From gitlab at gitlab.haskell.org Mon May 1 02:46:11 2023 From: gitlab at gitlab.haskell.org (Moritz Angermann (@angerman)) Date: Sun, 30 Apr 2023 22:46:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/riscv64-ncg Message-ID: <644f27f3ed429_178e7414aaf06e02410790@gitlab.mail> Moritz Angermann pushed new branch wip/angerman/riscv64-ncg at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/riscv64-ncg You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 02:52:00 2023 From: gitlab at gitlab.haskell.org (Moritz Angermann (@angerman)) Date: Sun, 30 Apr 2023 22:52:00 -0400 Subject: [Git][ghc/ghc][wip/angerman/riscv64-ncg] 3 commits: Bring back old aarch64 test-suite Message-ID: <644f29506ecd1_178e7414ac4205c24109c0@gitlab.mail> Moritz Angermann pushed to branch wip/angerman/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 304ed098 by Moritz Angermann at 2023-05-01T02:51:27+00:00 Bring back old aarch64 test-suite - - - - - 25dbbe54 by Moritz Angermann at 2023-05-01T02:51:38+00:00 Add RV64 backend - - - - - 80e8e802 by Moritz Angermann at 2023-05-01T02:51:43+00:00 Add RV64 notes - - - - - 9 changed files: - compiler/CodeGen.Platform.h - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/PIC.hs - + compiler/GHC/CmmToAsm/RV64-notes.md - + compiler/GHC/CmmToAsm/RV64.hs - + compiler/GHC/CmmToAsm/RV64/CodeGen.hs - + compiler/GHC/CmmToAsm/RV64/Cond.hs - + compiler/GHC/CmmToAsm/RV64/Instr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b462363660a280754e11a81778bc6bb29496d763...80e8e802a98ab15967f78e66ee312e357ce383d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b462363660a280754e11a81778bc6bb29496d763...80e8e802a98ab15967f78e66ee312e357ce383d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 06:43:59 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 01 May 2023 02:43:59 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] 18 commits: DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) Message-ID: <644f5fafc9f9e_178e7414e9365e4242966f@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 910740bb by Josh Meredith at 2023-05-01T06:42:22+00:00 WIP refactor jsSaturate to return a saturated IR - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Hs.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/CSE.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Lift.hs - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Stats.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/Stg/Unarise.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/117fc799b5caa7280526fbcc5cdf523dfb7a57ce...910740bb10a82bc2e95af042bbbf6ba6376e61f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/117fc799b5caa7280526fbcc5cdf523dfb7a57ce...910740bb10a82bc2e95af042bbbf6ba6376e61f3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 06:50:24 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 01 May 2023 02:50:24 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated IR (#23328) Message-ID: <644f61303a817_178e7414ec2cbcc24316bf@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 56208ad0 by Josh Meredith at 2023-05-01T06:49:56+00:00 JS: refactor jsSaturate to return a saturated IR (#23328) - - - - - 6 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -22,7 +22,6 @@ module GHC.JS.Transform , composOpM_ , composOpFold , satJExpr - , satJStat ) where @@ -200,8 +199,8 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) +jsSaturate' :: (JMacro a) => Maybe FastString -> a -> a +jsSaturate' str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) jsSaturate_ :: (JMacro a) => a -> IdentSupply a jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) @@ -219,9 +218,9 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) -- -- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing +jsSaturate :: Maybe FastString -> JStat -> Sat.JStat +jsSaturate str = witness . proof str + where proof = jsSaturate' -- This is an Applicative but we can't use it because no type variables :( witness :: JStat -> Sat.JStat @@ -315,5 +314,5 @@ satJVal = go go (JStr f) = Sat.JStr f go (JRegEx f) = Sat.JRegEx f go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) + go (JFunc args body) = Sat.JFunc args (jsSaturate Nothing body) go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a +saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat +rtsDecls :: Sat.JStat rtsDecls = jsSaturate (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread @@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat +rts :: StgToJSConfig -> Sat.JStat rts = jsSaturate (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56208ad05b5fe4d26821652bf3564fdb51307b39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56208ad05b5fe4d26821652bf3564fdb51307b39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 07:27:36 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 01 May 2023 03:27:36 -0400 Subject: [Git][ghc/ghc][wip/expand-do] PopSrcSpan in HsExpr Message-ID: <644f69e8c7705_178e7414f3407b024357c4@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 370f8052 by Apoorv Ingle at 2023-05-01T02:26:54-05:00 PopSrcSpan in HsExpr - - - - - 10 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/Language/Haskell/Syntax/Expr.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -726,6 +726,12 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcRn -> ppr x GhcTc -> ppr x +ppr_expr (PopSrcSpan x) = case ghcPass @p of + GhcPs -> panic "ppr_expr Ps HsPopSrcSpan" + GhcRn -> ppr x + GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" + + instance Outputable XXExprGhcTc where ppr (WrapExpr (HsWrap co_fn e)) = pprHsWrapper co_fn (\_parens -> pprExpr e) @@ -845,6 +851,7 @@ hsExprNeedsParens prec = go go (HsDo _ sc _) | isDoComprehensionContext sc = False | otherwise = prec > topPrec + go (PopSrcSpan{}) = prec > topPrec go (ExplicitList{}) = False go (RecordUpd{}) = False go (ExprWithTySig{}) = prec >= sigPrec @@ -1107,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - -- (ppr orig) - = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + (ppr orig) + -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Hs/Syn/Type.hs ===================================== @@ -114,6 +114,7 @@ hsExprType (HsIf _ _ t _) = lhsExprType t hsExprType (HsMultiIf ty _) = ty hsExprType (HsLet _ _ _ _ body) = lhsExprType body hsExprType (HsDo ty _ _) = ty +hsExprType (PopSrcSpan expr) = pprPanic "hsExprType" (text "impossible happened PopSrcSpan" <+> ppr expr) hsExprType (ExplicitList ty _) = mkListTy ty hsExprType (RecordCon con_expr _ _) = hsExprType con_expr hsExprType (RecordUpd v _ _) = dataConCantHappen v ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -29,6 +29,7 @@ import GHC.HsToCore.Utils import GHC.HsToCore.Arrows import GHC.HsToCore.Monad import GHC.HsToCore.Pmc ( addTyCs, pmcGRHSs ) +import GHC.HsToCore.Pmc.Utils import GHC.HsToCore.Errors.Types import GHC.Types.SourceText import GHC.Types.Name @@ -258,6 +259,8 @@ dsExpr (HsOverLit _ lit) = do { warnAboutOverflowedOverLit lit ; dsOverLit lit } +dsExpr e@(PopSrcSpan {}) = pprPanic "dsExpr" (ppr e) + dsExpr e@(XExpr ext_expr_tc) = case ext_expr_tc of ExpansionExpr (HsExpanded _ b) -> dsExpr b @@ -857,15 +860,22 @@ warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty | Just (SrcSpanAnn _ l, f) <- fish_var fun , is_gen_then f - , isNoSrcSpan l - = warnDiscardedDoBindings arg arg_ty + -- , isNoSrcSpan l + = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun + , text "arg" <+> ppr arg + , text "arg_ty" <+> ppr arg_ty + , text "f" <+> ppr f <+> ppr (is_gen_then f) + , text "l" <+> ppr (isNoSrcSpan l)]) + warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application fish_var :: LHsExpr GhcTc -> Maybe (SrcSpanAnnA , LIdP GhcTc) fish_var (L l (HsVar _ id)) = return (l, id) + fish_var (L _ (PopSrcSpan e)) = pprPanic "warnUnusedBindValue" (ppr e) fish_var (L _ (HsAppType _ e _ _)) = fish_var e fish_var (L l (XExpr (WrapExpr (HsWrap _ e)))) = do (l, e') <- fish_var (L l e) return (l, e') + fish_var (L l (XExpr (ExpansionExpr (HsExpanded _ e)))) = fish_var (L l e) fish_var _ = Nothing -- is this id a compiler generated (>>) with expanded do ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1663,7 +1663,7 @@ repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e) repE e@(HsTypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsUntypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsProc{}) = notHandled (ThExpressionForm e) - +repE e@(PopSrcSpan{}) = notHandled (ThExpressionForm e) {- Note [Quotation and rebindable syntax] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1234,6 +1234,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where ] HsGetField {} -> [] HsProjection {} -> [] + PopSrcSpan {} -> [] XExpr x | HieTc <- hiePass @p -> case x of ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -560,6 +560,8 @@ rnExpr (ArithSeq _ _ seq) else return (ArithSeq noExtField Nothing new_seq, fvs) } +rnExpr (PopSrcSpan _) = panic "impossible happened rnExpr PopSrcSpan" + {- ************************************************************************ * * ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -408,9 +408,33 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } +tcExpr (HsDo _ doFlav@(DoExpr{}) (L loc stmts)) res_ty + = do { expand_expr <- expandDoStmts doFlav stmts + ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) + (unLoc expand_expr) + -- Do expansion on the fly + ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expand_do_expr res_ty + } + +tcExpr (HsDo _ doFlav@(MDoExpr{}) (L loc stmts)) res_ty + = do { expand_expr <- expandDoStmts doFlav stmts + ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) + (unLoc expand_expr) + -- Do expansion on the fly + ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expand_do_expr res_ty + } + tcExpr (HsDo _ do_or_lc stmts) res_ty = tcDoStmts do_or_lc stmts res_ty +tcExpr (PopSrcSpan (L _ expr)) res_ty = popErrCtxt $ tcExpr expr res_ty + tcExpr (HsProc x pat cmd) res_ty = do { (pat', cmd', coi) <- tcProc pat cmd res_ty ; return $ mkHsWrapCo coi (HsProc x pat' cmd') } ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Tc.Gen.Match , tcDoStmt , tcGuardStmt , checkArgCounts + , expandDoStmts ) where @@ -319,32 +320,34 @@ tcDoStmts ListComp (L l stmts) res_ty (mkCheckExpType elt_ty) ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) } -tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty - = do { -- stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty +tcDoStmts (DoExpr _) ss _ + = pprPanic "tcDoStmts DoExpr" (ppr ss) -- do { + -- stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty -- ; res_ty <- readExpType res_ty -- ; return (HsDo res_ty doExpr (L l stmts')) - expand_expr <- expand_do_stmts doExpr stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doExpr (L l stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty - } - -tcDoStmts mDoExpr@(MDoExpr _) (L l stmts) res_ty - = do { -- stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty - -- ; res_ty <- readExpType res_ty + -- expand_expr <- expand_do_stmts doExpr stmts + -- ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doExpr (L l stmts)) + -- (unLoc expand_expr) + -- -- Do expansion on the fly + -- ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr + -- , text "expanded:" <+> ppr expand_expr + -- ]) + -- ; tcExpr expand_do_expr res_ty + -- } + +tcDoStmts (MDoExpr _) ss _ + = pprPanic "tcDoStmts MDoExpr" (ppr ss) + --do { -- stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty + -- ; res_ty <- readExpType res_ty -- ; return (HsDo res_ty mDoExpr (L l stmts')) - expand_expr <- expand_do_stmts mDoExpr stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField mDoExpr (L l stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts mdo" (text "tcExpr:" <+> ppr expand_do_expr) - ; tcExpr expand_do_expr res_ty + -- expand_expr <- expand_do_stmts mDoExpr stmts + -- ; let expand_do_expr = mkExpandedExpr (HsDo noExtField mDoExpr (L l stmts)) + -- (unLoc expand_expr) + -- -- Do expansion on the fly + -- ; traceTc "tcDoStmts mdo" (text "tcExpr:" <+> ppr expand_do_expr) + -- ; tcExpr expand_do_expr res_ty - } + -- } tcDoStmts MonadComp (L l stmts) res_ty = do { stmts' <- tcStmts (HsDoStmt MonadComp) tcMcStmt stmts res_ty @@ -1201,6 +1204,9 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) }) * * ************************************************************************ -} +expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) +expandDoStmts = expand_do_stmts + -- | Expand the Do statments so that it works fine with Quicklook -- See Note[Rebindable Do and Expanding Statements] -- ANI Questions: 1. What should be the location information in the expanded expression? @@ -1230,7 +1236,9 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding x can fail --- stmts ~~> stmt' let f pat = stmts'; f _ = fail ".." +-- instead of making an internal name, the fail block is just an anonymous match block +-- stmts ~~> stmt' let / = stmts'; +-- _ = fail ".."; -- ------------------------------------------------------- -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts @@ -1248,7 +1256,7 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) expand_stmts <- expand_do_stmts do_or_lc lstmts return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ e - , mkHsLam [pat] expand_stmts -- (\ x -> stmts') + , mkHsLam [pat] (noLocA $ PopSrcSpan expand_stmts) -- (\ x -> stmts') ] expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = @@ -1265,9 +1273,9 @@ expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ mkHsApps (wrapGenSpan f) -- (>>) - [ e -- e - , expand_stmts ] -- stmts' + return $ noLocA (PopSrcSpan (mkHsApps (wrapGenSpan f) -- (>>) + [ e -- e + , expand_stmts ])) -- stmts' expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts @@ -1288,11 +1296,11 @@ expand_do_stmts do_or_lc -- ; return (local_only_ids ++ later_ids) } )) -- (\ [ local_only_ids ++ later_ids ] -> stmts') do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ (mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) - [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) - , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> - expand_stmts -- stmts') - ]) + return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) + [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) + , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> + (noLocA $ PopSrcSpan expand_stmts) -- stmts') + ] where local_only_ids = local_ids \\ later_ids -- get unique local rec ids; --local rec ids and later ids can overlap @@ -1376,9 +1384,12 @@ mk_failable_lexpr_tcm pat lexpr fail_op = do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) PatBindRhs pat $ return id -- whatever ; dflags <- getDynFlags + ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr tc_pat + , ppr $ isIrrefutableHsPat dflags tc_pat + , ppr $ isPatSynCon (unLoc tc_pat)]) ; if isIrrefutableHsPat dflags tc_pat -- don't decorate with fail statement if the pattern is irrefutable || (isPatSynCon (unLoc tc_pat)) -- pattern syns always get a fail block while desugaring so skip - then return $ mkHsLam [pat] lexpr + then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } where isPatSynCon (ConPat {pat_con = L _ (PatSynCon _)}) = True @@ -1391,7 +1402,7 @@ mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsEx mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ - (noLocA [ mkHsCaseAlt pat lexpr -- pat -> expr + (noLocA [ mkHsCaseAlt pat (noLocA $ PopSrcSpan lexpr) -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -846,6 +846,8 @@ zonkExpr env (HsDo ty do_or_lc (L l stmts)) new_ty <- zonkTcTypeToTypeX env ty return (HsDo new_ty do_or_lc (L l new_stmts)) +zonkExpr env (PopSrcSpan (L _ exp)) = zonkExpr env exp + zonkExpr env (ExplicitList ty exprs) = do new_ty <- zonkTcTypeToTypeX env ty new_exprs <- zonkLExprs env exprs ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -584,6 +584,11 @@ data HsExpr p -- general idea, and Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr -- for an example of how we use it. + | PopSrcSpan (LHsExpr p) + -- Placeholder for identifying generated source locations in GhcRn phase + -- Should not presist post typechecking + -- Note [Desugaring Do with HsExpansion] TODO + -- --------------------------------------------------------------------- data DotFieldOcc p View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/370f8052b58945d7d7c4917c89728fe6bab92660 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/370f8052b58945d7d7c4917c89728fe6bab92660 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 07:49:05 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 01 May 2023 03:49:05 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <644f6ef1f1295_178e7414fd1b168244477e@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 13bc0c96 by Josh Meredith at 2023-05-01T07:48:30+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 6 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -22,7 +22,6 @@ module GHC.JS.Transform , composOpM_ , composOpFold , satJExpr - , satJStat ) where @@ -200,8 +199,8 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) +jsSaturate' :: (JMacro a) => Maybe FastString -> a -> a +jsSaturate' str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) jsSaturate_ :: (JMacro a) => a -> IdentSupply a jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) @@ -219,9 +218,9 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) -- -- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing +jsSaturate :: Maybe FastString -> JStat -> Sat.JStat +jsSaturate str = witness . proof str + where proof = jsSaturate' -- This is an Applicative but we can't use it because no type variables :( witness :: JStat -> Sat.JStat @@ -315,5 +314,5 @@ satJVal = go go (JStr f) = Sat.JStr f go (JRegEx f) = Sat.JRegEx f go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) + go (JFunc args body) = Sat.JFunc args (jsSaturate Nothing body) go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a +saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat +rtsDecls :: Sat.JStat rtsDecls = jsSaturate (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread @@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat +rts :: StgToJSConfig -> Sat.JStat rts = jsSaturate (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13bc0c9601f46c345ed5d5cc911d6a153c4213f1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13bc0c9601f46c345ed5d5cc911d6a153c4213f1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 08:40:05 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 01 May 2023 04:40:05 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <644f7ae5b9b02_178e74150829e88245224a@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 24d527f4 by Josh Meredith at 2023-05-01T08:39:50+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 6 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -22,7 +22,6 @@ module GHC.JS.Transform , composOpM_ , composOpFold , satJExpr - , satJStat ) where @@ -200,8 +199,8 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) +jsSaturate' :: (JMacro a) => Maybe FastString -> a -> a +jsSaturate' str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) jsSaturate_ :: (JMacro a) => a -> IdentSupply a jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) @@ -219,9 +218,9 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) -- -- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing +jsSaturate :: Maybe FastString -> JStat -> Sat.JStat +jsSaturate str = witness . proof str + where proof = jsSaturate' -- This is an Applicative but we can't use it because no type variables :( witness :: JStat -> Sat.JStat @@ -315,5 +314,5 @@ satJVal = go go (JStr f) = Sat.JStr f go (JRegEx f) = Sat.JRegEx f go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) + go (JFunc args body) = Sat.JFunc args (jsSaturate Nothing body) go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a +saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat +rtsDecls :: Sat.JStat rtsDecls = jsSaturate (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread @@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat +rts :: StgToJSConfig -> Sat.JStat rts = jsSaturate (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24d527f470b0533ed3618e8094f0d0a512b2a291 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24d527f470b0533ed3618e8094f0d0a512b2a291 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 09:58:35 2023 From: gitlab at gitlab.haskell.org (Moritz Angermann (@angerman)) Date: Mon, 01 May 2023 05:58:35 -0400 Subject: [Git][ghc/ghc][wip/angerman/riscv64-ncg] Fixup Rebase mistake Message-ID: <644f8d4b48de_178e74151eb9af424670d0@gitlab.mail> Moritz Angermann pushed to branch wip/angerman/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 30a10abc by Moritz Angermann at 2023-05-01T09:53:15+00:00 Fixup Rebase mistake - - - - - 1 changed file: - compiler/GHC/CmmToAsm/Reg/Linear.hs Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Linear.hs ===================================== @@ -114,7 +114,7 @@ import qualified GHC.CmmToAsm.Reg.Linear.PPC as PPC import qualified GHC.CmmToAsm.Reg.Linear.X86 as X86 import qualified GHC.CmmToAsm.Reg.Linear.X86_64 as X86_64 import qualified GHC.CmmToAsm.Reg.Linear.AArch64 as AArch64 -import qualified GHC.CmmToAsm.Reg.Linear.AArch64 as RV64 +import qualified GHC.CmmToAsm.Reg.Linear.RV64 as RV64 import GHC.CmmToAsm.Reg.Target import GHC.CmmToAsm.Reg.Liveness import GHC.CmmToAsm.Reg.Utils View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30a10abcc56166885fc457f55a66acbeddae06cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30a10abcc56166885fc457f55a66acbeddae06cd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 10:28:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 May 2023 06:28:41 -0400 Subject: [Git][ghc/ghc][wip/T23146] Update Note [Core letrec invariant] Message-ID: <644f94599b29c_178e741527a5cd0247428b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: b7784859 by Rodrigo Mesquita at 2023-05-01T11:28:15+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - 1 changed file: - compiler/GHC/Core.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,36 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In CorePrep, we generate a top-level binding for every data constructor + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist, after CorePrep + only. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7784859d190e75b8fe52df002c0b615c88f0365 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7784859d190e75b8fe52df002c0b615c88f0365 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 14:37:26 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 01 May 2023 10:37:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23315 Message-ID: <644fcea6cb590_178e74156a6aa9825217ea@gitlab.mail> Finley McIlwaine pushed new branch wip/t23315 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23315 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 14:38:46 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 01 May 2023 10:38:46 -0400 Subject: [Git][ghc/ghc][wip/t23315] Insert documentation into parsed signature modules Message-ID: <644fcef64a1ff_178e74156a6bc2c2521957@gitlab.mail> Finley McIlwaine pushed to branch wip/t23315 at Glasgow Haskell Compiler / GHC Commits: 83f26064 by Finley McIlwaine at 2023-05-01T08:38:22-06:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 7 changed files: - compiler/GHC/Parser.y - + testsuite/tests/parser/should_compile/T23315/Makefile - + testsuite/tests/parser/should_compile/T23315/Setup.hs - + testsuite/tests/parser/should_compile/T23315/T23315.cabal - + testsuite/tests/parser/should_compile/T23315/T23315.hsig - + testsuite/tests/parser/should_compile/T23315/T23315.stderr - + testsuite/tests/parser/should_compile/T23315/all.T Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -743,7 +743,7 @@ TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } -- Exported parsers %name parseModuleNoHaddock module -%name parseSignature signature +%name parseSignatureNoHaddock signature %name parseImport importdecl %name parseStatement e_stmt %name parseDeclaration topdecl @@ -4376,18 +4376,29 @@ pvL :: MonadP m => m (LocatedAn t a) -> m (Located a) pvL a = do { av <- a ; return (reLoc av) } --- | Parse a Haskell module with Haddock comments. --- This is done in two steps: +-- | Parse a Haskell module with Haddock comments. This is done in two steps: -- -- * 'parseModuleNoHaddock' to build the AST -- * 'addHaddockToModule' to insert Haddock comments into it -- --- This is the only parser entry point that deals with Haddock comments. --- The other entry points ('parseDeclaration', 'parseExpression', etc) do --- not insert them into the AST. +-- This and the signature module parser are the only parser entry points that +-- deal with Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. parseModule :: P (Located (HsModule GhcPs)) parseModule = parseModuleNoHaddock >>= addHaddockToModule +-- | Parse a Haskell signature module with Haddock comments. This is done in two +-- steps: +-- +-- * 'parseSignatureNoHaddock' to build the AST +-- * 'addHaddockToModule' to insert Haddock comments into it +-- +-- This and the module parser are the only parser entry points that deal with +-- Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. +parseSignature :: P (Located (HsModule GhcPs)) +parseSignature = parseSignatureNoHaddock >>= addHaddockToModule + commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc ===================================== testsuite/tests/parser/should_compile/T23315/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +T23315: clean + $(MAKE) clean + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build 1>&2 +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi ===================================== testsuite/tests/parser/should_compile/T23315/Setup.hs ===================================== @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file ===================================== testsuite/tests/parser/should_compile/T23315/T23315.cabal ===================================== @@ -0,0 +1,10 @@ +name: T23315 +version: 0.1.0.0 +build-type: Simple +cabal-version: 2.0 + +library + signatures: T23315 + build-depends: base >= 4.3 && < 5 + default-language: Haskell2010 + ghc-options: -Wall -haddock -ddump-parsed-ast ===================================== testsuite/tests/parser/should_compile/T23315/T23315.hsig ===================================== @@ -0,0 +1,4 @@ +signature T23315 where +-- | My unit +a :: () +-- ^ More docs ===================================== testsuite/tests/parser/should_compile/T23315/T23315.stderr ===================================== @@ -0,0 +1,117 @@ + +==================== Parser AST ==================== + +(L + { T23315.hsig:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T23315.hsig:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 })) + ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + []) + (Nothing)) + (EpaComments + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:1:11-16 }) + {ModuleName: T23315})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:2:1-12 }) + (DocD + (NoExtField) + (DocCommentNext + (L + { T23315.hsig:2:1-12 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T23315.hsig:2:5-12 } + (HsDocStringChunk + " My unit")) + [])) + []))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T23315.hsig:3:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T23315.hsig:3:1-7 }) + (SigD + (NoExtField) + (TypeSig + (EpAnn + (Anchor + { T23315.hsig:3:1 } + (UnchangedAnchor)) + (AnnSig + (AddEpAnn AnnDcolon (EpaSpan { T23315.hsig:3:3-4 })) + []) + (EpaComments + [])) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:1 }) + (Unqual + {OccName: a}))] + (HsWC + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsTupleTy + (EpAnn + (Anchor + { T23315.hsig:3:6 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { T23315.hsig:3:6 }) + (EpaSpan { T23315.hsig:3:7 })) + (EpaComments + [])) + (HsBoxedOrConstraintTuple) + [])))))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:4:1-14 }) + (DocD + (NoExtField) + (DocCommentPrev + (L + { T23315.hsig:4:1-14 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringPrevious) + (:| + (L + { T23315.hsig:4:5-14 } + (HsDocStringChunk + " More docs")) + [])) + [])))))])) + + ===================================== testsuite/tests/parser/should_compile/T23315/all.T ===================================== @@ -0,0 +1,3 @@ +test('T23315', + [extra_files(['Setup.hs']), js_broken(22352)], + makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83f26064c4fbfa8ff2442d0f40fca8953d70446c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83f26064c4fbfa8ff2442d0f40fca8953d70446c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 15:59:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 01 May 2023 11:59:28 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/glossary Message-ID: <644fe1e043864_178e74157f4916c25324b0@gitlab.mail> Ben Gamari pushed new branch wip/glossary at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/glossary You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 16:12:23 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 01 May 2023 12:12:23 -0400 Subject: [Git][ghc/ghc][wip/glossary] Update glossary.rst Message-ID: <644fe4e76bb8f_178e74158405f0c2540843@gitlab.mail> Ben Gamari pushed to branch wip/glossary at Glasgow Haskell Compiler / GHC Commits: f5f79492 by Ben Gamari at 2023-05-01T16:12:22+00:00 Update glossary.rst - - - - - 1 changed file: - docs/users_guide/glossary.rst Changes: ===================================== docs/users_guide/glossary.rst ===================================== @@ -5,14 +5,8 @@ technology preview:: GHC will occassionally ship features advertised as being in a *technology preview* state. Such features are generally opt-in in nature (e.g. new - language extensions). - - - Expectation that work will continue -- unlikely to just disappear - Doesn’t implement all features (best to enumerate: TH…) - A list of known bugs/shortcomings listed here (wiki page) - Isn’t optimized (produces suboptimal code) - Behavior may change in the future, although we will try to document such changes - - - + language extensions) and may have various shortcomings. These may include + known bugs (which we will try to document), lacking optimisation, and + unhandled interactions with other language features. As such, behavior + of such features may change in the future. However, we do expect features + to converge to non-preview state over the course of a few GHC major releases. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5f79492db87a914fcc49d4886385b6f6a185c6a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5f79492db87a914fcc49d4886385b6f6a185c6a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 16:14:31 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 May 2023 12:14:31 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 9 commits: JS: Fix h$base_access implementation (issue 22576) Message-ID: <644fe567b9e16_178e74158405f0c25412e0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c7a9d2d6 by Ben Gamari at 2023-04-26T12:59:41+01:00 ghc-toolchain: Initial commit - - - - - e824e588 by Ben Gamari at 2023-04-26T12:59:41+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - e3fdc932 by Ben Gamari at 2023-04-26T12:59:41+01:00 Move via-C flags into GHC - - - - - c2d3204f by Ben Gamari at 2023-04-26T12:59:41+01:00 Rip out runtime linker/compiler checks - - - - - e29638dc by Ben Gamari at 2023-04-26T12:59:41+01:00 configure: Rip out toolchain selection logic - - - - - 320ad3ec by Ben Gamari at 2023-04-26T12:59:41+01:00 Fixes - - - - - 11ecbac3 by Rodrigo Mesquita at 2023-05-01T17:11:41+01:00 Rename readProcess to readProcessStdout Fixes a bug regarding a translation from the autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/exts/implicit_parameters.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/jsbits/base.js - − m4/check_for_gold_t22266.m4 - − m4/check_ld_copy_bug.m4 - − m4/find_ld.m4 - − m4/find_merge_objects.m4 - − m4/fp_find_nm.m4 - − m4/fp_gcc_extra_flags.m4 - − m4/fp_gcc_supports_no_pie.m4 - − m4/fp_gcc_version.m4 - − m4/fp_prog_ar.m4 - − m4/fp_prog_ar_args.m4 - − m4/fp_prog_ar_is_gnu.m4 - − m4/fp_prog_ar_needs_ranlib.m4 - − m4/fp_prog_ar_supports_atfile.m4 - − m4/fp_prog_ar_supports_dash_l.m4 - − m4/fp_prog_ld_filelist.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1035f226e7297e1f51d0c0c89e280bfec6b4cb27...11ecbac333fe11acfefdcd45aa680045c2866452 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1035f226e7297e1f51d0c0c89e280bfec6b4cb27...11ecbac333fe11acfefdcd45aa680045c2866452 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 16:15:09 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 May 2023 12:15:09 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ghc-toolchain: Rename readProcess to readProcessStdout Message-ID: <644fe58dc9ca3_178e7415853a47c254177d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 102ae4bc by Rodrigo Mesquita at 2023-05-01T17:14:57+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes a bug regarding a translation from the autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 6 changed files: - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs - utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -96,7 +96,7 @@ checkLeadingUnderscore :: Cc -> Nm -> M Bool checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o prog - out <- readProgram (nmProgram nm) [test_o] + out <- readProgramStdout (nmProgram nm) [test_o] return $ "_func" `isInfixOf` out where prog = "int func(void) { return 0; }" ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -6,6 +6,7 @@ module GHC.Toolchain.Program , runProgram , callProgram , readProgram + , readProgramStdout -- * Finding 'Program's , ProgOpt(..) , emptyProgOpt @@ -58,8 +59,16 @@ callProgram prog args = do , "Exited with code " ++ show n ] -readProgram :: Program -> [String] -> M String +-- | Runs a program with a list of arguments and returns the exit code and the +-- stdout and stderr output +readProgram :: Program -> [String] -> M (ExitCode, String, String) readProgram prog args = do + logExecute prog args + liftIO $ readProcessWithExitCode (prgPath prog) (prgFlags prog ++ args) "" + +-- | Runs a program with a list of arguments and returns the stdout output +readProgramStdout :: Program -> [String] -> M String +readProgramStdout prog args = do logExecute prog args liftIO $ readProcess (prgPath prog) (prgFlags prog ++ args) "" ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -22,7 +22,7 @@ data Ar = Ar { arMkArchive :: Program findAr :: ProgOpt -> M Ar findAr progOpt = checking "for 'ar'" $ do bareAr <- findProgram "ar archiver" progOpt ["ar"] - arIsGnu <- ("GNU" `isInfixOf`) <$> readProgram bareAr ["--version"] + arIsGnu <- ("GNU" `isInfixOf`) <$> readProgramStdout bareAr ["--version"] -- Figure out how to invoke ar to create archives... mkArchive <- checking "for how to make archives" @@ -84,7 +84,7 @@ checkArSupportsDashL bareAr = checking "that ar supports -L" $ withTempDir $ \di callProgram bareAr ["qc", archive2, file "b0", file "b1"] oneOf "trying -L" [ do callProgram bareAr ["qcL", merged, archive1, archive2] - contents <- readProgram bareAr ["t", merged] + contents <- readProgramStdout bareAr ["t", merged] return $ not $ "conftest.a1" `isInfixOf` contents , return False ] @@ -98,7 +98,7 @@ checkArSupportsAtFile bareAr mkArchive = checking "that ar supports @-files" $ w createFile f writeFile atfile (unlines objs) callProgram mkArchive [archive, "@" ++ dir "conftest.atfile"] - contents <- readProgram bareAr ["t", archive] + contents <- readProgramStdout bareAr ["t", archive] if lines contents == objs then return True else logDebug "Contents didn't match" >> return False ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -77,8 +77,8 @@ checkSupportsNoPie ccLink = withTempDir $ \dir -> do let test = dir "test" -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. - out <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - if "unrecognized" `isInfixOf` out + (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] + if isSuccess code && "unrecognized" `isInfixOf` out then return False else return True @@ -119,7 +119,7 @@ checkBfdCopyBug archOs cc mb_readelf ccLink callProgram ccLink ["-o", exe, test_o, main_o, lib_so] - out <- readProgram (readelfProgram readelf) ["-r", exe] + out <- readProgramStdout (readelfProgram readelf) ["-r", exe] when ("R_ARM_COPY" `isInfixOf` out) $ throwE "Your linker is affected by binutils #16177. Please choose a different linker." ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -36,14 +36,14 @@ checkMergingWorks cc nm mergeObjs = compileC cc (fo "a") "void funA(int x) { return x; }" compileC cc (fo "b") "void funB(int x) { return x; }" callProgram (mergeObjsProgram mergeObjs) [fo "a", fo "b", "-o", fo "out"] - out <- readProgram (nmProgram nm) [fo "out"] + out <- readProgramStdout (nmProgram nm) [fo "out"] let ok = all (`isInfixOf` out) ["funA", "funB"] unless ok $ throwE "merged objects is missing symbols" checkForGoldT22266 :: Cc -> CcLink -> MergeObjs -> M () checkForGoldT22266 cc ccLink mergeObjs = do version <- checking "for ld.gold object merging bug (binutils #22266)" $ - readProgram (mergeObjsProgram mergeObjs) ["--version"] + readProgramStdout (mergeObjsProgram mergeObjs) ["--version"] when ("gold" `isInfixOf` version) check_it where check_it = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} module GHC.Toolchain.Utils @@ -5,6 +6,7 @@ module GHC.Toolchain.Utils , expectFileExists , withTempDir , oneOf + , isSuccess ) where import Control.Monad @@ -13,6 +15,7 @@ import Control.Monad.IO.Class import System.Directory import System.FilePath import System.IO.Error +import System.Exit import GHC.Toolchain.Prelude @@ -52,3 +55,9 @@ expectFileExists path err = do oneOf :: String -> [M b] -> M b oneOf err = foldr (<|>) (throwE err) + +isSuccess :: ExitCode -> Bool +isSuccess = \case + ExitSuccess -> True + ExitFailure _ -> False + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/102ae4bc247076c8e70b57c5cec00c5dc82feaaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/102ae4bc247076c8e70b57c5cec00c5dc82feaaf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 17:31:29 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 01 May 2023 13:31:29 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: ghc-toolchain: Rename readProcess to readProcessStdout Message-ID: <644ff7712eeff_178e74159a5e6502546611@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 9651258b by Rodrigo Mesquita at 2023-05-01T17:37:40+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - f0218199 by Rodrigo Mesquita at 2023-05-01T18:31:20+01:00 Re-introduce ld-override option - - - - - 8 changed files: - configure.ac - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs - utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs - utils/ghc-toolchain/src/Main.hs Changes: ===================================== configure.ac ===================================== @@ -446,6 +446,11 @@ FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) dnl ** Which ld to use dnl -------------------------------------------------------------- AC_ARG_VAR(LD,[Use as the path to ld. See also --disable-ld-override.]) +AC_ARG_ENABLE(ld-override, + [AS_HELP_STRING([--disable-ld-override], + [Prevent GHC from overriding the default linker used by gcc. If ld-override is disabled GHC will try to tell gcc to use whichever linker is selected by the LD environment variable. [default=override enabled]])], + [], + [enable_ld_override=yes]) dnl ** Which objdump to use? dnl -------------------------------------------------------------- ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -96,7 +96,7 @@ checkLeadingUnderscore :: Cc -> Nm -> M Bool checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o prog - out <- readProgram (nmProgram nm) [test_o] + out <- readProgramStdout (nmProgram nm) [test_o] return $ "_func" `isInfixOf` out where prog = "int func(void) { return 0; }" ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -6,6 +6,7 @@ module GHC.Toolchain.Program , runProgram , callProgram , readProgram + , readProgramStdout -- * Finding 'Program's , ProgOpt(..) , emptyProgOpt @@ -58,10 +59,20 @@ callProgram prog args = do , "Exited with code " ++ show n ] -readProgram :: Program -> [String] -> M String +-- | Runs a program with a list of arguments and returns the exit code and the +-- stdout and stderr output +readProgram :: Program -> [String] -> M (ExitCode, String, String) readProgram prog args = do logExecute prog args - liftIO $ readProcess (prgPath prog) (prgFlags prog ++ args) "" + liftIO $ readProcessWithExitCode (prgPath prog) (prgFlags prog ++ args) "" + +-- | Runs a program with a list of arguments and returns the stdout output +readProgramStdout :: Program -> [String] -> M String +readProgramStdout prog args = do + logExecute prog args + (_code, stdout, _stderr) <- liftIO $ readProcessWithExitCode (prgPath prog) (prgFlags prog ++ args) "" + -- Ignores the exit code! + return stdout logExecute :: Program -> [String] -> M () logExecute prog args = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -22,7 +22,7 @@ data Ar = Ar { arMkArchive :: Program findAr :: ProgOpt -> M Ar findAr progOpt = checking "for 'ar'" $ do bareAr <- findProgram "ar archiver" progOpt ["ar"] - arIsGnu <- ("GNU" `isInfixOf`) <$> readProgram bareAr ["--version"] + arIsGnu <- ("GNU" `isInfixOf`) <$> readProgramStdout bareAr ["--version"] -- Figure out how to invoke ar to create archives... mkArchive <- checking "for how to make archives" @@ -84,7 +84,7 @@ checkArSupportsDashL bareAr = checking "that ar supports -L" $ withTempDir $ \di callProgram bareAr ["qc", archive2, file "b0", file "b1"] oneOf "trying -L" [ do callProgram bareAr ["qcL", merged, archive1, archive2] - contents <- readProgram bareAr ["t", merged] + contents <- readProgramStdout bareAr ["t", merged] return $ not $ "conftest.a1" `isInfixOf` contents , return False ] @@ -98,7 +98,7 @@ checkArSupportsAtFile bareAr mkArchive = checking "that ar supports @-files" $ w createFile f writeFile atfile (unlines objs) callProgram mkArchive [archive, "@" ++ dir "conftest.atfile"] - contents <- readProgram bareAr ["t", archive] + contents <- readProgramStdout bareAr ["t", archive] if lines contents == objs then return True else logDebug "Contents didn't match" >> return False ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -22,8 +22,8 @@ data CcLink = CcLink { ccLinkProgram :: Program } deriving (Show, Read) -findCcLink :: ProgOpt -> ArchOS -> Cc -> Maybe Readelf -> M CcLink -findCcLink progOpt archOs cc readelf = checking "for C compiler for linking command" $ do +findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink +findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do ccLinkProgram <- case poPath progOpt of Just _ -> -- If the user specified a linker don't second-guess them @@ -31,16 +31,16 @@ findCcLink progOpt archOs cc readelf = checking "for C compiler for linking comm Nothing -> do -- If not then try to find a decent linker on our own rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc] - findLinkFlags cc rawCcLink <|> pure rawCcLink + findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie} -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ -findLinkFlags :: Cc -> Program -> M Program -findLinkFlags cc ccLink - | doLinkerSearch = +findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program +findLinkFlags ldOverride cc ccLink + | enableOverride && doLinkerSearch = oneOf "this can't happen" [ -- Annoyingly, gcc silently falls back to vanilla ld (typically bfd -- ld) if @-fuse-ld@ is given with a non-existent linker. @@ -54,6 +54,13 @@ findLinkFlags cc ccLink <|> (ccLink <$ checkLinkWorks cc ccLink) | otherwise = return ccLink + where + enableOverride = case ldOverride of + -- ROMES: We're basically defining the default value here, + -- wouldn't it be better to define the default on construction? + Nothing -> True + Just True -> True + Just False -> False -- | Should we attempt to find a more efficient linker on this platform? -- @@ -77,8 +84,8 @@ checkSupportsNoPie ccLink = withTempDir $ \dir -> do let test = dir "test" -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. - out <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - if "unrecognized" `isInfixOf` out + (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] + if isSuccess code && "unrecognized" `isInfixOf` out then return False else return True @@ -119,7 +126,7 @@ checkBfdCopyBug archOs cc mb_readelf ccLink callProgram ccLink ["-o", exe, test_o, main_o, lib_so] - out <- readProgram (readelfProgram readelf) ["-r", exe] + out <- readProgramStdout (readelfProgram readelf) ["-r", exe] when ("R_ARM_COPY" `isInfixOf` out) $ throwE "Your linker is affected by binutils #16177. Please choose a different linker." ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -36,14 +36,14 @@ checkMergingWorks cc nm mergeObjs = compileC cc (fo "a") "void funA(int x) { return x; }" compileC cc (fo "b") "void funB(int x) { return x; }" callProgram (mergeObjsProgram mergeObjs) [fo "a", fo "b", "-o", fo "out"] - out <- readProgram (nmProgram nm) [fo "out"] + out <- readProgramStdout (nmProgram nm) [fo "out"] let ok = all (`isInfixOf` out) ["funA", "funB"] unless ok $ throwE "merged objects is missing symbols" checkForGoldT22266 :: Cc -> CcLink -> MergeObjs -> M () checkForGoldT22266 cc ccLink mergeObjs = do version <- checking "for ld.gold object merging bug (binutils #22266)" $ - readProgram (mergeObjsProgram mergeObjs) ["--version"] + readProgramStdout (mergeObjsProgram mergeObjs) ["--version"] when ("gold" `isInfixOf` version) check_it where check_it = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} module GHC.Toolchain.Utils @@ -5,6 +6,7 @@ module GHC.Toolchain.Utils , expectFileExists , withTempDir , oneOf + , isSuccess ) where import Control.Monad @@ -13,6 +15,7 @@ import Control.Monad.IO.Class import System.Directory import System.FilePath import System.IO.Error +import System.Exit import GHC.Toolchain.Prelude @@ -52,3 +55,9 @@ expectFileExists path err = do oneOf :: String -> [M b] -> M b oneOf err = foldr (<|>) (throwE err) + +isSuccess :: ExitCode -> Bool +isSuccess = \case + ExitSuccess -> True + ExitFailure _ -> False + ===================================== utils/ghc-toolchain/src/Main.hs ===================================== @@ -44,6 +44,7 @@ data Opts = Opts , optDllwrap :: ProgOpt , optUnregisterised :: Maybe Bool , optTablesNextToCode :: Maybe Bool + , optLdOverride :: Maybe Bool , optVerbosity :: Int , optKeepTemp :: Bool } @@ -65,6 +66,7 @@ emptyOpts = Opts , optWindres = po0 , optUnregisterised = Nothing , optTablesNextToCode = Nothing + , optLdOverride = Nothing -- See comment in Link on 'enableOverride'. Shouldn't we set the default here? , optVerbosity = 0 , optKeepTemp = False } @@ -98,6 +100,9 @@ _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) _optTablesNextToCode :: Lens Opts (Maybe Bool) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) +_optLdOvveride :: Lens Opts (Maybe Bool) +_optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) + _optVerbosity :: Lens Opts Int _optVerbosity = Lens optVerbosity (\x o -> o {optVerbosity=x}) @@ -114,6 +119,7 @@ options = concat [ enableDisable "unregisterised" "unregisterised backend" _optUnregisterised , enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode + , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride ] ++ concat [ progOpts "cc" "C compiler" _optCc @@ -235,13 +241,12 @@ determineTablesNextToCode determineTablesNextToCode archOs unreg userReq = case userReq of Just True + | not tntcSupported + -> throwE "Tables-next-to-code not supported by this platform" | unreg -> throwE "Tables-next-to-code cannot be used with unregisterised code generator" - | tntcSupported -> throwE "Tables-next-to-code not supported by this platform" | otherwise -> return True Just False -> return False - Nothing - | tntcSupported -> return True - | otherwise -> return False + Nothing -> pure tntcSupported where tntcSupported = tablesNextToCodeSupported archOs @@ -253,7 +258,7 @@ mkTarget opts = do archOs <- parseTriple cc0 (optTriple opts) cc <- addPlatformDepCcFlags archOs cc0 readelf <- optional $ findReadelf (optReadelf opts) - ccLink <- findCcLink (optCcLink opts) archOs cc readelf + ccLink <- findCcLink (optCcLink opts) (optLdOverride opts) archOs cc readelf ar <- findAr (optAr opts) ranlib <- if arNeedsRanlib ar View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/102ae4bc247076c8e70b57c5cec00c5dc82feaaf...f02181995fcccea4e456431db8698dfd7a1309d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/102ae4bc247076c8e70b57c5cec00c5dc82feaaf...f02181995fcccea4e456431db8698dfd7a1309d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 17:47:55 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 01 May 2023 13:47:55 -0400 Subject: [Git][ghc/ghc][wip/expand-do] a new check for irrefutable pattern Message-ID: <644ffb4bb68e8_178e74159eeb09c2547346@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 6b457021 by Apoorv Ingle at 2023-05-01T12:47:20-05:00 a new check for irrefutable pattern - - - - - 5 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -729,8 +729,8 @@ ppr_expr (XExpr x) = case ghcPass @p of ppr_expr (PopSrcSpan x) = case ghcPass @p of GhcPs -> panic "ppr_expr Ps HsPopSrcSpan" GhcRn -> ppr x - GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" - + GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" + instance Outputable XXExprGhcTc where ppr (WrapExpr (HsWrap co_fn e)) @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) - -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -67,6 +67,7 @@ import GHC.Hs.Extension import GHC.Hs.Type import GHC.Tc.Types.Evidence import GHC.Types.Basic +import GHC.Types.TypeEnv import GHC.Types.SourceText -- others: import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} ) @@ -502,6 +503,7 @@ looksLazyPat (VarPat {}) = False looksLazyPat (WildPat {}) = False looksLazyPat _ = True + isIrrefutableHsPat :: forall p. (OutputableBndrId p) => DynFlags -> LPat (GhcPass p) -> Bool -- (isIrrefutableHsPat p) is true if matching against p cannot fail, ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,14 +858,15 @@ warnDiscardedDoBindings rhs rhs_ty warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty - | Just (SrcSpanAnn _ l, f) <- fish_var fun + | Just (SrcSpanAnn _ l, (L (SrcSpanAnn _ loc) f)) <- fish_var fun , is_gen_then f -- , isNoSrcSpan l = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun , text "arg" <+> ppr arg , text "arg_ty" <+> ppr arg_ty , text "f" <+> ppr f <+> ppr (is_gen_then f) - , text "l" <+> ppr (isNoSrcSpan l)]) + , text "l" <+> ppr (isNoSrcSpan l) <+> ppr (isNoSrcSpan loc) + ]) warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application @@ -879,8 +880,8 @@ warnUnusedBindValue fun arg arg_ty fish_var _ = Nothing -- is this id a compiler generated (>>) with expanded do - is_gen_then :: LIdP GhcTc -> Bool - is_gen_then (L _ f) = f `hasKey` thenMClassOpKey + is_gen_then :: Id -> Bool + is_gen_then f = f `hasKey` thenMClassOpKey warnUnusedBindValue _ _ _ = return () ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -59,7 +59,6 @@ import GHC.Tc.Types.Evidence import GHC.Core.Multiplicity import GHC.Core.UsageEnv -import GHC.Core.ConLike import GHC.Core.TyCon -- Create chunkified tuple types for monad comprehensions import GHC.Core.Make @@ -81,6 +80,7 @@ import GHC.Types.Name import GHC.Types.Id import GHC.Types.SrcLoc import GHC.Types.Basic (Origin (..)) +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Control.Arrow ( second ) @@ -1381,19 +1381,19 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc -- generate a fail block even if it is not really needed. This would fail typechecking as -- a monad fail instance for such datatypes maynot be defined. cf. GHC.Hs.isIrrefutableHsPat mk_failable_lexpr_tcm pat lexpr fail_op = - do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) - PatBindRhs pat $ return id -- whatever - ; dflags <- getDynFlags - ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr tc_pat - , ppr $ isIrrefutableHsPat dflags tc_pat - , ppr $ isPatSynCon (unLoc tc_pat)]) - ; if isIrrefutableHsPat dflags tc_pat -- don't decorate with fail statement if the pattern is irrefutable - || (isPatSynCon (unLoc tc_pat)) -- pattern syns always get a fail block while desugaring so skip + do { tc_env <- getGblEnv + ; is_strict <- xoptM LangExt.Strict + ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr pat + , ppr $ isIrrefutableHsPatRn tc_env is_strict pat + ]) + + ; if isIrrefutableHsPatRn tc_env is_strict pat + -- don't decorate with fail statement if the pattern is irrefutable + -- pattern syns always get a fail block while desugaring so skip then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } - where isPatSynCon (ConPat {pat_con = L _ (PatSynCon _)}) = True - isPatSynCon _ = False + where -- makes the fail block -- TODO: check the discussion around MonadFail.fail type signature. @@ -1401,9 +1401,9 @@ mk_failable_lexpr_tcm pat lexpr fail_op = mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ + return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ (noLocA [ mkHsCaseAlt pat (noLocA $ PopSrcSpan lexpr) -- pat -> expr - , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" + , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) ])) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -20,6 +20,7 @@ module GHC.Tc.Gen.Pat , tcCheckPat, tcCheckPat_O, tcInferPat , tcPats , addDataConStupidTheta + , isIrrefutableHsPatRn ) where @@ -40,6 +41,7 @@ import GHC.Types.Id import GHC.Types.Var import GHC.Types.Name import GHC.Types.Name.Reader +import GHC.Types.TypeEnv (lookupTypeEnv) import GHC.Core.Multiplicity import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic ) import GHC.Tc.Utils.Env @@ -77,6 +79,7 @@ import GHC.Data.List.SetOps ( getNth ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import Data.List( partition ) +import Data.Maybe (isJust) {- ************************************************************************ @@ -1619,3 +1622,45 @@ checkGADT conlike ex_tvs arg_tys = \case where has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs + + +isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = goL pat + where + goL :: LPat GhcRn -> Bool + goL = go . unLoc + + go :: Pat GhcRn -> Bool + go (WildPat {}) = True + go (VarPat {}) = True + go (LazyPat _ p') + | is_strict + = isIrrefutableHsPatRn tc_env False p' + | otherwise = True + go (BangPat _ pat) = goL pat + go (ParPat _ _ pat _) = goL pat + go (AsPat _ _ _ pat) = goL pat + go (ViewPat _ _ pat) = goL pat + go (SigPat _ pat _) = goL pat + go (TuplePat _ pats _) = all goL pats + go (SumPat {}) = False + -- See Note [Unboxed sum patterns aren't irrefutable] + go (ListPat {}) = False + + go (ConPat + { pat_con = L _ dcName + , pat_args = details }) = case lookupTypeEnv type_env dcName of + Just (ATyCon con) -> + isJust (tyConSingleDataCon_maybe con) + && all goL (hsConPatArgs details) + _ -> False -- conservative. + go (LitPat {}) = False + go (NPat {}) = False + go (NPlusKPat {}) = False + + -- We conservatively assume that no TH splices are irrefutable + -- since we cannot know until the splice is evaluated. + go (SplicePat {}) = False + + go (XPat ext) = case ext of + HsPatExpanded _ pat -> go pat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b4570211c23fd8ab3b03843886782003203948b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b4570211c23fd8ab3b03843886782003203948b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 19:41:32 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 01 May 2023 15:41:32 -0400 Subject: [Git][ghc/ghc][wip/expand-do] a new check for irrefutable pattern Message-ID: <645015ec66f32_178e7415bee54ec2559185@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: f477fa38 by Apoorv Ingle at 2023-05-01T14:41:20-05:00 a new check for irrefutable pattern - - - - - 7 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/Language/Haskell/Syntax/Expr.hs - testsuite/tests/rebindable/T18324b.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -729,8 +729,8 @@ ppr_expr (XExpr x) = case ghcPass @p of ppr_expr (PopSrcSpan x) = case ghcPass @p of GhcPs -> panic "ppr_expr Ps HsPopSrcSpan" GhcRn -> ppr x - GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" - + GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" + instance Outputable XXExprGhcTc where ppr (WrapExpr (HsWrap co_fn e)) @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) - -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -502,6 +502,7 @@ looksLazyPat (VarPat {}) = False looksLazyPat (WildPat {}) = False looksLazyPat _ = True + isIrrefutableHsPat :: forall p. (OutputableBndrId p) => DynFlags -> LPat (GhcPass p) -> Bool -- (isIrrefutableHsPat p) is true if matching against p cannot fail, ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,14 +858,15 @@ warnDiscardedDoBindings rhs rhs_ty warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty - | Just (SrcSpanAnn _ l, f) <- fish_var fun + | Just (SrcSpanAnn _ l, (L (SrcSpanAnn _ loc) f)) <- fish_var fun , is_gen_then f -- , isNoSrcSpan l = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun , text "arg" <+> ppr arg , text "arg_ty" <+> ppr arg_ty , text "f" <+> ppr f <+> ppr (is_gen_then f) - , text "l" <+> ppr (isNoSrcSpan l)]) + , text "l" <+> ppr (isNoSrcSpan l) <+> ppr (isNoSrcSpan loc) + ]) warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application @@ -879,8 +880,8 @@ warnUnusedBindValue fun arg arg_ty fish_var _ = Nothing -- is this id a compiler generated (>>) with expanded do - is_gen_then :: LIdP GhcTc -> Bool - is_gen_then (L _ f) = f `hasKey` thenMClassOpKey + is_gen_then :: Id -> Bool + is_gen_then f = f `hasKey` thenMClassOpKey warnUnusedBindValue _ _ _ = return () ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -59,7 +59,6 @@ import GHC.Tc.Types.Evidence import GHC.Core.Multiplicity import GHC.Core.UsageEnv -import GHC.Core.ConLike import GHC.Core.TyCon -- Create chunkified tuple types for monad comprehensions import GHC.Core.Make @@ -81,6 +80,7 @@ import GHC.Types.Name import GHC.Types.Id import GHC.Types.SrcLoc import GHC.Types.Basic (Origin (..)) +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Control.Arrow ( second ) @@ -1237,8 +1237,8 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding x can fail -- instead of making an internal name, the fail block is just an anonymous match block --- stmts ~~> stmt' let / = stmts'; --- _ = fail ".."; +-- stmts ~~> stmt' let / pat = stmts'; +-- _ = fail "Pattern match failure .." -- ------------------------------------------------------- -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts @@ -1381,19 +1381,19 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc -- generate a fail block even if it is not really needed. This would fail typechecking as -- a monad fail instance for such datatypes maynot be defined. cf. GHC.Hs.isIrrefutableHsPat mk_failable_lexpr_tcm pat lexpr fail_op = - do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) - PatBindRhs pat $ return id -- whatever - ; dflags <- getDynFlags - ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr tc_pat - , ppr $ isIrrefutableHsPat dflags tc_pat - , ppr $ isPatSynCon (unLoc tc_pat)]) - ; if isIrrefutableHsPat dflags tc_pat -- don't decorate with fail statement if the pattern is irrefutable - || (isPatSynCon (unLoc tc_pat)) -- pattern syns always get a fail block while desugaring so skip + do { tc_env <- getGblEnv + ; is_strict <- xoptM LangExt.Strict + ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr pat + , ppr $ isIrrefutableHsPatRn tc_env is_strict pat + ]) + + ; if isIrrefutableHsPatRn tc_env is_strict pat + -- don't decorate with fail statement if the pattern is irrefutable + -- pattern syns always get a fail block while desugaring so skip then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } - where isPatSynCon (ConPat {pat_con = L _ (PatSynCon _)}) = True - isPatSynCon _ = False + where -- makes the fail block -- TODO: check the discussion around MonadFail.fail type signature. @@ -1401,9 +1401,9 @@ mk_failable_lexpr_tcm pat lexpr fail_op = mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ + return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ (noLocA [ mkHsCaseAlt pat (noLocA $ PopSrcSpan lexpr) -- pat -> expr - , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" + , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) ])) @@ -1415,3 +1415,10 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = <+> text "at" <+> ppr (getLocA pat) mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty + +{- Note [Desugaring Do with HsExpansion] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We expand do blocks before typeching it rather than after type checking it +TODO expand using examples + +-} ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -20,6 +20,7 @@ module GHC.Tc.Gen.Pat , tcCheckPat, tcCheckPat_O, tcInferPat , tcPats , addDataConStupidTheta + , isIrrefutableHsPatRn ) where @@ -40,6 +41,7 @@ import GHC.Types.Id import GHC.Types.Var import GHC.Types.Name import GHC.Types.Name.Reader +import GHC.Types.TypeEnv (lookupTypeEnv) import GHC.Core.Multiplicity import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic ) import GHC.Tc.Utils.Env @@ -77,6 +79,7 @@ import GHC.Data.List.SetOps ( getNth ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import Data.List( partition ) +import Data.Maybe (isJust) {- ************************************************************************ @@ -1619,3 +1622,45 @@ checkGADT conlike ex_tvs arg_tys = \case where has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs + + +isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = goL pat + where + goL :: LPat GhcRn -> Bool + goL = go . unLoc + + go :: Pat GhcRn -> Bool + go (WildPat {}) = True + go (VarPat {}) = True + go (LazyPat _ p') + | is_strict + = isIrrefutableHsPatRn tc_env False p' + | otherwise = True + go (BangPat _ pat) = goL pat + go (ParPat _ _ pat _) = goL pat + go (AsPat _ _ _ pat) = goL pat + go (ViewPat _ _ pat) = goL pat + go (SigPat _ pat _) = goL pat + go (TuplePat _ pats _) = all goL pats + go (SumPat {}) = False + -- See Note [Unboxed sum patterns aren't irrefutable] + go (ListPat {}) = False + + go (ConPat + { pat_con = L _ dcName + , pat_args = details }) = case lookupTypeEnv type_env dcName of + Just (ATyCon con) -> + isJust (tyConSingleDataCon_maybe con) + && all goL (hsConPatArgs details) + _ -> False -- conservative. + go (LitPat {}) = False + go (NPat {}) = False + go (NPlusKPat {}) = False + + -- We conservatively assume that no TH splices are irrefutable + -- since we cannot know until the splice is evaluated. + go (SplicePat {}) = False + + go (XPat ext) = case ext of + HsPatExpanded _ pat -> go pat ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -587,7 +587,7 @@ data HsExpr p | PopSrcSpan (LHsExpr p) -- Placeholder for identifying generated source locations in GhcRn phase -- Should not presist post typechecking - -- Note [Desugaring Do with HsExpansion] TODO + -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match -- --------------------------------------------------------------------- ===================================== testsuite/tests/rebindable/T18324b.hs ===================================== @@ -14,7 +14,7 @@ unLoc (L _ e) = e data B = B -type family Anno a = b +type family Anno a = b type family XRec p a = r | r -> a type instance XRec (GhcPass p) a = L (Anno a) a @@ -33,17 +33,14 @@ type GhcRn = GhcPass 'Rn data ClsInstDecl pass = ClsInstDecl { cid_datafam_insts :: LDataFamInstDecl pass } - --- type LTyFamInstDecl pass = XRec pass (TyFamInstDecl pass) type LDataFamInstDecl pass = XRec pass ([FamEqn pass (HsDataDefn pass)]) --- type TyFamDefltDecl = TyFamInstDecl type family IdP p type instance IdP (GhcPass p) = IdGhcP p type LIdP p = XRec p (IdP p) -data HsDataDefn pass +data HsDataDefn pass data FamEqn pass rhs = FamEqn @@ -54,7 +51,9 @@ fffggg :: ClsInstDecl GhcRn -> [Int] fffggg ddd = -- let do FamEqn { feqn_tycon = L _ _ - , feqn_rhs = _ } {-:: FamEqn GhcRn (HsDataDefn GhcRn)-} <- unLoc $ cid_datafam_insts ddd - [ 0 ] - - + , feqn_rhs = defns } :: FamEqn GhcRn (HsDataDefn GhcRn) <- unLoc $ cid_datafam_insts ddd + [ 0 ] ++ dataSubs defns + where + dataSubs :: HsDataDefn GhcRn + -> [Int] + dataSubs = undefined View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f477fa38f40b35768110a7005578773ac8db7c17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f477fa38f40b35768110a7005578773ac8db7c17 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 20:11:47 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 01 May 2023 16:11:47 -0400 Subject: [Git][ghc/ghc][wip/expand-do] a new check for irrefutable pattern Message-ID: <64501d03882d_178e7415c4c1e88256018a@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 9201e4ce by Apoorv Ingle at 2023-05-01T15:11:25-05:00 a new check for irrefutable pattern - - - - - 9 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/Language/Haskell/Syntax/Expr.hs - testsuite/tests/rebindable/T18324b.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -729,8 +729,8 @@ ppr_expr (XExpr x) = case ghcPass @p of ppr_expr (PopSrcSpan x) = case ghcPass @p of GhcPs -> panic "ppr_expr Ps HsPopSrcSpan" GhcRn -> ppr x - GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" - + GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" + instance Outputable XXExprGhcTc where ppr (WrapExpr (HsWrap co_fn e)) @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) - -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -502,6 +502,7 @@ looksLazyPat (VarPat {}) = False looksLazyPat (WildPat {}) = False looksLazyPat _ = True + isIrrefutableHsPat :: forall p. (OutputableBndrId p) => DynFlags -> LPat (GhcPass p) -> Bool -- (isIrrefutableHsPat p) is true if matching against p cannot fail, ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,14 +858,15 @@ warnDiscardedDoBindings rhs rhs_ty warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty - | Just (SrcSpanAnn _ l, f) <- fish_var fun + | Just (SrcSpanAnn _ l, (L (SrcSpanAnn _ loc) f)) <- fish_var fun , is_gen_then f -- , isNoSrcSpan l = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun , text "arg" <+> ppr arg , text "arg_ty" <+> ppr arg_ty , text "f" <+> ppr f <+> ppr (is_gen_then f) - , text "l" <+> ppr (isNoSrcSpan l)]) + , text "l" <+> ppr (isNoSrcSpan l) <+> ppr (isNoSrcSpan loc) + ]) warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application @@ -879,8 +880,8 @@ warnUnusedBindValue fun arg arg_ty fish_var _ = Nothing -- is this id a compiler generated (>>) with expanded do - is_gen_then :: LIdP GhcTc -> Bool - is_gen_then (L _ f) = f `hasKey` thenMClassOpKey + is_gen_then :: Id -> Bool + is_gen_then f = f `hasKey` thenMClassOpKey warnUnusedBindValue _ _ _ = return () ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -605,6 +605,7 @@ addTickHsExpr (XExpr (HsTick t e)) = liftM (XExpr . HsTick t) (addTickLHsExprNever e) addTickHsExpr (XExpr (HsBinTick t0 t1 e)) = liftM (XExpr . HsBinTick t0 t1) (addTickLHsExprNever e) +addTickHsExpr e@(PopSrcSpan _) = pprPanic "addTickHsExpr: impossible happen PopSrcSpan" (ppr e) addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc) addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -59,7 +59,6 @@ import GHC.Tc.Types.Evidence import GHC.Core.Multiplicity import GHC.Core.UsageEnv -import GHC.Core.ConLike import GHC.Core.TyCon -- Create chunkified tuple types for monad comprehensions import GHC.Core.Make @@ -81,6 +80,7 @@ import GHC.Types.Name import GHC.Types.Id import GHC.Types.SrcLoc import GHC.Types.Basic (Origin (..)) +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Control.Arrow ( second ) @@ -1237,8 +1237,8 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding x can fail -- instead of making an internal name, the fail block is just an anonymous match block --- stmts ~~> stmt' let / = stmts'; --- _ = fail ".."; +-- stmts ~~> stmt' let / pat = stmts'; +-- _ = fail "Pattern match failure .." -- ------------------------------------------------------- -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts @@ -1381,19 +1381,19 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc -- generate a fail block even if it is not really needed. This would fail typechecking as -- a monad fail instance for such datatypes maynot be defined. cf. GHC.Hs.isIrrefutableHsPat mk_failable_lexpr_tcm pat lexpr fail_op = - do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) - PatBindRhs pat $ return id -- whatever - ; dflags <- getDynFlags - ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr tc_pat - , ppr $ isIrrefutableHsPat dflags tc_pat - , ppr $ isPatSynCon (unLoc tc_pat)]) - ; if isIrrefutableHsPat dflags tc_pat -- don't decorate with fail statement if the pattern is irrefutable - || (isPatSynCon (unLoc tc_pat)) -- pattern syns always get a fail block while desugaring so skip + do { tc_env <- getGblEnv + ; is_strict <- xoptM LangExt.Strict + ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr pat + , ppr $ isIrrefutableHsPatRn tc_env is_strict pat + ]) + + ; if isIrrefutableHsPatRn tc_env is_strict pat + -- don't decorate with fail statement if the pattern is irrefutable + -- pattern syns always get a fail block while desugaring so skip then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } - where isPatSynCon (ConPat {pat_con = L _ (PatSynCon _)}) = True - isPatSynCon _ = False + where -- makes the fail block -- TODO: check the discussion around MonadFail.fail type signature. @@ -1401,9 +1401,9 @@ mk_failable_lexpr_tcm pat lexpr fail_op = mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ + return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ (noLocA [ mkHsCaseAlt pat (noLocA $ PopSrcSpan lexpr) -- pat -> expr - , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" + , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) ])) @@ -1415,3 +1415,10 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = <+> text "at" <+> ppr (getLocA pat) mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty + +{- Note [Desugaring Do with HsExpansion] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We expand do blocks before typeching it rather than after type checking it +TODO expand using examples + +-} ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -20,6 +20,7 @@ module GHC.Tc.Gen.Pat , tcCheckPat, tcCheckPat_O, tcInferPat , tcPats , addDataConStupidTheta + , isIrrefutableHsPatRn ) where @@ -40,6 +41,7 @@ import GHC.Types.Id import GHC.Types.Var import GHC.Types.Name import GHC.Types.Name.Reader +import GHC.Types.TypeEnv (lookupTypeEnv) import GHC.Core.Multiplicity import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic ) import GHC.Tc.Utils.Env @@ -77,6 +79,7 @@ import GHC.Data.List.SetOps ( getNth ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import Data.List( partition ) +import Data.Maybe (isJust) {- ************************************************************************ @@ -1619,3 +1622,45 @@ checkGADT conlike ex_tvs arg_tys = \case where has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs + + +isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = goL pat + where + goL :: LPat GhcRn -> Bool + goL = go . unLoc + + go :: Pat GhcRn -> Bool + go (WildPat {}) = True + go (VarPat {}) = True + go (LazyPat _ p') + | is_strict + = isIrrefutableHsPatRn tc_env False p' + | otherwise = True + go (BangPat _ pat) = goL pat + go (ParPat _ _ pat _) = goL pat + go (AsPat _ _ _ pat) = goL pat + go (ViewPat _ _ pat) = goL pat + go (SigPat _ pat _) = goL pat + go (TuplePat _ pats _) = all goL pats + go (SumPat {}) = False + -- See Note [Unboxed sum patterns aren't irrefutable] + go (ListPat {}) = False + + go (ConPat + { pat_con = L _ dcName + , pat_args = details }) = case lookupTypeEnv type_env dcName of + Just (ATyCon con) -> + isJust (tyConSingleDataCon_maybe con) + && all goL (hsConPatArgs details) + _ -> False -- conservative. + go (LitPat {}) = False + go (NPat {}) = False + go (NPlusKPat {}) = False + + -- We conservatively assume that no TH splices are irrefutable + -- since we cannot know until the splice is evaluated. + go (SplicePat {}) = False + + go (XPat ext) = case ext of + HsPatExpanded _ pat -> go pat ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -725,6 +725,7 @@ exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice" exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" exprCtOrigin (XExpr (HsExpanded a _)) = exprCtOrigin a +exprCtOrigin (PopSrcSpan (L _ e)) = exprCtOrigin e -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -587,7 +587,7 @@ data HsExpr p | PopSrcSpan (LHsExpr p) -- Placeholder for identifying generated source locations in GhcRn phase -- Should not presist post typechecking - -- Note [Desugaring Do with HsExpansion] TODO + -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match -- --------------------------------------------------------------------- ===================================== testsuite/tests/rebindable/T18324b.hs ===================================== @@ -14,7 +14,7 @@ unLoc (L _ e) = e data B = B -type family Anno a = b +type family Anno a = b type family XRec p a = r | r -> a type instance XRec (GhcPass p) a = L (Anno a) a @@ -33,17 +33,14 @@ type GhcRn = GhcPass 'Rn data ClsInstDecl pass = ClsInstDecl { cid_datafam_insts :: LDataFamInstDecl pass } - --- type LTyFamInstDecl pass = XRec pass (TyFamInstDecl pass) type LDataFamInstDecl pass = XRec pass ([FamEqn pass (HsDataDefn pass)]) --- type TyFamDefltDecl = TyFamInstDecl type family IdP p type instance IdP (GhcPass p) = IdGhcP p type LIdP p = XRec p (IdP p) -data HsDataDefn pass +data HsDataDefn pass data FamEqn pass rhs = FamEqn @@ -54,7 +51,9 @@ fffggg :: ClsInstDecl GhcRn -> [Int] fffggg ddd = -- let do FamEqn { feqn_tycon = L _ _ - , feqn_rhs = _ } {-:: FamEqn GhcRn (HsDataDefn GhcRn)-} <- unLoc $ cid_datafam_insts ddd - [ 0 ] - - + , feqn_rhs = defns } :: FamEqn GhcRn (HsDataDefn GhcRn) <- unLoc $ cid_datafam_insts ddd + [ 0 ] ++ dataSubs defns + where + dataSubs :: HsDataDefn GhcRn + -> [Int] + dataSubs = undefined View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9201e4ce457cfc82d5c574b81833066b2b7325d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9201e4ce457cfc82d5c574b81833066b2b7325d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 20:54:32 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 01 May 2023 16:54:32 -0400 Subject: [Git][ghc/ghc][wip/t23315] Insert documentation into parsed signature modules Message-ID: <64502708d3272_178e7415d27011025628c7@gitlab.mail> Finley McIlwaine pushed to branch wip/t23315 at Glasgow Haskell Compiler / GHC Commits: 37f93685 by Finley McIlwaine at 2023-05-01T14:53:55-06:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 7 changed files: - compiler/GHC/Parser.y - + testsuite/tests/parser/should_compile/T23315/Makefile - + testsuite/tests/parser/should_compile/T23315/Setup.hs - + testsuite/tests/parser/should_compile/T23315/T23315.cabal - + testsuite/tests/parser/should_compile/T23315/T23315.hsig - + testsuite/tests/parser/should_compile/T23315/T23315.stderr - + testsuite/tests/parser/should_compile/T23315/all.T Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -743,7 +743,7 @@ TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } -- Exported parsers %name parseModuleNoHaddock module -%name parseSignature signature +%name parseSignatureNoHaddock signature %name parseImport importdecl %name parseStatement e_stmt %name parseDeclaration topdecl @@ -4376,18 +4376,29 @@ pvL :: MonadP m => m (LocatedAn t a) -> m (Located a) pvL a = do { av <- a ; return (reLoc av) } --- | Parse a Haskell module with Haddock comments. --- This is done in two steps: +-- | Parse a Haskell module with Haddock comments. This is done in two steps: -- -- * 'parseModuleNoHaddock' to build the AST -- * 'addHaddockToModule' to insert Haddock comments into it -- --- This is the only parser entry point that deals with Haddock comments. --- The other entry points ('parseDeclaration', 'parseExpression', etc) do --- not insert them into the AST. +-- This and the signature module parser are the only parser entry points that +-- deal with Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. parseModule :: P (Located (HsModule GhcPs)) parseModule = parseModuleNoHaddock >>= addHaddockToModule +-- | Parse a Haskell signature module with Haddock comments. This is done in two +-- steps: +-- +-- * 'parseSignatureNoHaddock' to build the AST +-- * 'addHaddockToModule' to insert Haddock comments into it +-- +-- This and the module parser are the only parser entry points that deal with +-- Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. +parseSignature :: P (Located (HsModule GhcPs)) +parseSignature = parseSignatureNoHaddock >>= addHaddockToModule + commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc ===================================== testsuite/tests/parser/should_compile/T23315/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +T23315: clean + $(MAKE) clean + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build 1>&2 +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi ===================================== testsuite/tests/parser/should_compile/T23315/Setup.hs ===================================== @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file ===================================== testsuite/tests/parser/should_compile/T23315/T23315.cabal ===================================== @@ -0,0 +1,10 @@ +name: T23315 +version: 0.1.0.0 +build-type: Simple +cabal-version: 2.0 + +library + signatures: T23315 + build-depends: base >= 4.3 && < 5 + default-language: Haskell2010 + ghc-options: -Wall -haddock -ddump-parsed-ast ===================================== testsuite/tests/parser/should_compile/T23315/T23315.hsig ===================================== @@ -0,0 +1,4 @@ +signature T23315 where +-- | My unit +a :: () +-- ^ More docs ===================================== testsuite/tests/parser/should_compile/T23315/T23315.stderr ===================================== @@ -0,0 +1,112 @@ + +==================== Parser AST ==================== + +(L + { T23315.hsig:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T23315.hsig:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 })) + ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))] + [] + (Nothing)) + (EpaComments + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:1:11-16 }) + {ModuleName: T23315})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:2:1-12 }) + (DocD + (NoExtField) + (DocCommentNext + (L + { T23315.hsig:2:1-12 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T23315.hsig:2:5-12 } + (HsDocStringChunk + " My unit")) + [])) + []))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T23315.hsig:3:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T23315.hsig:3:1-7 }) + (SigD + (NoExtField) + (TypeSig + (EpAnn + (Anchor + { T23315.hsig:3:1 } + (UnchangedAnchor)) + (AnnSig + (AddEpAnn AnnDcolon (EpaSpan { T23315.hsig:3:3-4 })) + []) + (EpaComments + [])) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:1 }) + (Unqual + {OccName: a}))] + (HsWC + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsTupleTy + (EpAnn + (Anchor + { T23315.hsig:3:6 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { T23315.hsig:3:6 }) + (EpaSpan { T23315.hsig:3:7 })) + (EpaComments + [])) + (HsBoxedOrConstraintTuple) + [])))))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:4:1-14 }) + (DocD + (NoExtField) + (DocCommentPrev + (L + { T23315.hsig:4:1-14 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringPrevious) + (:| + (L + { T23315.hsig:4:5-14 } + (HsDocStringChunk + " More docs")) + [])) + [])))))])) + + ===================================== testsuite/tests/parser/should_compile/T23315/all.T ===================================== @@ -0,0 +1,3 @@ +test('T23315', + [extra_files(['Setup.hs']), js_broken(22352)], + makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37f936856fcccb61cf52e57a08cbfa54a86e3c78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37f936856fcccb61cf52e57a08cbfa54a86e3c78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 21:41:49 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 May 2023 17:41:49 -0400 Subject: [Git][ghc/ghc][wip/T23070-unify] Use the eager unifier in the constraint solver Message-ID: <6450321d5f058_178e7415dd721f8256837f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-unify at Glasgow Haskell Compiler / GHC Commits: 06072d2f by Simon Peyton Jones at 2023-05-01T22:43:20+01:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 28 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/06072d2f547e84af96c07bd21091773135ffc6c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/06072d2f547e84af96c07bd21091773135ffc6c9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 1 21:51:21 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 01 May 2023 17:51:21 -0400 Subject: [Git][ghc/ghc][wip/T23307] 5 commits: Add the Unsatisfiable class Message-ID: <64503459e98_178e7415e21f4bc25704a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23307 at Glasgow Haskell Compiler / GHC Commits: 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - fbdea779 by Simon Peyton Jones at 2023-05-01T19:55:08+01:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - b4cf71f8 by Simon Peyton Jones at 2023-05-01T19:55:08+01:00 Wibbles - - - - - 79aa2318 by Simon Peyton Jones at 2023-05-01T22:52:47+01:00 Make it even more clever adding T23307a - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Id/Make.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/GHC/TypeError.hs - libraries/base/changelog.md - testsuite/tests/deriving/should_compile/T17324.stderr - testsuite/tests/driver/t22391/t22391.stderr - testsuite/tests/driver/t22391/t22391j.stderr - testsuite/tests/ghci/prog018/prog018.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30365bebdd0eeae3ccf7386a2b08ac2bfafd07cf...79aa2318ed1909f25e04b849896bf74e5f66d4f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30365bebdd0eeae3ccf7386a2b08ac2bfafd07cf...79aa2318ed1909f25e04b849896bf74e5f66d4f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 00:06:48 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Mon, 01 May 2023 20:06:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23329 Message-ID: <645054186efe4_178e7416056e5942578892@gitlab.mail> Ryan Scott pushed new branch wip/T23329 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23329 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 00:11:26 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Mon, 01 May 2023 20:11:26 -0400 Subject: [Git][ghc/ghc][wip/T23329] Fix type variable substitution in gen_Newtype_fam_insts Message-ID: <6450552e8061e_178e741607247d02582350@gitlab.mail> Ryan Scott pushed to branch wip/T23329 at Glasgow Haskell Compiler / GHC Commits: c3e83ddb by Ryan Scott at 2023-05-01T20:11:17-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch copies the same code over to `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 5 changed files: - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/TyCl/Class.hs - + testsuite/tests/deriving/should_compile/T23329.hs - + testsuite/tests/deriving/should_compile/T23329_M.hs - testsuite/tests/deriving/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -92,7 +92,7 @@ import GHC.Unit.Module import Language.Haskell.Syntax.Basic (FieldLabelString(..)) -import Data.List ( find, partition, intersperse ) +import Data.List ( find, mapAccumL, partition, intersperse ) -- | A declarative description of an auxiliary binding that should be -- generated. See @Note [Auxiliary binders]@ for a more detailed description @@ -2089,6 +2089,18 @@ gen_Newtype_fam_insts loc' cls inst_tvs inst_tys rhs_ty rhs_env = zipTyEnv cls_tvs underlying_inst_tys rhs_subst = mkTvSubst in_scope rhs_env + subst_tvs :: Subst -> [TyVar] -> (Subst, [Type]) + subst_tvs = mapAccumL subst_tv + + subst_tv :: Subst -> TyVar -> (Subst, Type) + subst_tv subst tc_tv + | Just ty <- lookupVarEnv (getTvSubstEnv subst) tc_tv + = (subst, ty) + | otherwise + = (extendTvSubst subst tc_tv ty', ty') + where + ty' = mkTyVarTy (updateTyVarKind (substTyUnchecked subst) tc_tv) + mk_atf_inst :: TyCon -> TcM FamInst mk_atf_inst fam_tc = do rep_tc_name <- newFamInstTyConName (L locn (tyConName fam_tc)) @@ -2100,8 +2112,8 @@ gen_Newtype_fam_insts loc' cls inst_tvs inst_tys rhs_ty newFamInst SynFamilyInst axiom where fam_tvs = tyConTyVars fam_tc - rep_lhs_tys = substTyVars lhs_subst fam_tvs - rep_rhs_tys = substTyVars rhs_subst fam_tvs + (_, rep_lhs_tys) = subst_tvs lhs_subst fam_tvs + (_, rep_rhs_tys) = subst_tvs rhs_subst fam_tvs rep_rhs_ty = mkTyConApp fam_tc rep_rhs_tys rep_tcvs = tyCoVarsOfTypesList rep_lhs_tys (rep_tvs, rep_cvs) = partition isTyVar rep_tcvs ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -526,6 +526,7 @@ tcATDefault loc inst_subst defined_ats (ATI fam_tc defs) = do { warnMissingAT (tyConName fam_tc) ; return [] } where + subst_tv :: Subst -> TyVar -> (Subst, Type) subst_tv subst tc_tv | Just ty <- lookupVarEnv (getTvSubstEnv subst) tc_tv = (subst, ty) ===================================== testsuite/tests/deriving/should_compile/T23329.hs ===================================== @@ -0,0 +1,9 @@ +module T23329 where + +import Data.Kind (Type) +import Data.Proxy (Proxy(Proxy)) + +import T23329_M + +foo :: () +foo = myMethod @Type @MyMaybe @() () Proxy Proxy ===================================== testsuite/tests/deriving/should_compile/T23329_M.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T23329_M where + +import Data.Kind (Type) +import Data.Proxy (Proxy) + +class MyClass (f :: k -> Type) where + type MyTypeFamily f (i :: k) :: Type + myMethod :: MyTypeFamily f i -> Proxy f -> Proxy i -> () + +instance MyClass Maybe where + type MyTypeFamily Maybe i = () + myMethod = undefined + +newtype MyMaybe a = MyMaybe (Maybe a) + deriving MyClass ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -141,3 +141,4 @@ test('T20994', normal, compile, ['']) test('T22167', normal, compile, ['']) test('T22696a', normal, compile, ['']) test('T22696c', normal, compile, ['']) +test('T23329', normal, multimod_compile, ['T23329', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3e83ddb4c4cb2ef4c263bc350ee452ba8c4a30d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3e83ddb4c4cb2ef4c263bc350ee452ba8c4a30d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 07:44:57 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Tue, 02 May 2023 03:44:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/riscv-moritz-rebase Message-ID: <6450bf79ddeb5_178e74167abb57c260784f@gitlab.mail> Sven Tennie pushed new branch wip/riscv-moritz-rebase at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/riscv-moritz-rebase You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 08:55:51 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 02 May 2023 04:55:51 -0400 Subject: [Git][ghc/ghc][wip/ghcup-metadata-nightly] Testing Message-ID: <6450d01742068_178e74168df9ef426269b7@gitlab.mail> Matthew Pickering pushed to branch wip/ghcup-metadata-nightly at Glasgow Haskell Compiler / GHC Commits: f2af4694 by GHC GitLab CI at 2023-05-02T09:43:55+01:00 Testing - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -999,7 +999,7 @@ project-version: - . ./version.sh # Download existing ghcup metadata - - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://gitlab.haskell.org/ghc/ghcup-metadata/-/raw/main/ghcup-0.0.7.yaml" + - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://gitlab.haskell.org/ghc/ghcup-metadata/-/raw/updates/ghcup-0.0.7.yaml" - .gitlab/generate_job_metadata @@ -1072,7 +1072,7 @@ ghcup-metadata-nightly-push: - git remote add gitlab_origin https://oauth2:$PROJECT_PUSH_TOKEN at gitlab.haskell.org/ghc/ghcup-metadata.git - git add . - git commit -m "Update metadata" - - git push gitlab_origin HEAD:main -o ci.skip + - git push gitlab_origin HEAD:updates -o ci.skip rules: - if: $NIGHTLY # - if: $CI_PIPELINE_SOURCE == "schedule" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f2af46940ac4d2a40d71af67e3d419b307485157 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f2af46940ac4d2a40d71af67e3d419b307485157 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 09:24:50 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 02 May 2023 05:24:50 -0400 Subject: [Git][ghc/ghc][wip/ghcup-metadata-nightly] 38 commits: hadrian: Pass haddock file arguments in a response file Message-ID: <6450d6e295d65_178e74169717cfc26391a3@gitlab.mail> Matthew Pickering pushed to branch wip/ghcup-metadata-nightly at Glasgow Haskell Compiler / GHC Commits: f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - a864418d by GHC GitLab CI at 2023-05-02T10:02:05+01:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/CSE.hs - compiler/GHC/Stg/Debug.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2af46940ac4d2a40d71af67e3d419b307485157...a864418d1422da2fe185a51fc7a24c51de7b92ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2af46940ac4d2a40d71af67e3d419b307485157...a864418d1422da2fe185a51fc7a24c51de7b92ff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 09:25:30 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 02 May 2023 05:25:30 -0400 Subject: [Git][ghc/ghc][wip/ghcup-metadata-nightly] Incrementally update ghcup metadata in ghc/ghcup-metadata Message-ID: <6450d70a5125c_178e741697657f4263937c@gitlab.mail> Matthew Pickering pushed to branch wip/ghcup-metadata-nightly at Glasgow Haskell Compiler / GHC Commits: 7f382a00 by Matthew Pickering at 2023-05-02T10:25:23+01:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -999,7 +999,7 @@ project-version: - . ./version.sh # Download existing ghcup metadata - - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-0.0.7.yaml" + - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://gitlab.haskell.org/ghc/ghcup-metadata/-/raw/updates/ghcup-0.0.7.yaml" - .gitlab/generate_job_metadata @@ -1048,6 +1048,37 @@ ghcup-metadata-nightly: rules: - if: $NIGHTLY +# Update the +ghcup-metadata-nightly-push: + stage: deploy + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + dependencies: null + tags: + - x86_64-linux + variables: + BUILD_FLAVOUR: default + GIT_SUBMODULE_STRATEGY: "none" + needs: + - job: ghcup-metadata-nightly + artifacts: true + script: + - git clone https://gitlab.haskell.org/ghc/ghcup-metadata.git + - cp metadata_test.yaml ghcup-metadata/ghcup-0.0.7.yaml + - cd ghcup-metadata + - git config user.email "ghc-ci at gitlab-haskell.org" + - git config user.name "GHC GitLab CI" + - git remote add gitlab_origin https://oauth2:$PROJECT_PUSH_TOKEN at gitlab.haskell.org/ghc/ghcup-metadata.git + - git add . + - git commit -m "Update metadata" + - git push gitlab_origin HEAD:updates -o ci.skip + rules: + - if: $NIGHTLY + # Only run the update on scheduled nightly pipelines, ie once a day + - if: $CI_PIPELINE_SOURCE == "schedule" + # And only update the metadata for master branch + - if: '$CI_COMMIT_BRANCH == "master"' + + ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f382a007930c03662573f2ce33cd3a93477d554 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f382a007930c03662573f2ce33cd3a93477d554 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 09:26:10 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 02 May 2023 05:26:10 -0400 Subject: [Git][ghc/ghc][wip/ghcup-metadata-nightly] Incrementally update ghcup metadata in ghc/ghcup-metadata Message-ID: <6450d732becbf_178e7416989069c26395dc@gitlab.mail> Matthew Pickering pushed to branch wip/ghcup-metadata-nightly at Glasgow Haskell Compiler / GHC Commits: b5de89fe by Matthew Pickering at 2023-05-02T10:25:47+01:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -999,7 +999,7 @@ project-version: - . ./version.sh # Download existing ghcup metadata - - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-0.0.7.yaml" + - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://gitlab.haskell.org/ghc/ghcup-metadata/-/raw/updates/ghcup-0.0.7.yaml" - .gitlab/generate_job_metadata @@ -1048,6 +1048,37 @@ ghcup-metadata-nightly: rules: - if: $NIGHTLY +# Update the +ghcup-metadata-nightly-push: + stage: deploy + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + dependencies: null + tags: + - x86_64-linux + variables: + BUILD_FLAVOUR: default + GIT_SUBMODULE_STRATEGY: "none" + needs: + - job: ghcup-metadata-nightly + artifacts: true + script: + - git clone https://gitlab.haskell.org/ghc/ghcup-metadata.git + - cp metadata_test.yaml ghcup-metadata/ghcup-0.0.7.yaml + - cd ghcup-metadata + - git config user.email "ghc-ci at gitlab-haskell.org" + - git config user.name "GHC GitLab CI" + - git remote add gitlab_origin https://oauth2:$PROJECT_PUSH_TOKEN at gitlab.haskell.org/ghc/ghcup-metadata.git + - git add . + - git commit -m "Update metadata" + - git push gitlab_origin HEAD:updates -o ci.skip + rules: + - if: $NIGHTLY + # Only run the update on scheduled nightly pipelines, ie once a day + - if: $CI_PIPELINE_SOURCE == "schedule" + # And only update the metadata for master branch + - if: '$CI_COMMIT_BRANCH == "master"' + + ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5de89fec18270c18fb60369931131bfd41d780b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5de89fec18270c18fb60369931131bfd41d780b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 11:54:54 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 02 May 2023 07:54:54 -0400 Subject: [Git][ghc/ghc][wip/codebuffer-perftest] base/encoding: add an allocations performance test (#22946) Message-ID: <6450fa0e9a228_178e7416be82c24269462c@gitlab.mail> Josh Meredith pushed to branch wip/codebuffer-perftest at Glasgow Haskell Compiler / GHC Commits: 5b8f25c4 by Josh Meredith at 2023-05-02T11:54:40+00:00 base/encoding: add an allocations performance test (#22946) - - - - - 2 changed files: - libraries/base/tests/perf/all.T - + libraries/base/tests/perf/encodingAllocations.hs Changes: ===================================== libraries/base/tests/perf/all.T ===================================== @@ -1,5 +1,14 @@ +# .stats files aren't yet supported in the JS backend +setTestOpts(js_skip) + #-------------------------------------- # Check specialization of elem via rules #-------------------------------------- test('T17752', [only_ways(['normal'])] , makefile_test, ['T17752']) + +#-------------------------------------- + +# We don't expect the code in test to vary at all, but the variance is set to +# 1% in case the constant allocations increase by other means. +test('encodingAllocations', [only_ways(['normal']), collect_stats('bytes allocated', 1)], compile_and_run, ['-O2']) ===================================== libraries/base/tests/perf/encodingAllocations.hs ===================================== @@ -0,0 +1,30 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -dno-typeable-binds -O2 #-} + +module Main (main) where + +import System.IO +import Data.Bits +import GHC.Int +import GHC.Exts +import System.Environment +import Distribution.Simple.Utils + + +main :: IO () +main = withTempFile "." "encodingAllocations.tmp" (const $ loop 1000000) + +loop :: Int -> Handle -> IO () +loop 0 !_ = pure () +loop !n !h = do + hPutChar h $! dummy_char n + loop (n-1) h + +-- unsafe efficient version of `chr` +my_chr :: Int -> Char +my_chr (I# i) = C# (chr# i) + +-- return either a or b +dummy_char :: Int -> Char +dummy_char !i = my_chr ((i .&. 1) + 97) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b8f25c466bdc0f5345cbc020c207d94540d84f8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b8f25c466bdc0f5345cbc020c207d94540d84f8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 12:04:47 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 02 May 2023 08:04:47 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <6450fc5f9b69a_178e7416c3678342699560@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: f9fd8f57 by Josh Meredith at 2023-05-02T12:04:22+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 6 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS @@ -22,7 +23,6 @@ module GHC.JS.Transform , composOpM_ , composOpFold , satJExpr - , satJStat ) where @@ -200,54 +200,34 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) - where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v - +jsSaturate :: Maybe FastString -> JStat -> Sat.JStat +jsSaturate str x = evalState (go x) (newIdentSupply str) + where + go :: JStat -> State [Ident] Sat.JStat + go = \case + DeclStat i rhs -> return $ Sat.DeclStat i (fmap satJExpr rhs) + ReturnStat e -> return $ Sat.ReturnStat (satJExpr e) + IfStat c t e -> Sat.IfStat (satJExpr c) <$> go t <*> go e + WhileStat is_do c e -> Sat.WhileStat is_do (satJExpr c) <$> go e + ForInStat is_each i iter body -> Sat.ForInStat is_each i (satJExpr iter) <$> go body + SwitchStat struct ps def -> Sat.SwitchStat (satJExpr struct) + <$> mapM (\(p1, p2) -> (satJExpr p1,) <$> go p2) ps + <*> go def + TryStat t i c f -> Sat.TryStat <$> go t <*> pure i <*> go c <*> go f + BlockStat bs -> fmap Sat.BlockStat $! mapM go bs + ApplStat rator rand -> return $ Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) + UOpStat rator rand -> return $ Sat.UOpStat (satJUOp rator) (satJExpr rand) + AssignStat lhs rhs -> return $ Sat.AssignStat (satJExpr lhs) (satJExpr rhs) + LabelStat lbl stmt -> Sat.LabelStat lbl <$> go stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + UnsatBlock us -> go =<< runIdentSupply us -------------------------------------------------------------------------------- -- Translation -- -- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - satJExpr :: JExpr -> Sat.JExpr satJExpr = go @@ -315,5 +295,5 @@ satJVal = go go (JStr f) = Sat.JStr f go (JRegEx f) = Sat.JRegEx f go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) + go (JFunc args body) = Sat.JFunc args (jsSaturate Nothing body) go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a +saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat +rtsDecls :: Sat.JStat rtsDecls = jsSaturate (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread @@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat +rts :: StgToJSConfig -> Sat.JStat rts = jsSaturate (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9fd8f57c4dd5a871770df7165dbd1647064ddf7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9fd8f57c4dd5a871770df7165dbd1647064ddf7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 12:19:49 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 02 May 2023 08:19:49 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <6450ffe5d908f_178e7416c81f9d0270495b@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 379bdcf8 by Josh Meredith at 2023-05-02T12:19:36+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 6 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS @@ -22,7 +23,6 @@ module GHC.JS.Transform , composOpM_ , composOpFold , satJExpr - , satJStat ) where @@ -33,7 +33,6 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict @@ -200,54 +199,34 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) - where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v - +jsSaturate :: Maybe FastString -> JStat -> Sat.JStat +jsSaturate str x = evalState (go x) (newIdentSupply str) + where + go :: JStat -> State [Ident] Sat.JStat + go = \case + DeclStat i rhs -> return $ Sat.DeclStat i (fmap satJExpr rhs) + ReturnStat e -> return $ Sat.ReturnStat (satJExpr e) + IfStat c t e -> Sat.IfStat (satJExpr c) <$> go t <*> go e + WhileStat is_do c e -> Sat.WhileStat is_do (satJExpr c) <$> go e + ForInStat is_each i iter body -> Sat.ForInStat is_each i (satJExpr iter) <$> go body + SwitchStat struct ps def -> Sat.SwitchStat (satJExpr struct) + <$> mapM (\(p1, p2) -> (satJExpr p1,) <$> go p2) ps + <*> go def + TryStat t i c f -> Sat.TryStat <$> go t <*> pure i <*> go c <*> go f + BlockStat bs -> fmap Sat.BlockStat $! mapM go bs + ApplStat rator rand -> return $ Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) + UOpStat rator rand -> return $ Sat.UOpStat (satJUOp rator) (satJExpr rand) + AssignStat lhs rhs -> return $ Sat.AssignStat (satJExpr lhs) (satJExpr rhs) + LabelStat lbl stmt -> Sat.LabelStat lbl <$> go stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + UnsatBlock us -> go =<< runIdentSupply us -------------------------------------------------------------------------------- -- Translation -- -- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - satJExpr :: JExpr -> Sat.JExpr satJExpr = go @@ -315,5 +294,5 @@ satJVal = go go (JStr f) = Sat.JStr f go (JRegEx f) = Sat.JRegEx f go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) + go (JFunc args body) = Sat.JFunc args (jsSaturate Nothing body) go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a +saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat +rtsDecls :: Sat.JStat rtsDecls = jsSaturate (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread @@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat +rts :: StgToJSConfig -> Sat.JStat rts = jsSaturate (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/379bdcf8c0c1bb3c4ff5170ccc4e69d2c17b55f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/379bdcf8c0c1bb3c4ff5170ccc4e69d2c17b55f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 12:48:05 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 02 May 2023 08:48:05 -0400 Subject: [Git][ghc/ghc][wip/unitidset] WIP refactor `Set UnitId` to `UniqDSet UnitId` Message-ID: <64510685f05c3_178e7416d0fb5a4270936e@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: a2aaf8ea by Josh Meredith at 2023-05-02T12:47:37+00:00 WIP refactor `Set UnitId` to `UniqDSet UnitId` - - - - - 21 changed files: - compiler/GHC.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -395,6 +395,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -418,8 +419,6 @@ import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as S import qualified Data.Sequence as Seq import System.Directory @@ -604,7 +603,7 @@ setSessionDynFlags dflags0 = do logger <- getLogger dflags <- checkNewDynFlags logger dflags0 let all_uids = hsc_all_home_unit_ids hsc_env - case S.toList all_uids of + case uniqDSetToList all_uids of [uid] -> do setUnitDynFlagsNoCheck uid dflags modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags)) @@ -1379,7 +1378,7 @@ data ModuleInfo = ModuleInfo { -- | Request information about a loaded 'Module' getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X getModuleInfo mdl = withSession $ \hsc_env -> do - if moduleUnitId mdl `S.member` hsc_all_home_unit_ids hsc_env + if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env then liftIO $ getHomeModuleInfo hsc_env mdl else liftIO $ getPackageModuleInfo hsc_env mdl @@ -1756,7 +1755,7 @@ isModuleTrusted m = withSession $ \hsc_env -> liftIO $ hscCheckSafe hsc_env m noSrcSpan -- | Return if a module is trusted and the pkgs it depends on to be trusted. -moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId) +moduleTrustReqs :: GhcMonad m => Module -> m (Bool, UnitIdSet) moduleTrustReqs m = withSession $ \hsc_env -> liftIO $ hscGetSafe hsc_env m noSrcSpan ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -56,12 +56,11 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre import GHC.Types.ForeignStubs import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) +import GHC.Types.Unique.DSet import System.Directory import System.FilePath import System.IO -import Data.Set (Set) -import qualified Data.Set as Set {- ************************************************************************ @@ -84,7 +83,7 @@ codeOutput -> (a -> ForeignStubs) -> [(ForeignSrcLang, FilePath)] -- ^ additional files to be compiled with the C compiler - -> Set UnitId -- ^ Dependencies + -> UnitIdSet -- ^ Dependencies -> Stream IO RawCmmGroup a -- Compiled C-- -> IO (FilePath, (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}), @@ -161,11 +160,11 @@ outputC :: Logger -> DynFlags -> FilePath -> Stream IO RawCmmGroup a - -> Set UnitId + -> UnitIdSet -> IO a outputC logger dflags filenm cmm_stream unit_deps = withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do - let pkg_names = map unitIdString (Set.toAscList unit_deps) + let pkg_names = map unitIdString (uniqDSetToAscList unit_deps) doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h "#include \"Stg.h\"\n" ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -127,7 +127,7 @@ hsc_HUE = ue_currentHomeUnitEnv . hsc_unit_env hsc_HUG :: HscEnv -> HomeUnitGraph hsc_HUG = ue_home_unit_graph . hsc_unit_env -hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId +hsc_all_home_unit_ids :: HscEnv -> UnitIdSet hsc_all_home_unit_ids = unitEnv_keys . hsc_HUG hscUpdateHPT_lazy :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -245,6 +245,7 @@ import GHC.Types.Name.Ppr import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.TyThing import GHC.Types.HpcInfo +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint ( Fingerprint ) import GHC.Utils.Panic @@ -274,7 +275,6 @@ import Data.IORef import System.FilePath as FilePath import System.Directory import qualified Data.Set as S -import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) @@ -1457,15 +1457,15 @@ checkSafeImports tcg_env clearDiagnostics -- Check safe imports are correct - safePkgs <- S.fromList <$> mapMaybeM checkSafe safeImps + safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps safeErrs <- getDiagnostics clearDiagnostics -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] (infErrs, infPkgs) <- case (safeInferOn dflags) of - False -> return (emptyMessages, S.empty) - True -> do infPkgs <- S.fromList <$> mapMaybeM checkSafe regImps + False -> return (emptyMessages, emptyUniqDSet) + True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps infErrs <- getDiagnostics clearDiagnostics return (infErrs, infPkgs) @@ -1516,12 +1516,12 @@ checkSafeImports tcg_env checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l -- what pkg's to add to our trust requirements - pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId -> + pkgTrustReqs :: DynFlags -> UnitIdSet -> UnitIdSet -> Bool -> ImportAvails pkgTrustReqs dflags req inf infPassed | safeInferOn dflags && not (safeHaskellModeEnabled dflags) && infPassed = emptyImportAvails { - imp_trust_pkgs = req `S.union` inf + imp_trust_pkgs = req `unionUniqDSets` inf } pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe = emptyImportAvails @@ -1540,12 +1540,12 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do return $ isEmptyMessages errs -- | Return if a module is trusted and the pkgs it depends on to be trusted. -hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId) +hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, UnitIdSet) hscGetSafe hsc_env m l = runHsc hsc_env $ do (self, pkgs) <- hscCheckSafe' m l good <- isEmptyMessages `fmap` getDiagnostics clearDiagnostics -- don't want them printed... - let pkgs' | Just p <- self = S.insert p pkgs + let pkgs' | Just p <- self = addOneToUniqDSet pkgs p | otherwise = pkgs return (good, pkgs') @@ -1554,7 +1554,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do -- own package be trusted and a list of other packages required to be trusted -- (these later ones haven't been checked) but the own package trust has been. hscCheckSafe' :: Module -> SrcSpan - -> Hsc (Maybe UnitId, Set UnitId) + -> Hsc (Maybe UnitId, UnitIdSet) hscCheckSafe' m l = do hsc_env <- getHscEnv let home_unit = hsc_home_unit hsc_env @@ -1566,7 +1566,7 @@ hscCheckSafe' m l = do -- Not necessary if that is reflected in dependencies | otherwise -> return (Just $ toUnitId (moduleUnit m), pkgs) where - isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId) + isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, UnitIdSet) isModSafe home_unit m l = do hsc_env <- getHscEnv dflags <- getDynFlags @@ -1648,10 +1648,10 @@ hscCheckSafe' m l = do -- | Check the list of packages are trusted. -checkPkgTrust :: Set UnitId -> Hsc () +checkPkgTrust :: UnitIdSet -> Hsc () checkPkgTrust pkgs = do hsc_env <- getHscEnv - let errors = S.foldr go emptyBag pkgs + let errors = foldr go emptyBag $ uniqDSetToAscList pkgs state = hsc_units hsc_env go pkg acc | unitIsTrusted $ unsafeLookupUnitId state pkg @@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do False -> return tcg_env where - wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = S.empty } + wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet } pprMod = ppr $ moduleName $ tcg_mod tcg_env whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" @@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs in NoStubs `appendStubC` ip_init | otherwise = NoStubs (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) - <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty + <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet rawCmms return stub_c_exists where ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -107,6 +107,7 @@ import GHC.Types.SourceFile import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Types.PkgQual import GHC.Unit @@ -490,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much mkBatchMsg :: HscEnv -> Messager mkBatchMsg hsc_env = - if length (hsc_all_home_unit_ids hsc_env) > 1 + if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 -- This also displays what unit each module is from. then batchMultiMsg else batchMsg @@ -1735,25 +1736,25 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- This function checks then important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -checkHomeUnitsClosed :: UnitEnv -> Set.Set UnitId -> [(UnitId, UnitId)] -> [DriverMessages] +checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages] -- Fast path, trivially closed. checkHomeUnitsClosed ue home_id_set home_imp_ids - | Set.size home_id_set == 1 = [] + | sizeUniqDSet home_id_set == 1 = [] | otherwise = - let res = foldMap loop home_imp_ids + let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids -- Now check whether everything which transitively depends on a home_unit is actually a home_unit -- These units are the ones which we need to load as home packages but failed to do for some reason, -- it's a bug in the tool invoking GHC. - bad_unit_ids = Set.difference res home_id_set - in if Set.null bad_unit_ids + bad_unit_ids = res `minusUniqDSet` home_id_set + in if isEmptyUniqDSet bad_unit_ids then [] - else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)] + else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)] where rootLoc = mkGeneralSrcSpan (fsLit "") -- TODO: This could repeat quite a bit of work but I struggled to write this function. -- Which units transitively depend on a home unit - loop :: (UnitId, UnitId) -> Set.Set UnitId -- The units which transitively depend on a home unit + loop :: (UnitId, UnitId) -> UnitIdSet -- The units which transitively depend on a home unit loop (from_uid, uid) = let us = ue_findHomeUnitEnv from_uid ue in let um = unitInfoMap (homeUnitEnv_units us) in @@ -1761,20 +1762,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids Nothing -> pprPanic "uid not found" (ppr uid) Just ui -> let depends = unitDepends ui - home_depends = Set.fromList depends `Set.intersection` home_id_set - other_depends = Set.fromList depends `Set.difference` home_id_set + home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set + other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set in -- Case 1: The unit directly depends on a home_id - if not (null home_depends) + if not (isEmptyUniqDSet home_depends) then - let res = foldMap (loop . (from_uid,)) other_depends - in Set.insert uid res + let res :: UnitIdSet + res = foldl' (\acc ide -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends + in addOneToUniqDSet res uid -- Case 2: Check the rest of the dependencies, and then see if any of them depended on else - let res = foldMap (loop . (from_uid,)) other_depends + let res = foldl' (\acc ide -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends in - if not (Set.null res) - then Set.insert uid res + if not (isEmptyUniqDSet res) + then addOneToUniqDSet res uid else res -- | Update the every ModSummary that is depended on ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -108,6 +108,7 @@ import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceError +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -125,7 +126,6 @@ import Control.Monad import qualified Control.Monad.Catch as MC (handle) import Data.Maybe import Data.Either ( partitionEithers ) -import qualified Data.Set as Set import Data.Time ( getCurrentTime ) import GHC.Iface.Recomp @@ -408,8 +408,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt home_mod_infos = eltsHpt hpt -- the packages we depend on - pkg_deps = Set.toList - $ Set.unions + pkg_deps = uniqDSetToAscList + $ unionManyUniqDSets $ fmap (dep_direct_pkgs . mi_deps . hm_iface) $ home_mod_infos ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -40,7 +41,6 @@ import Data.IORef import Data.List (sortBy) import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.Set as Set import GHC.Linker.Types import GHC.Unit.Finder @@ -196,7 +196,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do mk_mod_usage_info :: UsageConfig -> HomeUnit - -> Set.Set UnitId + -> UnitIdSet -> Module -> ImportedMods -> NameSet @@ -255,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names -- (need to recompile if its export list changes: export_fprint) mkUsage :: Module -> ModIface -> Maybe Usage mkUsage mod iface - | toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids + | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -504,7 +504,7 @@ loadInterface doc_str mod from -- overlapping instances. ; massertPpr ((isOneShot (ghcMode (hsc_dflags hsc_env))) - || moduleUnitId mod `notElem` hsc_all_home_unit_ids hsc_env + || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env) || mod == gHC_PRIM) (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Types.SrcLoc import GHC.Types.Unique.Set import GHC.Types.Fixity.Env import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.State @@ -617,8 +618,8 @@ checkDependencies hsc_env summary iface all_home_units = hsc_all_home_unit_ids hsc_env units = hsc_units hsc_env prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) + prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) @@ -633,7 +634,7 @@ checkDependencies hsc_env summary iface classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) + | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -324,20 +324,20 @@ loadCmdLineLibs interp hsc_env = do loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState loadCmdLineLibs' interp hsc_env pls = snd <$> foldM - (\(done', pls') cur_uid -> load done' cur_uid pls') - (Set.empty, pls) - (hsc_all_home_unit_ids hsc_env) + (\(done', pls') cur_uid -> load done' cur_uid pls') + (emptyUniqDSet, pls) + (uniqDSetToList $ hsc_all_home_unit_ids hsc_env) where - load :: Set.Set UnitId -> UnitId -> LoaderState -> IO (Set.Set UnitId, LoaderState) - load done uid pls | uid `Set.member` done = return (done, pls) + load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState) + load done uid pls | uid `elementOfUniqDSet` done = return (done, pls) load done uid pls = do let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) - (homeUnitDepends (hsc_units hsc')) + (homeUnitDepends (hsc_units hsc')) pls'' <- loadCmdLineLibs'' interp hsc' pls' - return $ (Set.insert uid done', pls'') + return $ (addOneToUniqDSet done' uid, pls'') loadCmdLineLibs'' :: Interp @@ -685,7 +685,7 @@ getLinkDeps :: HscEnv -> Maybe FilePath -- replace object suffixes? -> SrcSpan -- for error messages -> [Module] -- If you need these - -> IO ([Linkable], [Linkable], [UnitId], UniqDSet UnitId) -- ... then link these first + -> IO ([Linkable], [Linkable], [UnitId], UnitIdSet) -- ... then link these first -- The module and package dependencies for the needed modules are returned. -- See Note [Object File Dependencies] -- Fails with an IO exception if it can't find enough files @@ -737,7 +737,7 @@ getLinkDeps hsc_env pls replace_osuf span mods -- It is also a matter of correctness to use the module graph so that dependencies between home units -- is resolved correctly. - make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) + make_deps_loop :: (UnitIdSet, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UnitIdSet, Set.Set NodeKey) make_deps_loop found [] = found make_deps_loop found@(found_units, found_mods) (nk:nexts) | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts @@ -766,7 +766,7 @@ getLinkDeps hsc_env pls replace_osuf span mods HsBootFile -> link_boot_mod_error (mi_module iface) _ -> return $ Just (mi_module iface) - in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod + in (dep_direct_pkgs (mi_deps iface),) <$> mmod Nothing -> let err = text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid in throwGhcExceptionIO (ProgramError (showSDoc dflags err)) @@ -780,9 +780,9 @@ getLinkDeps hsc_env pls replace_osuf span mods -- dependencies of that. Hence we need to traverse the dependency -- tree recursively. See bug #936, testcase ghci/prog007. follow_deps :: [Module] -- modules to follow - -> UniqDSet Module -- accum. module dependencies - -> UniqDSet UnitId -- accum. package dependencies - -> IO ([Module], UniqDSet UnitId) -- result + -> UniqDSet Module -- accum. module dependencies + -> UnitIdSet -- accum. package dependencies + -> IO ([Module], UnitIdSet) -- result follow_deps [] acc_mods acc_pkgs = return (uniqDSetToList acc_mods, acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs @@ -814,7 +814,7 @@ getLinkDeps hsc_env pls replace_osuf span mods acc_mods' = case hsc_home_unit_maybe hsc_env of Nothing -> acc_mods Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) + acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps) case hsc_home_unit_maybe hsc_env of Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Linker.Types where import GHC.Prelude -import GHC.Unit ( UnitId, Module ) +import GHC.Unit ( UnitId, Module, UnitIdSet ) import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) import GHC.Fingerprint.Type ( Fingerprint ) import GHCi.RemoteTypes ( ForeignHValue ) @@ -53,7 +53,6 @@ import Control.Concurrent.MVar import Data.Time ( UTCTime ) import Data.Maybe import GHC.Unit.Module.Env -import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Unit.Module.WholeCoreBindings @@ -146,7 +145,7 @@ data LoadedPkgInfo { loaded_pkg_uid :: !UnitId , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] - , loaded_pkg_trans_deps :: UniqDSet UnitId + , loaded_pkg_trans_deps :: UnitIdSet } instance Outputable LoadedPkgInfo where ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Types.HpcInfo import GHC.Types.Error import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Module.Warnings @@ -213,8 +214,8 @@ rnImports imports = do let merged_import_avail = clobberSourceImports imp_avails dflags <- getDynFlags let final_import_avail = - merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags) - `S.union` imp_dep_direct_pkgs merged_import_avail} + merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags) + `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail} return (decls, rdr_env, final_import_avail, hpc_usage) where @@ -494,7 +495,7 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of -- | Calculate the 'ImportAvails' induced by an import of a particular -- interface, but without 'imp_mods'. calculateAvails :: HomeUnit - -> S.Set UnitId + -> UnitIdSet -> ModIface -> IsSafeImport -> IsBootInterface @@ -549,7 +550,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by -- Trusted packages are a lot like orphans. trusted_pkgs | mod_safe' = dep_trusted_pkgs deps - | otherwise = S.empty + | otherwise = emptyUniqDSet pkg = moduleUnit (mi_module iface) @@ -562,11 +563,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by | isHomeUnit home_unit pkg = ptrust | otherwise = False - dependent_pkgs = if toUnitId pkg `S.member` other_home_units - then S.empty - else S.singleton ipkg + dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units + then emptyUniqDSet + else unitUniqDSet ipkg - direct_mods = mkModDeps $ if toUnitId pkg `S.member` other_home_units + direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) else S.empty ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -148,6 +148,7 @@ import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -185,7 +186,6 @@ import Data.List ( sortBy, sort ) import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE import Data.Ord -import qualified Data.Set as S import Data.Traversable ( for ) @@ -3134,7 +3134,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports) , text "Dependent packages:" <+> - ppr (S.toList $ imp_dep_direct_pkgs imports)] + ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)] -- The use of sort is just to reduce unnecessary -- wobbling in testsuite output ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -142,6 +142,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Basic import GHC.Types.CostCentre.State import GHC.Types.HpcInfo @@ -1367,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_direct_dep_mods = emptyInstalledModuleEnv, - imp_dep_direct_pkgs = S.empty, + imp_dep_direct_pkgs = emptyUniqDSet, imp_sig_mods = [], - imp_trust_pkgs = S.empty, + imp_trust_pkgs = emptyUniqDSet, imp_trust_own_pkg = False, imp_boot_mods = emptyInstalledModuleEnv, imp_orphs = [], @@ -1398,8 +1399,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, - imp_dep_direct_pkgs = ddpkgs1 `S.union` ddpkgs2, - imp_trust_pkgs = tpkgs1 `S.union` tpkgs2, + imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2, + imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, ===================================== compiler/GHC/Types/Unique/DSet.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Types.Unique.DSet ( isEmptyUniqDSet, lookupUniqDSet, uniqDSetToList, + uniqDSetToAscList, partitionUniqDSet, mapUniqDSet ) where @@ -43,8 +44,11 @@ import GHC.Types.Unique.DFM import GHC.Types.Unique.Set import GHC.Types.Unique +import GHC.Utils.Binary + import Data.Coerce import Data.Data +import Data.List (sort) -- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here. -- Beyond preserving invariants, we may also want to 'override' typeclass @@ -120,6 +124,9 @@ lookupUniqDSet = lookupUDFM . getUniqDSet uniqDSetToList :: UniqDSet a -> [a] uniqDSetToList = eltsUDFM . getUniqDSet +uniqDSetToAscList :: Ord a => UniqDSet a -> [a] +uniqDSetToAscList = sort . uniqDSetToList + partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a) partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet @@ -140,3 +147,7 @@ instance Outputable a => Outputable (UniqDSet a) where pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList + +instance (Uniquable a, Binary a) => Binary (UniqDSet a) where + put_ bh = put_ bh . uniqDSetToList + get bh = mkUniqDSet <$> get bh ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -81,6 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.Session import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) +import GHC.Types.Unique.DSet import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -339,8 +340,8 @@ unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env) unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env -unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey -unitEnv_keys env = Map.keysSet (unitEnv_graph env) +unitEnv_keys :: UnitEnvGraph v -> UnitIdSet +unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) @@ -443,7 +444,7 @@ ue_unitHomeUnit_maybe uid ue_env = ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env -ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId +ue_all_home_unit_ids :: UnitEnv -> UnitIdSet ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph -- ------------------------------------------------------- -- Query and modify the currently active unit ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -28,6 +28,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -53,13 +54,13 @@ data Dependencies = Deps -- ^ All home-package modules which are directly imported by this one. -- This may include modules from other units when using multiple home units - , dep_direct_pkgs :: Set UnitId + , dep_direct_pkgs :: UnitIdSet -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. -- Does not include other home units when using multiple home units. -- Modules from these units will go in `dep_direct_mods` - , dep_plugin_pkgs :: Set UnitId + , dep_plugin_pkgs :: UnitIdSet -- ^ All units needed for plugins ------------------------------------ @@ -69,7 +70,7 @@ data Dependencies = Deps -- ^ Transitive closure of hsig files in the home package - , dep_trusted_pkgs :: Set UnitId + , dep_trusted_pkgs :: UnitIdSet -- Packages which we are required to trust -- when the module is imported as a safe import -- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names @@ -110,7 +111,7 @@ data Dependencies = Deps mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods - plugin_units = Set.fromList (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -197,12 +198,12 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps - { dep_direct_mods = Set.empty - , dep_direct_pkgs = Set.empty - , dep_plugin_pkgs = Set.empty + { dep_direct_mods = mempty + , dep_direct_pkgs = emptyUniqDSet + , dep_plugin_pkgs = emptyUniqDSet , dep_sig_mods = [] - , dep_boot_mods = Set.empty - , dep_trusted_pkgs = Set.empty + , dep_boot_mods = mempty + , dep_trusted_pkgs = emptyUniqDSet , dep_orphs = [] , dep_finsts = [] } @@ -220,11 +221,11 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods = pprWithUnitState unit_state $ vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods, text "boot module dependencies:" <+> ppr_set ppr bmods, - text "direct package dependencies:" <+> ppr_set ppr pkgs, - text "plugin package dependencies:" <+> ppr_set ppr plgns, - if null tps + text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, + text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, + if isEmptyUniqDSet tps then empty - else text "trusted package dependencies:" <+> ppr_set ppr tps, + else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), text "family instance modules:" <+> fsep (map ppr finsts) ] @@ -235,6 +236,9 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc ppr_set w = fsep . fmap w . Set.toAscList + ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc + ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance -- @@ -491,7 +495,7 @@ data ImportAvails imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot, -- ^ Home-package modules directly imported by the module being compiled. - imp_dep_direct_pkgs :: Set UnitId, + imp_dep_direct_pkgs :: UnitIdSet, -- ^ Packages directly needed by the module being compiled imp_trust_own_pkg :: Bool, @@ -502,7 +506,7 @@ data ImportAvails -- Transitive information below here - imp_trust_pkgs :: Set UnitId, + imp_trust_pkgs :: UnitIdSet, -- ^ This records the -- packages the current module needs to trust for Safe Haskell -- compilation to succeed. A package is required to be trusted if ===================================== compiler/GHC/Unit/Module/ModGuts.hs ===================================== @@ -37,8 +37,6 @@ import GHC.Types.SourceFile ( HscSource(..), hscSourceToIsBoot ) import GHC.Types.SrcLoc import GHC.Types.CostCentre -import Data.Set (Set) - -- | A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module @@ -137,7 +135,7 @@ data CgGuts cg_ccs :: [CostCentre], -- List of cost centres used in bindings and rules cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs cg_foreign_files :: ![(ForeignSrcLang, FilePath)], - cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to + cg_dep_pkgs :: !UnitIdSet, -- ^ Dependent packages, used to -- generate #includes for C code gen cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -346,10 +346,10 @@ data UnitConfig = UnitConfig , unitConfigFlagsIgnored :: [IgnorePackageFlag] -- ^ Ignored units , unitConfigFlagsTrusted :: [TrustFlag] -- ^ Trusted units , unitConfigFlagsPlugins :: [PackageFlag] -- ^ Plugins exposed units - , unitConfigHomeUnits :: Set.Set UnitId + , unitConfigHomeUnits :: UnitIdSet } -initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig +initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> UnitConfig initUnitConfig dflags cached_dbs home_units = let !hu_id = homeUnitId_ dflags !hu_instanceof = homeUnitInstanceOf_ dflags @@ -626,7 +626,7 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) +initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) initUnits logger dflags cached_dbs home_units = do let forceUnitInfoMap (state, _) = unitInfoMap state `seq` () @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (Set.toList override_set) $ \pkg -> + forM_ (uniqDSetToList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1374,9 +1374,9 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- The set of UnitIds which appear in both db and pkgs. These are the -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 - override_set :: Set UnitId - override_set = Set.intersection (nonDetUniqMapToKeySet db_map) - (nonDetUniqMapToKeySet pkg_map) + override_set :: UnitIdSet + override_set = intersectUniqDSets (mkUniqDSet $ nonDetKeysUniqMap db_map) + (mkUniqDSet $ nonDetKeysUniqMap pkg_map) -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1688,7 +1688,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = Set.toList home_unit_deps + , homeUnitDepends = uniqDSetToList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,15 +1701,15 @@ mkUnitState logger cfg = do } return (state, raw_dbs) -selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True +selectHptFlag :: UnitIdSet -> PackageFlag -> Bool +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True selectHptFlag _ _ = False -selectHomeUnits :: Set.Set UnitId -> [PackageFlag] -> Set.Set UnitId -selectHomeUnits home_units flags = foldl' go Set.empty flags +selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet +selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags where - go :: Set.Set UnitId -> PackageFlag -> Set.Set UnitId - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = Set.insert (toUnitId uid) cur + go :: UnitIdSet -> PackageFlag -> UnitIdSet + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Unit.Types , GenInstantiatedUnit (..) , InstantiatedUnit , DefUnitId + , UnitIdSet , Instantiations , GenInstantiations , mkInstantiatedUnit @@ -538,6 +539,8 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId +type UnitIdSet = UniqDSet UnitId + unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS ===================================== ghc/GHCi/UI.hs ===================================== @@ -105,6 +105,7 @@ import GHC.Utils.Misc import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Bag (unitBag) import qualified GHC.Data.Strict as Strict +import GHC.Types.Unique.DSet -- Haskell Libraries import System.Console.Haskeline as Haskeline @@ -125,7 +126,6 @@ import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) import Data.List ( elemIndices, find, intercalate, intersperse, minimumBy, isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) ) import qualified Data.List.NonEmpty as NE -import qualified Data.Set as S import Data.Maybe import qualified Data.Map as M import Data.IntMap.Strict (IntMap) @@ -561,7 +561,7 @@ interactiveUI config srcs maybe_exprs = do -- Set to True because Prelude is implicitly imported. impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession - let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 + let in_multi = sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 empty_cache <- liftIO newIfaceCache startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, @@ -2568,15 +2568,15 @@ isSafeModule m = do -- print info to user... liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")" liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off") - when (not $ S.null good) + when (not $ isEmptyUniqDSet good) (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++ - (intercalate ", " $ map (showPpr dflags) (S.toList good))) - case msafe && S.null bad of + (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good))) + case msafe && isEmptyUniqDSet bad of True -> liftIO $ putStrLn $ mname ++ " is trusted!" False -> do - when (not $ null bad) + when (not $ isEmptyUniqDSet bad) (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): " - ++ (intercalate ", " $ map (showPpr dflags) (S.toList bad))) + ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad))) liftIO $ putStrLn $ mname ++ " is NOT trusted!" where @@ -2586,8 +2586,8 @@ isSafeModule m = do | isHomeModule (hsc_home_unit hsc_env) md = True | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) - tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty) - | otherwise = S.partition part deps + tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet) + | otherwise = partitionUniqDSet part deps where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2aaf8ea6d03fa3fc8760012a4cd57b1b0ca4fd7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2aaf8ea6d03fa3fc8760012a4cd57b1b0ca4fd7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 14:13:47 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 02 May 2023 10:13:47 -0400 Subject: [Git][ghc/ghc][wip/js-boundsCheck] Split Addr# storage into arr and default array Message-ID: <64511a9b5129b_178e7416e167f8c27270d6@gitlab.mail> Sylvain Henry pushed to branch wip/js-boundsCheck at Glasgow Haskell Compiler / GHC Commits: 2e61bec7 by Sylvain Henry at 2023-05-02T16:18:32+02:00 Split Addr# storage into arr and default array Addr# were stored in "arr" sub-array as tuples [array,offset] We change this to store only the array in "arr" and the offset in the default array. - - - - - 9 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,219 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsCheckedLen bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsCheckedRangeLen bound a1 o1 n - . boundsCheckedRangeLen bound a2 o2 n + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsCheckedRangeLen bound a1 o1 n - . boundsCheckedRangeLen bound a2 o2 n - . checkOverlapByteArray bound a1 o1 a2 o2 n - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsCheckedRangeLen bound a o n $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -757,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -918,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ r |= var "h$threads" - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ r |= var "h$threads" + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1032,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsCheckedLen bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsCheckedLen bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsCheckedLen bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsCheckedLen bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsCheckedLen bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1368,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1392,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1407,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1417,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1432,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1445,73 +1387,151 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked' +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound :: JExpr -- ^ Max index expression -> Bool -- ^ Should we do bounds checking? -> JExpr -- ^ Index -> JStat -- ^ Result -> JStat -boundsChecked' _ False _ r = r -boundsChecked' max_index True i r = - ifS ((i .>=. zero_) .&&. (i .<. max_index)) r $ - returnS (app "h$exitProcess" [Int 134]) +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] -- | Bounds checking using ".length" property (Arrays) -boundsChecked +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range :: Bool -- ^ Should we do bounds checking? -> JExpr -- ^ Array -> JExpr -- ^ Index + -> JExpr -- ^ Range size -> JStat -- ^ Result -> JStat -boundsChecked do_check arr = boundsChecked' (arr .^ "length") do_check +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) -- | Bounds checking using ".len" property (ByteArrays) -boundsCheckedLen +bnd_ba :: Bool -- ^ Should we do bounds checking? -> JExpr -- ^ Array -> JExpr -- ^ Index -> JStat -- ^ Result -> JStat -boundsCheckedLen do_check arr = boundsChecked' (arr .^ "len") do_check +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r -- | Bounds checking on a range and using ".len" property (ByteArrays) -- -- Empty ranges trivially pass the check -boundsCheckedRangeLen +bnd_ba_range :: Bool -- ^ Should we do bounds checking? -> JExpr -- ^ Array -> JExpr -- ^ Index -> JExpr -- ^ Range size -> JStat -- ^ Result -> JStat -boundsCheckedRangeLen False _ _ _ r = r -boundsCheckedRangeLen True xs i n r = +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ - ifS (n .===. zero_) -- We can always fill zero elements, even if it seems out-of-bounds + -- Empty ranges trivially pass the check + ifS (n .===. zero_) r - (boundsCheckedLen True xs (Add i (Sub n 1)) (boundsCheckedLen True xs i r)) + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) checkOverlapByteArray :: Bool -- ^ Should we do bounds checking? @@ -1522,20 +1542,18 @@ checkOverlapByteArray -> JExpr -- ^ Range size -> JStat -- ^ Result -> JStat -checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray False _ _ _ _ _ r = r checkOverlapByteArray True a1 o1 a2 o2 n r = ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) -byteIndex16 :: JExpr -> JExpr -byteIndex16 i = Add 1 (Mul 2 i) - -byteIndex32 :: JExpr -> JExpr -byteIndex32 i = Add 3 (Mul 4 i) - -byteIndex64 :: JExpr -> JExpr -byteIndex64 i = Add 7 (Mul 8 i) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; return true; } ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(21142), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e61bec70c36af6e459fa7a73e93d1be29192610 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e61bec70c36af6e459fa7a73e93d1be29192610 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 14:15:57 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 02 May 2023 10:15:57 -0400 Subject: [Git][ghc/ghc][wip/js-boundsCheck] 42 commits: JS: fix thread-related primops Message-ID: <64511b1dc3ad1_178e7416e237d902728021@gitlab.mail> Sylvain Henry pushed to branch wip/js-boundsCheck at Glasgow Haskell Compiler / GHC Commits: d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0646d828 by Josh Meredith at 2023-05-02T16:19:46+02:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 081b9d44 by Sylvain Henry at 2023-05-02T16:21:05+02:00 Split Addr# storage into arr and default array Addr# were stored in "arr" sub-array as tuples [array,offset] We change this to store only the array in "arr" and the offset in the default array. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/CSE.hs - compiler/GHC/Stg/Debug.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e61bec70c36af6e459fa7a73e93d1be29192610...081b9d44742ad212dfacd855e16f239c91ccfa9f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e61bec70c36af6e459fa7a73e93d1be29192610...081b9d44742ad212dfacd855e16f239c91ccfa9f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 14:56:17 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 02 May 2023 10:56:17 -0400 Subject: [Git][ghc/ghc][wip/unitidset] WIP refactor `Set UnitId` to `UniqDSet UnitId` Message-ID: <64512491a96d8_3c91159795054895@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: e398305c by Josh Meredith at 2023-05-02T14:55:57+00:00 WIP refactor `Set UnitId` to `UniqDSet UnitId` - - - - - 21 changed files: - compiler/GHC.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -395,6 +395,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -418,8 +419,6 @@ import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as S import qualified Data.Sequence as Seq import System.Directory @@ -604,7 +603,7 @@ setSessionDynFlags dflags0 = do logger <- getLogger dflags <- checkNewDynFlags logger dflags0 let all_uids = hsc_all_home_unit_ids hsc_env - case S.toList all_uids of + case uniqDSetToList all_uids of [uid] -> do setUnitDynFlagsNoCheck uid dflags modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags)) @@ -1379,7 +1378,7 @@ data ModuleInfo = ModuleInfo { -- | Request information about a loaded 'Module' getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X getModuleInfo mdl = withSession $ \hsc_env -> do - if moduleUnitId mdl `S.member` hsc_all_home_unit_ids hsc_env + if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env then liftIO $ getHomeModuleInfo hsc_env mdl else liftIO $ getPackageModuleInfo hsc_env mdl @@ -1756,7 +1755,7 @@ isModuleTrusted m = withSession $ \hsc_env -> liftIO $ hscCheckSafe hsc_env m noSrcSpan -- | Return if a module is trusted and the pkgs it depends on to be trusted. -moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId) +moduleTrustReqs :: GhcMonad m => Module -> m (Bool, UnitIdSet) moduleTrustReqs m = withSession $ \hsc_env -> liftIO $ hscGetSafe hsc_env m noSrcSpan ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -56,12 +56,11 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre import GHC.Types.ForeignStubs import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) +import GHC.Types.Unique.DSet import System.Directory import System.FilePath import System.IO -import Data.Set (Set) -import qualified Data.Set as Set {- ************************************************************************ @@ -84,7 +83,7 @@ codeOutput -> (a -> ForeignStubs) -> [(ForeignSrcLang, FilePath)] -- ^ additional files to be compiled with the C compiler - -> Set UnitId -- ^ Dependencies + -> UnitIdSet -- ^ Dependencies -> Stream IO RawCmmGroup a -- Compiled C-- -> IO (FilePath, (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}), @@ -161,11 +160,11 @@ outputC :: Logger -> DynFlags -> FilePath -> Stream IO RawCmmGroup a - -> Set UnitId + -> UnitIdSet -> IO a outputC logger dflags filenm cmm_stream unit_deps = withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do - let pkg_names = map unitIdString (Set.toAscList unit_deps) + let pkg_names = map unitIdString (uniqDSetToAscList unit_deps) doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h "#include \"Stg.h\"\n" ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -127,7 +127,7 @@ hsc_HUE = ue_currentHomeUnitEnv . hsc_unit_env hsc_HUG :: HscEnv -> HomeUnitGraph hsc_HUG = ue_home_unit_graph . hsc_unit_env -hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId +hsc_all_home_unit_ids :: HscEnv -> UnitIdSet hsc_all_home_unit_ids = unitEnv_keys . hsc_HUG hscUpdateHPT_lazy :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -245,6 +245,7 @@ import GHC.Types.Name.Ppr import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.TyThing import GHC.Types.HpcInfo +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint ( Fingerprint ) import GHC.Utils.Panic @@ -274,7 +275,6 @@ import Data.IORef import System.FilePath as FilePath import System.Directory import qualified Data.Set as S -import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) @@ -1457,15 +1457,15 @@ checkSafeImports tcg_env clearDiagnostics -- Check safe imports are correct - safePkgs <- S.fromList <$> mapMaybeM checkSafe safeImps + safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps safeErrs <- getDiagnostics clearDiagnostics -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] (infErrs, infPkgs) <- case (safeInferOn dflags) of - False -> return (emptyMessages, S.empty) - True -> do infPkgs <- S.fromList <$> mapMaybeM checkSafe regImps + False -> return (emptyMessages, emptyUniqDSet) + True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps infErrs <- getDiagnostics clearDiagnostics return (infErrs, infPkgs) @@ -1516,12 +1516,12 @@ checkSafeImports tcg_env checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l -- what pkg's to add to our trust requirements - pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId -> + pkgTrustReqs :: DynFlags -> UnitIdSet -> UnitIdSet -> Bool -> ImportAvails pkgTrustReqs dflags req inf infPassed | safeInferOn dflags && not (safeHaskellModeEnabled dflags) && infPassed = emptyImportAvails { - imp_trust_pkgs = req `S.union` inf + imp_trust_pkgs = req `unionUniqDSets` inf } pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe = emptyImportAvails @@ -1540,12 +1540,12 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do return $ isEmptyMessages errs -- | Return if a module is trusted and the pkgs it depends on to be trusted. -hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId) +hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, UnitIdSet) hscGetSafe hsc_env m l = runHsc hsc_env $ do (self, pkgs) <- hscCheckSafe' m l good <- isEmptyMessages `fmap` getDiagnostics clearDiagnostics -- don't want them printed... - let pkgs' | Just p <- self = S.insert p pkgs + let pkgs' | Just p <- self = addOneToUniqDSet pkgs p | otherwise = pkgs return (good, pkgs') @@ -1554,7 +1554,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do -- own package be trusted and a list of other packages required to be trusted -- (these later ones haven't been checked) but the own package trust has been. hscCheckSafe' :: Module -> SrcSpan - -> Hsc (Maybe UnitId, Set UnitId) + -> Hsc (Maybe UnitId, UnitIdSet) hscCheckSafe' m l = do hsc_env <- getHscEnv let home_unit = hsc_home_unit hsc_env @@ -1566,7 +1566,7 @@ hscCheckSafe' m l = do -- Not necessary if that is reflected in dependencies | otherwise -> return (Just $ toUnitId (moduleUnit m), pkgs) where - isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId) + isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, UnitIdSet) isModSafe home_unit m l = do hsc_env <- getHscEnv dflags <- getDynFlags @@ -1648,10 +1648,10 @@ hscCheckSafe' m l = do -- | Check the list of packages are trusted. -checkPkgTrust :: Set UnitId -> Hsc () +checkPkgTrust :: UnitIdSet -> Hsc () checkPkgTrust pkgs = do hsc_env <- getHscEnv - let errors = S.foldr go emptyBag pkgs + let errors = foldr go emptyBag $ uniqDSetToAscList pkgs state = hsc_units hsc_env go pkg acc | unitIsTrusted $ unsafeLookupUnitId state pkg @@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do False -> return tcg_env where - wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = S.empty } + wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet } pprMod = ppr $ moduleName $ tcg_mod tcg_env whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" @@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs in NoStubs `appendStubC` ip_init | otherwise = NoStubs (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) - <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty + <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet rawCmms return stub_c_exists where ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -107,6 +107,7 @@ import GHC.Types.SourceFile import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Types.PkgQual import GHC.Unit @@ -490,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much mkBatchMsg :: HscEnv -> Messager mkBatchMsg hsc_env = - if length (hsc_all_home_unit_ids hsc_env) > 1 + if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 -- This also displays what unit each module is from. then batchMultiMsg else batchMsg @@ -1735,25 +1736,25 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- This function checks then important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -checkHomeUnitsClosed :: UnitEnv -> Set.Set UnitId -> [(UnitId, UnitId)] -> [DriverMessages] +checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages] -- Fast path, trivially closed. checkHomeUnitsClosed ue home_id_set home_imp_ids - | Set.size home_id_set == 1 = [] + | sizeUniqDSet home_id_set == 1 = [] | otherwise = - let res = foldMap loop home_imp_ids + let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids -- Now check whether everything which transitively depends on a home_unit is actually a home_unit -- These units are the ones which we need to load as home packages but failed to do for some reason, -- it's a bug in the tool invoking GHC. - bad_unit_ids = Set.difference res home_id_set - in if Set.null bad_unit_ids + bad_unit_ids = res `minusUniqDSet` home_id_set + in if isEmptyUniqDSet bad_unit_ids then [] - else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)] + else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)] where rootLoc = mkGeneralSrcSpan (fsLit "") -- TODO: This could repeat quite a bit of work but I struggled to write this function. -- Which units transitively depend on a home unit - loop :: (UnitId, UnitId) -> Set.Set UnitId -- The units which transitively depend on a home unit + loop :: (UnitId, UnitId) -> UnitIdSet -- The units which transitively depend on a home unit loop (from_uid, uid) = let us = ue_findHomeUnitEnv from_uid ue in let um = unitInfoMap (homeUnitEnv_units us) in @@ -1761,20 +1762,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids Nothing -> pprPanic "uid not found" (ppr uid) Just ui -> let depends = unitDepends ui - home_depends = Set.fromList depends `Set.intersection` home_id_set - other_depends = Set.fromList depends `Set.difference` home_id_set + home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set + other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set in -- Case 1: The unit directly depends on a home_id - if not (null home_depends) + if not (isEmptyUniqDSet home_depends) then - let res = foldMap (loop . (from_uid,)) other_depends - in Set.insert uid res + let res :: UnitIdSet + res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends + in addOneToUniqDSet res uid -- Case 2: Check the rest of the dependencies, and then see if any of them depended on else - let res = foldMap (loop . (from_uid,)) other_depends + let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends in - if not (Set.null res) - then Set.insert uid res + if not (isEmptyUniqDSet res) + then addOneToUniqDSet res uid else res -- | Update the every ModSummary that is depended on ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -108,6 +108,7 @@ import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceError +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -125,7 +126,6 @@ import Control.Monad import qualified Control.Monad.Catch as MC (handle) import Data.Maybe import Data.Either ( partitionEithers ) -import qualified Data.Set as Set import Data.Time ( getCurrentTime ) import GHC.Iface.Recomp @@ -408,8 +408,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt home_mod_infos = eltsHpt hpt -- the packages we depend on - pkg_deps = Set.toList - $ Set.unions + pkg_deps = uniqDSetToAscList + $ unionManyUniqDSets $ fmap (dep_direct_pkgs . mi_deps . hm_iface) $ home_mod_infos ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -40,7 +41,6 @@ import Data.IORef import Data.List (sortBy) import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.Set as Set import GHC.Linker.Types import GHC.Unit.Finder @@ -196,7 +196,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do mk_mod_usage_info :: UsageConfig -> HomeUnit - -> Set.Set UnitId + -> UnitIdSet -> Module -> ImportedMods -> NameSet @@ -255,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names -- (need to recompile if its export list changes: export_fprint) mkUsage :: Module -> ModIface -> Maybe Usage mkUsage mod iface - | toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids + | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -504,7 +504,7 @@ loadInterface doc_str mod from -- overlapping instances. ; massertPpr ((isOneShot (ghcMode (hsc_dflags hsc_env))) - || moduleUnitId mod `notElem` hsc_all_home_unit_ids hsc_env + || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env) || mod == gHC_PRIM) (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Types.SrcLoc import GHC.Types.Unique.Set import GHC.Types.Fixity.Env import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.State @@ -617,8 +618,8 @@ checkDependencies hsc_env summary iface all_home_units = hsc_all_home_unit_ids hsc_env units = hsc_units hsc_env prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) + prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) @@ -633,7 +634,7 @@ checkDependencies hsc_env summary iface classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) + | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -324,20 +324,20 @@ loadCmdLineLibs interp hsc_env = do loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState loadCmdLineLibs' interp hsc_env pls = snd <$> foldM - (\(done', pls') cur_uid -> load done' cur_uid pls') - (Set.empty, pls) - (hsc_all_home_unit_ids hsc_env) + (\(done', pls') cur_uid -> load done' cur_uid pls') + (emptyUniqDSet, pls) + (uniqDSetToList $ hsc_all_home_unit_ids hsc_env) where - load :: Set.Set UnitId -> UnitId -> LoaderState -> IO (Set.Set UnitId, LoaderState) - load done uid pls | uid `Set.member` done = return (done, pls) + load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState) + load done uid pls | uid `elementOfUniqDSet` done = return (done, pls) load done uid pls = do let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) - (homeUnitDepends (hsc_units hsc')) + (homeUnitDepends (hsc_units hsc')) pls'' <- loadCmdLineLibs'' interp hsc' pls' - return $ (Set.insert uid done', pls'') + return $ (addOneToUniqDSet done' uid, pls'') loadCmdLineLibs'' :: Interp @@ -685,7 +685,7 @@ getLinkDeps :: HscEnv -> Maybe FilePath -- replace object suffixes? -> SrcSpan -- for error messages -> [Module] -- If you need these - -> IO ([Linkable], [Linkable], [UnitId], UniqDSet UnitId) -- ... then link these first + -> IO ([Linkable], [Linkable], [UnitId], UnitIdSet) -- ... then link these first -- The module and package dependencies for the needed modules are returned. -- See Note [Object File Dependencies] -- Fails with an IO exception if it can't find enough files @@ -737,7 +737,7 @@ getLinkDeps hsc_env pls replace_osuf span mods -- It is also a matter of correctness to use the module graph so that dependencies between home units -- is resolved correctly. - make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) + make_deps_loop :: (UnitIdSet, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UnitIdSet, Set.Set NodeKey) make_deps_loop found [] = found make_deps_loop found@(found_units, found_mods) (nk:nexts) | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts @@ -766,7 +766,7 @@ getLinkDeps hsc_env pls replace_osuf span mods HsBootFile -> link_boot_mod_error (mi_module iface) _ -> return $ Just (mi_module iface) - in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod + in (dep_direct_pkgs (mi_deps iface),) <$> mmod Nothing -> let err = text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid in throwGhcExceptionIO (ProgramError (showSDoc dflags err)) @@ -780,9 +780,9 @@ getLinkDeps hsc_env pls replace_osuf span mods -- dependencies of that. Hence we need to traverse the dependency -- tree recursively. See bug #936, testcase ghci/prog007. follow_deps :: [Module] -- modules to follow - -> UniqDSet Module -- accum. module dependencies - -> UniqDSet UnitId -- accum. package dependencies - -> IO ([Module], UniqDSet UnitId) -- result + -> UniqDSet Module -- accum. module dependencies + -> UnitIdSet -- accum. package dependencies + -> IO ([Module], UnitIdSet) -- result follow_deps [] acc_mods acc_pkgs = return (uniqDSetToList acc_mods, acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs @@ -814,7 +814,7 @@ getLinkDeps hsc_env pls replace_osuf span mods acc_mods' = case hsc_home_unit_maybe hsc_env of Nothing -> acc_mods Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) + acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps) case hsc_home_unit_maybe hsc_env of Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Linker.Types where import GHC.Prelude -import GHC.Unit ( UnitId, Module ) +import GHC.Unit ( UnitId, Module, UnitIdSet ) import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) import GHC.Fingerprint.Type ( Fingerprint ) import GHCi.RemoteTypes ( ForeignHValue ) @@ -53,7 +53,6 @@ import Control.Concurrent.MVar import Data.Time ( UTCTime ) import Data.Maybe import GHC.Unit.Module.Env -import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Unit.Module.WholeCoreBindings @@ -146,7 +145,7 @@ data LoadedPkgInfo { loaded_pkg_uid :: !UnitId , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] - , loaded_pkg_trans_deps :: UniqDSet UnitId + , loaded_pkg_trans_deps :: UnitIdSet } instance Outputable LoadedPkgInfo where ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Types.HpcInfo import GHC.Types.Error import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Module.Warnings @@ -213,8 +214,8 @@ rnImports imports = do let merged_import_avail = clobberSourceImports imp_avails dflags <- getDynFlags let final_import_avail = - merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags) - `S.union` imp_dep_direct_pkgs merged_import_avail} + merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags) + `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail} return (decls, rdr_env, final_import_avail, hpc_usage) where @@ -494,7 +495,7 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of -- | Calculate the 'ImportAvails' induced by an import of a particular -- interface, but without 'imp_mods'. calculateAvails :: HomeUnit - -> S.Set UnitId + -> UnitIdSet -> ModIface -> IsSafeImport -> IsBootInterface @@ -549,7 +550,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by -- Trusted packages are a lot like orphans. trusted_pkgs | mod_safe' = dep_trusted_pkgs deps - | otherwise = S.empty + | otherwise = emptyUniqDSet pkg = moduleUnit (mi_module iface) @@ -562,11 +563,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by | isHomeUnit home_unit pkg = ptrust | otherwise = False - dependent_pkgs = if toUnitId pkg `S.member` other_home_units - then S.empty - else S.singleton ipkg + dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units + then emptyUniqDSet + else unitUniqDSet ipkg - direct_mods = mkModDeps $ if toUnitId pkg `S.member` other_home_units + direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) else S.empty ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -148,6 +148,7 @@ import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -185,7 +186,6 @@ import Data.List ( sortBy, sort ) import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE import Data.Ord -import qualified Data.Set as S import Data.Traversable ( for ) @@ -3134,7 +3134,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports) , text "Dependent packages:" <+> - ppr (S.toList $ imp_dep_direct_pkgs imports)] + ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)] -- The use of sort is just to reduce unnecessary -- wobbling in testsuite output ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -142,6 +142,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Basic import GHC.Types.CostCentre.State import GHC.Types.HpcInfo @@ -1367,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_direct_dep_mods = emptyInstalledModuleEnv, - imp_dep_direct_pkgs = S.empty, + imp_dep_direct_pkgs = emptyUniqDSet, imp_sig_mods = [], - imp_trust_pkgs = S.empty, + imp_trust_pkgs = emptyUniqDSet, imp_trust_own_pkg = False, imp_boot_mods = emptyInstalledModuleEnv, imp_orphs = [], @@ -1398,8 +1399,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, - imp_dep_direct_pkgs = ddpkgs1 `S.union` ddpkgs2, - imp_trust_pkgs = tpkgs1 `S.union` tpkgs2, + imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2, + imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, ===================================== compiler/GHC/Types/Unique/DSet.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Types.Unique.DSet ( isEmptyUniqDSet, lookupUniqDSet, uniqDSetToList, + uniqDSetToAscList, partitionUniqDSet, mapUniqDSet ) where @@ -43,8 +44,11 @@ import GHC.Types.Unique.DFM import GHC.Types.Unique.Set import GHC.Types.Unique +import GHC.Utils.Binary + import Data.Coerce import Data.Data +import Data.List (sort) -- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here. -- Beyond preserving invariants, we may also want to 'override' typeclass @@ -120,6 +124,9 @@ lookupUniqDSet = lookupUDFM . getUniqDSet uniqDSetToList :: UniqDSet a -> [a] uniqDSetToList = eltsUDFM . getUniqDSet +uniqDSetToAscList :: Ord a => UniqDSet a -> [a] +uniqDSetToAscList = sort . uniqDSetToList + partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a) partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet @@ -140,3 +147,7 @@ instance Outputable a => Outputable (UniqDSet a) where pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList + +instance (Uniquable a, Binary a) => Binary (UniqDSet a) where + put_ bh = put_ bh . uniqDSetToAscList + get bh = mkUniqDSet <$> get bh ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -81,6 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.Session import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) +import GHC.Types.Unique.DSet import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -339,8 +340,8 @@ unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env) unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env -unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey -unitEnv_keys env = Map.keysSet (unitEnv_graph env) +unitEnv_keys :: UnitEnvGraph v -> UnitIdSet +unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) @@ -443,7 +444,7 @@ ue_unitHomeUnit_maybe uid ue_env = ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env -ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId +ue_all_home_unit_ids :: UnitEnv -> UnitIdSet ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph -- ------------------------------------------------------- -- Query and modify the currently active unit ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -28,6 +28,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -53,13 +54,13 @@ data Dependencies = Deps -- ^ All home-package modules which are directly imported by this one. -- This may include modules from other units when using multiple home units - , dep_direct_pkgs :: Set UnitId + , dep_direct_pkgs :: UnitIdSet -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. -- Does not include other home units when using multiple home units. -- Modules from these units will go in `dep_direct_mods` - , dep_plugin_pkgs :: Set UnitId + , dep_plugin_pkgs :: UnitIdSet -- ^ All units needed for plugins ------------------------------------ @@ -69,7 +70,7 @@ data Dependencies = Deps -- ^ Transitive closure of hsig files in the home package - , dep_trusted_pkgs :: Set UnitId + , dep_trusted_pkgs :: UnitIdSet -- Packages which we are required to trust -- when the module is imported as a safe import -- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names @@ -110,7 +111,7 @@ data Dependencies = Deps mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods - plugin_units = Set.fromList (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -197,12 +198,12 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps - { dep_direct_mods = Set.empty - , dep_direct_pkgs = Set.empty - , dep_plugin_pkgs = Set.empty + { dep_direct_mods = mempty + , dep_direct_pkgs = emptyUniqDSet + , dep_plugin_pkgs = emptyUniqDSet , dep_sig_mods = [] - , dep_boot_mods = Set.empty - , dep_trusted_pkgs = Set.empty + , dep_boot_mods = mempty + , dep_trusted_pkgs = emptyUniqDSet , dep_orphs = [] , dep_finsts = [] } @@ -220,11 +221,11 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods = pprWithUnitState unit_state $ vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods, text "boot module dependencies:" <+> ppr_set ppr bmods, - text "direct package dependencies:" <+> ppr_set ppr pkgs, - text "plugin package dependencies:" <+> ppr_set ppr plgns, - if null tps + text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, + text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, + if isEmptyUniqDSet tps then empty - else text "trusted package dependencies:" <+> ppr_set ppr tps, + else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), text "family instance modules:" <+> fsep (map ppr finsts) ] @@ -235,6 +236,9 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc ppr_set w = fsep . fmap w . Set.toAscList + ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc + ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance -- @@ -491,7 +495,7 @@ data ImportAvails imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot, -- ^ Home-package modules directly imported by the module being compiled. - imp_dep_direct_pkgs :: Set UnitId, + imp_dep_direct_pkgs :: UnitIdSet, -- ^ Packages directly needed by the module being compiled imp_trust_own_pkg :: Bool, @@ -502,7 +506,7 @@ data ImportAvails -- Transitive information below here - imp_trust_pkgs :: Set UnitId, + imp_trust_pkgs :: UnitIdSet, -- ^ This records the -- packages the current module needs to trust for Safe Haskell -- compilation to succeed. A package is required to be trusted if ===================================== compiler/GHC/Unit/Module/ModGuts.hs ===================================== @@ -37,8 +37,6 @@ import GHC.Types.SourceFile ( HscSource(..), hscSourceToIsBoot ) import GHC.Types.SrcLoc import GHC.Types.CostCentre -import Data.Set (Set) - -- | A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module @@ -137,7 +135,7 @@ data CgGuts cg_ccs :: [CostCentre], -- List of cost centres used in bindings and rules cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs cg_foreign_files :: ![(ForeignSrcLang, FilePath)], - cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to + cg_dep_pkgs :: !UnitIdSet, -- ^ Dependent packages, used to -- generate #includes for C code gen cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -346,10 +346,10 @@ data UnitConfig = UnitConfig , unitConfigFlagsIgnored :: [IgnorePackageFlag] -- ^ Ignored units , unitConfigFlagsTrusted :: [TrustFlag] -- ^ Trusted units , unitConfigFlagsPlugins :: [PackageFlag] -- ^ Plugins exposed units - , unitConfigHomeUnits :: Set.Set UnitId + , unitConfigHomeUnits :: UnitIdSet } -initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig +initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> UnitConfig initUnitConfig dflags cached_dbs home_units = let !hu_id = homeUnitId_ dflags !hu_instanceof = homeUnitInstanceOf_ dflags @@ -626,7 +626,7 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) +initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) initUnits logger dflags cached_dbs home_units = do let forceUnitInfoMap (state, _) = unitInfoMap state `seq` () @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (Set.toList override_set) $ \pkg -> + forM_ (uniqDSetToList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1374,9 +1374,9 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- The set of UnitIds which appear in both db and pkgs. These are the -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 - override_set :: Set UnitId - override_set = Set.intersection (nonDetUniqMapToKeySet db_map) - (nonDetUniqMapToKeySet pkg_map) + override_set :: UnitIdSet + override_set = intersectUniqDSets (mkUniqDSet $ nonDetKeysUniqMap db_map) + (mkUniqDSet $ nonDetKeysUniqMap pkg_map) -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1688,7 +1688,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = Set.toList home_unit_deps + , homeUnitDepends = uniqDSetToList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,15 +1701,15 @@ mkUnitState logger cfg = do } return (state, raw_dbs) -selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True +selectHptFlag :: UnitIdSet -> PackageFlag -> Bool +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True selectHptFlag _ _ = False -selectHomeUnits :: Set.Set UnitId -> [PackageFlag] -> Set.Set UnitId -selectHomeUnits home_units flags = foldl' go Set.empty flags +selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet +selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags where - go :: Set.Set UnitId -> PackageFlag -> Set.Set UnitId - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = Set.insert (toUnitId uid) cur + go :: UnitIdSet -> PackageFlag -> UnitIdSet + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Unit.Types , GenInstantiatedUnit (..) , InstantiatedUnit , DefUnitId + , UnitIdSet , Instantiations , GenInstantiations , mkInstantiatedUnit @@ -538,6 +539,8 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId +type UnitIdSet = UniqDSet UnitId + unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS ===================================== ghc/GHCi/UI.hs ===================================== @@ -105,6 +105,7 @@ import GHC.Utils.Misc import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Bag (unitBag) import qualified GHC.Data.Strict as Strict +import GHC.Types.Unique.DSet -- Haskell Libraries import System.Console.Haskeline as Haskeline @@ -125,7 +126,6 @@ import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) import Data.List ( elemIndices, find, intercalate, intersperse, minimumBy, isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) ) import qualified Data.List.NonEmpty as NE -import qualified Data.Set as S import Data.Maybe import qualified Data.Map as M import Data.IntMap.Strict (IntMap) @@ -561,7 +561,7 @@ interactiveUI config srcs maybe_exprs = do -- Set to True because Prelude is implicitly imported. impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession - let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 + let in_multi = sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 empty_cache <- liftIO newIfaceCache startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, @@ -2568,15 +2568,15 @@ isSafeModule m = do -- print info to user... liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")" liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off") - when (not $ S.null good) + when (not $ isEmptyUniqDSet good) (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++ - (intercalate ", " $ map (showPpr dflags) (S.toList good))) - case msafe && S.null bad of + (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good))) + case msafe && isEmptyUniqDSet bad of True -> liftIO $ putStrLn $ mname ++ " is trusted!" False -> do - when (not $ null bad) + when (not $ isEmptyUniqDSet bad) (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): " - ++ (intercalate ", " $ map (showPpr dflags) (S.toList bad))) + ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad))) liftIO $ putStrLn $ mname ++ " is NOT trusted!" where @@ -2586,8 +2586,8 @@ isSafeModule m = do | isHomeModule (hsc_home_unit hsc_env) md = True | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) - tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty) - | otherwise = S.partition part deps + tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet) + | otherwise = partitionUniqDSet part deps where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e398305cf56890538eedaa0da43d3d8f98c5b197 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e398305cf56890538eedaa0da43d3d8f98c5b197 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 16:08:11 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Tue, 02 May 2023 12:08:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/supersven/riscv-increase-CI-happiness Message-ID: <6451356b117f4_3c911551f401036ce@gitlab.mail> Sven Tennie pushed new branch wip/supersven/riscv-increase-CI-happiness at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/riscv-increase-CI-happiness You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 19:36:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 02 May 2023 15:36:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T19146 Message-ID: <6451665678426_3c911551dd81267c4@gitlab.mail> Ben Gamari pushed new branch wip/T19146 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19146 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 19:38:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 02 May 2023 15:38:30 -0400 Subject: [Git][ghc/ghc][wip/T19146] 2 commits: rts: Don't sanity-check StgTSO.global_link Message-ID: <645166b644b2a_3c911551e001287b2@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: b5382516 by Ben Gamari at 2023-05-02T15:38:25-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d2bcf347 by Ben Gamari at 2023-05-02T15:38:25-04:00 rts: Introduce printGlobalThreads - - - - - 4 changed files: - rts/Threads.c - rts/Threads.h - rts/sm/Evac.c - rts/sm/Sanity.c Changes: ===================================== rts/Threads.c ===================================== @@ -1008,6 +1008,20 @@ printAllThreads(void) } } +void +printGlobalThreads(void) +{ + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + debugBelch("\ngen %d\n", g); + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu)\n", t, t->id); + } + for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + } + } +} + // useful from gdb void printThreadQueue(StgTSO *t) ===================================== rts/Threads.h ===================================== @@ -43,6 +43,7 @@ W_ threadStackUnderflow (Capability *cap, StgTSO *tso); bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value); #if defined(DEBUG) +void printGlobalThreads(void); void printThreadBlockage (StgTSO *tso); void printThreadStatus (StgTSO *t); void printAllThreads (void); ===================================== rts/sm/Evac.c ===================================== @@ -1030,8 +1030,10 @@ loop: return; case TSO: + { copy(p,info,q,sizeofW(StgTSO),gen_no); return; + } case STACK: { ===================================== rts/sm/Sanity.c ===================================== @@ -737,6 +737,27 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* + * Note [Avoid dangling global_link pointers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * TSOs are a bit odd in that they have a global_link pointer field + * which is not scavenged by the GC. This field is used to track the + * generations[_].[old_]threads lists and is ultimately updated by + * MarkWeak.c:tidyThreadList. + + * Typically the fact that this field is not scavenged is fine as all reachable + * TSOs on the heap are guaranteed to be on some generation's thread list and + * therefore will be scavenged by tidyThreadList. However, the sanity checker + * poses a bit of a challenge here as it walks heap blocks directly and + * therefore may encounter TSOs which aren't reachable via the heap. + * For this reason, checkTSO does not check global_link. Instead, we only do + * so in checkGlobalTSOList, which by definition will only look at + * threads which are reachable via a thread list (and therefore must have won + * the forwarding-pointer race). + * + * See #19146. + */ + void checkTSO(StgTSO *tso) { @@ -761,9 +782,11 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && - (tso->global_link == END_TSO_QUEUE || - get_itbl((StgClosure*)tso->global_link)->type == TSO)); + + // This assertion is sadly not viable. See Note [Sanity-checking global_link]. + //ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && + // (tso->global_link == END_TSO_QUEUE || + // get_itbl((StgClosure*)tso->global_link)->type == TSO)); if (tso->label) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->label)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/708c5eba210deb951b1ab130a84fd67ebb76318d...d2bcf3472a825bafc11e90b5e5f8b8d40cd6bc67 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/708c5eba210deb951b1ab130a84fd67ebb76318d...d2bcf3472a825bafc11e90b5e5f8b8d40cd6bc67 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 19:49:52 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 02 May 2023 15:49:52 -0400 Subject: [Git][ghc/ghc][wip/T19146] 3 commits: rts: Assert that pointers aren't cleared Message-ID: <645169603a36a_3c911551f401343f8@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: 83b58e1a by Ben Gamari at 2023-05-02T15:49:39-04:00 rts: Assert that pointers aren't cleared This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - a41e2a77 by Ben Gamari at 2023-05-02T15:49:43-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - 593058d2 by Ben Gamari at 2023-05-02T15:49:44-04:00 rts: Introduce printGlobalThreads - - - - - 7 changed files: - rts/Threads.c - rts/Threads.h - rts/include/Cmm.h - rts/include/MachDeps.h - rts/include/rts/storage/ClosureMacros.h - rts/sm/Evac.c - rts/sm/Sanity.c Changes: ===================================== rts/Threads.c ===================================== @@ -1008,6 +1008,20 @@ printAllThreads(void) } } +void +printGlobalThreads(void) +{ + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + debugBelch("\ngen %d\n", g); + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu)\n", t, t->id); + } + for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + } + } +} + // useful from gdb void printThreadQueue(StgTSO *t) ===================================== rts/Threads.h ===================================== @@ -43,6 +43,7 @@ W_ threadStackUnderflow (Capability *cap, StgTSO *tso); bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value); #if defined(DEBUG) +void printGlobalThreads(void); void printThreadBlockage (StgTSO *tso); void printThreadStatus (StgTSO *t); void printAllThreads (void); ===================================== rts/include/Cmm.h ===================================== @@ -605,16 +605,20 @@ #define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK) #define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT) +#define LOOKS_LIKE_PTR(p) ((p) != NULL && (p) != INVALID_GHC_POINTER) + /* Debugging macros */ #define LOOKS_LIKE_INFO_PTR(p) \ - ((p) != NULL && \ + (LOOKS_LIKE_PTR(p) && \ LOOKS_LIKE_INFO_PTR_NOT_NULL(p)) #define LOOKS_LIKE_INFO_PTR_NOT_NULL(p) \ ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \ (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES)) -#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) +#define LOOKS_LIKE_CLOSURE_PTR(p) \ + ( LOOKS_LIKE_PTR(p) && \ + LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) /* * The layout of the StgFunInfoExtra part of an info table changes ===================================== rts/include/MachDeps.h ===================================== @@ -107,6 +107,17 @@ #endif #endif +// This is the bit-pattern used by the RTS to clear freed memory +// when +RTS -DZ is in use. The LOOKS_LIKE_*_PTR utilities use this +// macro to catch clearly invalid pointers +#if !defined(INVALID_GHC_POINTER) +#if SIZEOF_HSWORD == 4 +#define INVALID_GHC_POINTER 0xaaaaaaaa +#else +#define INVALID_GHC_POINTER 0xaaaaaaaaaaaaaaaa +#endif +#endif + #if !defined(TAG_BITS) #if SIZEOF_HSWORD == 4 #define TAG_BITS 2 ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -270,6 +270,12 @@ EXTERN_INLINE StgClosure *TAG_CLOSURE(StgWord tag,StgClosure * p) make sense... -------------------------------------------------------------------------- */ +EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p); +EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p) +{ + return p && (p != (const void*) INVALID_GHC_POINTER); +} + EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) { @@ -280,12 +286,13 @@ EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p) { - return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); + return LOOKS_LIKE_PTR((const void*) p) && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); } EXTERN_INLINE bool LOOKS_LIKE_CLOSURE_PTR (const void *p); EXTERN_INLINE bool LOOKS_LIKE_CLOSURE_PTR (const void *p) { + if (!LOOKS_LIKE_PTR(p)) return false; const StgInfoTable *info = RELAXED_LOAD(&UNTAG_CONST_CLOSURE((const StgClosure *) (p))->header.info); return LOOKS_LIKE_INFO_PTR((StgWord) info); } ===================================== rts/sm/Evac.c ===================================== @@ -1030,8 +1030,10 @@ loop: return; case TSO: + { copy(p,info,q,sizeofW(StgTSO),gen_no); return; + } case STACK: { ===================================== rts/sm/Sanity.c ===================================== @@ -737,6 +737,27 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* + * Note [Avoid dangling global_link pointers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * TSOs are a bit odd in that they have a global_link pointer field + * which is not scavenged by the GC. This field is used to track the + * generations[_].[old_]threads lists and is ultimately updated by + * MarkWeak.c:tidyThreadList. + + * Typically the fact that this field is not scavenged is fine as all reachable + * TSOs on the heap are guaranteed to be on some generation's thread list and + * therefore will be scavenged by tidyThreadList. However, the sanity checker + * poses a bit of a challenge here as it walks heap blocks directly and + * therefore may encounter TSOs which aren't reachable via the heap. + * For this reason, checkTSO does not check global_link. Instead, we only do + * so in checkGlobalTSOList, which by definition will only look at + * threads which are reachable via a thread list (and therefore must have won + * the forwarding-pointer race). + * + * See #19146. + */ + void checkTSO(StgTSO *tso) { @@ -761,9 +782,11 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && - (tso->global_link == END_TSO_QUEUE || - get_itbl((StgClosure*)tso->global_link)->type == TSO)); + + // This assertion is sadly not viable. See Note [Sanity-checking global_link]. + //ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && + // (tso->global_link == END_TSO_QUEUE || + // get_itbl((StgClosure*)tso->global_link)->type == TSO)); if (tso->label) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->label)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2bcf3472a825bafc11e90b5e5f8b8d40cd6bc67...593058d280912576c595a0d6e3619c7f90cbaf0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2bcf3472a825bafc11e90b5e5f8b8d40cd6bc67...593058d280912576c595a0d6e3619c7f90cbaf0a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 19:55:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 02 May 2023 15:55:14 -0400 Subject: [Git][ghc/ghc][wip/T19146] 7 commits: rts: Clear block_info when unblocking Message-ID: <64516aa2db4e7_3c911551f2c1347c@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: d1540380 by Ben Gamari at 2023-05-02T15:50:41-04:00 rts: Clear block_info when unblocking Otherwise we may end up with dangling pointers which may complicate debugging. - - - - - 251f4a5a by Ben Gamari at 2023-05-02T15:52:07-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - 4102dbc3 by Ben Gamari at 2023-05-02T15:52:37-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - c5a93c73 by Ben Gamari at 2023-05-02T15:53:50-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 71fb0a37 by Ben Gamari at 2023-05-02T15:53:53-04:00 rts: Assert that pointers aren't cleared This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 0aeb9d4f by Ben Gamari at 2023-05-02T15:54:40-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - 280bace4 by Ben Gamari at 2023-05-02T15:54:59-04:00 rts: Introduce printGlobalThreads - - - - - 13 changed files: - rts/RaiseAsync.c - rts/RtsFlags.c - rts/RtsMessages.c - rts/Schedule.c - rts/Threads.c - rts/Threads.h - rts/include/Cmm.h - rts/include/MachDeps.h - rts/include/rts/storage/ClosureMacros.h - rts/posix/Select.c - rts/sm/MarkWeak.c - rts/sm/Sanity.c - rts/win32/AsyncMIO.c Changes: ===================================== rts/RaiseAsync.c ===================================== @@ -729,6 +729,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) done: tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap, tso); } @@ -1092,6 +1093,7 @@ done: // wake it up if (tso->why_blocked != NotBlocked) { tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); } ===================================== rts/RtsFlags.c ===================================== @@ -2201,13 +2201,14 @@ static void read_debug_flags(const char* arg) } // -Dx also turns on -v. Use -l to direct trace // events to the .eventlog file instead. - RtsFlags.TraceFlags.tracing = TRACE_STDERR; - - // sanity implies zero_on_gc - if(RtsFlags.DebugFlags.sanity){ - RtsFlags.DebugFlags.zero_on_gc = true; - } + if (RtsFlags.TraceFlags.tracing == TRACE_NONE) { + RtsFlags.TraceFlags.tracing = TRACE_STDERR; + } + // sanity implies zero_on_gc + if(RtsFlags.DebugFlags.sanity){ + RtsFlags.DebugFlags.zero_on_gc = true; + } } #endif ===================================== rts/RtsMessages.c ===================================== @@ -186,7 +186,12 @@ rtsFatalInternalErrorFn(const char *s, va_list ap) #endif #if defined(TRACING) - if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG) endEventLogging(); + if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG) { + // Use flushAllCapsEventsBufs rather than endEventLogging here since + // the latter insists on acquiring all capabilities to flush the eventlog; + // this would deadlock if we barfed during a GC. + flushAllCapsEventsBufs(); + } #endif abort(); ===================================== rts/Schedule.c ===================================== @@ -2565,7 +2565,8 @@ resumeThread (void *task_) traceEventRunThread(cap, tso); /* Reset blocking status */ - tso->why_blocked = NotBlocked; + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; if ((tso->flags & TSO_BLOCKEX) == 0) { // avoid locking the TSO if we don't have to ===================================== rts/Threads.c ===================================== @@ -334,6 +334,7 @@ unblock: // just run the thread now, if the BH is not really available, // we'll block again. tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); // We used to set the context switch flag here, which would @@ -1007,6 +1008,20 @@ printAllThreads(void) } } +void +printGlobalThreads(void) +{ + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + debugBelch("\ngen %d\n", g); + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu)\n", t, t->id); + } + for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + } + } +} + // useful from gdb void printThreadQueue(StgTSO *t) ===================================== rts/Threads.h ===================================== @@ -46,6 +46,7 @@ bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value); void printThreadBlockage (StgTSO *tso); void printThreadStatus (StgTSO *t); void printAllThreads (void); +void printGlobalThreads(void); void printThreadQueue (StgTSO *t); #endif ===================================== rts/include/Cmm.h ===================================== @@ -605,16 +605,20 @@ #define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK) #define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT) +#define LOOKS_LIKE_PTR(p) ((p) != NULL && (p) != INVALID_GHC_POINTER) + /* Debugging macros */ #define LOOKS_LIKE_INFO_PTR(p) \ - ((p) != NULL && \ + (LOOKS_LIKE_PTR(p) && \ LOOKS_LIKE_INFO_PTR_NOT_NULL(p)) #define LOOKS_LIKE_INFO_PTR_NOT_NULL(p) \ ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \ (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES)) -#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) +#define LOOKS_LIKE_CLOSURE_PTR(p) \ + ( LOOKS_LIKE_PTR(p) && \ + LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) /* * The layout of the StgFunInfoExtra part of an info table changes ===================================== rts/include/MachDeps.h ===================================== @@ -107,6 +107,17 @@ #endif #endif +// This is the bit-pattern used by the RTS to clear freed memory +// when +RTS -DZ is in use. The LOOKS_LIKE_*_PTR utilities use this +// macro to catch clearly invalid pointers +#if !defined(INVALID_GHC_POINTER) +#if SIZEOF_HSWORD == 4 +#define INVALID_GHC_POINTER 0xaaaaaaaa +#else +#define INVALID_GHC_POINTER 0xaaaaaaaaaaaaaaaa +#endif +#endif + #if !defined(TAG_BITS) #if SIZEOF_HSWORD == 4 #define TAG_BITS 2 ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -270,6 +270,12 @@ EXTERN_INLINE StgClosure *TAG_CLOSURE(StgWord tag,StgClosure * p) make sense... -------------------------------------------------------------------------- */ +EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p); +EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p) +{ + return p && (p != (const void*) INVALID_GHC_POINTER); +} + EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) { @@ -280,12 +286,13 @@ EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p) { - return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); + return LOOKS_LIKE_PTR((const void*) p) && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); } EXTERN_INLINE bool LOOKS_LIKE_CLOSURE_PTR (const void *p); EXTERN_INLINE bool LOOKS_LIKE_CLOSURE_PTR (const void *p) { + if (!LOOKS_LIKE_PTR(p)) return false; const StgInfoTable *info = RELAXED_LOAD(&UNTAG_CONST_CLOSURE((const StgClosure *) (p))->header.info); return LOOKS_LIKE_INFO_PTR((StgWord) info); } ===================================== rts/posix/Select.c ===================================== @@ -106,6 +106,7 @@ static bool wakeUpSleepingThreads (Capability *cap, LowResTime now) } iomgr->sleeping_queue = tso->_link; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %" FMT_StgThreadID "\n", tso->id)); @@ -437,6 +438,7 @@ awaitEvent(Capability *cap, bool wait) debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap,tso); break; ===================================== rts/sm/MarkWeak.c ===================================== @@ -251,7 +251,7 @@ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) */ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads) { - StgTSO *t, *tmp, *next; + StgTSO *t, *next; bool flag = false; for (t = gen->old_threads; t != END_TSO_QUEUE; t = next) { @@ -272,12 +272,14 @@ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_t t->global_link = END_TSO_QUEUE; continue; default: - tmp = t; + { + StgTSO *tmp = t; evacuate((StgClosure **)&tmp); tmp->global_link = *resurrected_threads; *resurrected_threads = tmp; flag = true; } + } } gen->old_threads = END_TSO_QUEUE; @@ -387,18 +389,21 @@ static bool tidyWeakList(generation *gen) } /* - * Walk over the `old_threads` list of the given generation and move any - * reachable threads onto the `threads` list. + * Walk over the given generation's thread list and promote TSOs which are + * reachable via the heap. This will move the TSO from gen->old_threads to + * new_gen->threads. + * + * This has the side-effect of updating the global thread list to account for + * indirections introduced by evacuation. */ static void tidyThreadList (generation *gen) { - StgTSO *t, *tmp, *next, **prev; + StgTSO *next; + StgTSO **prev = &gen->old_threads; - prev = &gen->old_threads; - - for (t = gen->old_threads; t != END_TSO_QUEUE; t = next) { + for (StgTSO *t = gen->old_threads; t != END_TSO_QUEUE; t = next) { - tmp = (StgTSO *)isAlive((StgClosure *)t); + StgTSO *tmp = (StgTSO *)isAlive((StgClosure *)t); if (tmp != NULL) { t = tmp; @@ -426,10 +431,9 @@ static void tidyThreadList (generation *gen) *prev = next; // move this thread onto the correct threads list. - generation *new_gen; - new_gen = Bdescr((P_)t)->gen; + generation *new_gen = Bdescr((P_)t)->gen; t->global_link = new_gen->threads; - new_gen->threads = t; + new_gen->threads = t; } } } ===================================== rts/sm/Sanity.c ===================================== @@ -737,14 +737,34 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* + * Note [Avoid dangling global_link pointers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * TSOs are a bit odd in that they have a global_link pointer field + * which is not scavenged by the GC. This field is used to track the + * generations[_].[old_]threads lists and is ultimately updated by + * MarkWeak.c:tidyThreadList. + + * Typically the fact that this field is not scavenged is fine as all reachable + * TSOs on the heap are guaranteed to be on some generation's thread list and + * therefore will be scavenged by tidyThreadList. However, the sanity checker + * poses a bit of a challenge here as it walks heap blocks directly and + * therefore may encounter TSOs which aren't reachable via the heap. + * For this reason, checkTSO does not check global_link. Instead, we only do + * so in checkGlobalTSOList, which by definition will only look at + * threads which are reachable via a thread list (and therefore must have won + * the forwarding-pointer race). + * + * See #19146. + */ + void checkTSO(StgTSO *tso) { - StgTSO *next = tso->_link; const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; load_load_barrier(); - ASSERT(next == END_TSO_QUEUE || + ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || info == &stg_TSO_info || info == &stg_WHITEHOLE_info); // used to happen due to STM doing @@ -762,9 +782,11 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && - (tso->global_link == END_TSO_QUEUE || - get_itbl((StgClosure*)tso->global_link)->type == TSO)); + + // This assertion is sadly not viable. See Note [Sanity-checking global_link]. + //ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && + // (tso->global_link == END_TSO_QUEUE || + // get_itbl((StgClosure*)tso->global_link)->type == TSO)); if (tso->label) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->label)); ===================================== rts/win32/AsyncMIO.c ===================================== @@ -321,6 +321,7 @@ start: // Terminates the run queue + this inner for-loop. tso->_link = END_TSO_QUEUE; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; // save the StgAsyncIOResult in the // stg_block_async_info stack frame, because // the block_info field will be overwritten by View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/593058d280912576c595a0d6e3619c7f90cbaf0a...280bace467a531d00be6e5d448c528b09b0dbc5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/593058d280912576c595a0d6e3619c7f90cbaf0a...280bace467a531d00be6e5d448c528b09b0dbc5a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 21:26:10 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 02 May 2023 17:26:10 -0400 Subject: [Git][ghc/ghc][wip/T23307] Wibbles Message-ID: <64517ff270320_3c911551f2c14338f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23307 at Glasgow Haskell Compiler / GHC Commits: 76cb9a77 by Simon Peyton Jones at 2023-05-02T22:27:20+01:00 Wibbles * Improve Wrinkle W4 * Delete redundant guard - - - - - 1 changed file: - compiler/GHC/Types/Id/Make.hs Changes: ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -1053,7 +1053,6 @@ dataConSrcToImplBang bang_opts fam_envs arg_ty arg_ty' = case mb_co of { Just redn -> scaledSet arg_ty (reductionReducedType redn) ; Nothing -> arg_ty } - , all (not . isNewTyCon . fst) (splitTyConApp_maybe $ scaledThing arg_ty') , shouldUnpackTy bang_opts unpk_prag fam_envs arg_ty' = if bang_opt_unbox_disable bang_opts then HsStrict True -- Not unpacking because of -O0 @@ -1389,11 +1388,12 @@ shouldUnpackTy bang_opts prag fam_envs ty | (_:_:_) <- data_cons -> False -- Don't unpack sum types automatically, but they can -- be unpacked with an explicit source UNPACK. - | otherwise + | otherwise -- Wrinkle (W4) of Note [Recursive unboxing] -> bang_opt_unbox_strict bang_opts || (bang_opt_unbox_small bang_opts && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields] - where (rep_tys, _) = dataConArgUnpack ty + where + (rep_tys, _) = dataConArgUnpack ty -- Given a type already assumed to have been normalized by topNormaliseType, -- unpackable_type_datacons ty = Just datacons @@ -1496,12 +1496,25 @@ Wrinkles: field of `Unconsed`: we never unpack a sum type without an explicit pragma (see should_unpack). -(W4) We behave conservatively when there is no UNPACK pragma - data T = MkS !T Int - with -funbox-strict-fields or -funbox-small-strict-fields - we behave as if there was an UNPACK pragma there. "Conservative" - in the sense that we recurse more often, which may stop us unboxing - because we find a loop at the toot. +(W4) Consider + data T = MkT !Wombat + data Wombat = MkW {-# UNPACK #-} !S Int + data S = MkS {-# NOUNPACK #-} !Wombat Int + Suppose we are deciding whether to unpack the first field of MkT, by + calling (shouldUnpackTy Wombat). Then we'll try to unpack the !S field + of MkW, and be stopped by the {-# NOUNPACK #-}, and all is fine; we can + unpack MkT. + + If that NOUNPACK had been a UNPACK, though, we'd get a loop, and would + decide not to unpack the Wombat field of MkT. + + But what if there was no pragma in `data S`? Then we /still/ decide not + to unpack the Wombat field of MkT (at least when auto-unpacking is on), + because we don't know for sure which decision will be taken for the + Wombat field of MkS. + + TL;DR when there is no pragma, behave as if there was a UNPACK, at least + when auto-unpacking is on. See `should_unpack` in `shouldUnpackTy`. ************************************************************************ * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76cb9a77b1088e3e4141174ea7d2cb18200b4ac1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76cb9a77b1088e3e4141174ea7d2cb18200b4ac1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 21:35:41 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 02 May 2023 17:35:41 -0400 Subject: [Git][ghc/ghc][wip/T23083] 2 commits: CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead Message-ID: <6451822d60e62_3c911551e141518aa@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: f6c98b85 by Sebastian Graf at 2023-05-02T23:35:21+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - fd286b50 by Sebastian Graf at 2023-05-02T23:35:21+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Utils/Trace.hs - docs/users_guide/using-optimisation.rst - libraries/base/Unsafe/Coerce.hs - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -717,9 +717,12 @@ this exhaustive list can be empty! its scrutinee is (see GHC.Core.Utils.exprIsTrivial). This is actually important; see Note [Empty case is trivial] in GHC.Core.Utils -* An empty case is replaced by its scrutinee during the CoreToStg - conversion; remember STG is un-typed, so there is no need for - the empty case to do the type conversion. +* We lower empty cases in GHC.CoreToStg to an eval on the scrutinee. + +Historical Note: We used to lower EmptyCase in CorePrep by way of an +unsafeCoercion on the scrutinee, but that yielded panics in CodeGen when +we were beginning to eta expand in arguments, plus required to mess with +heterogenously-kinded coercions. It's simpler to stick to it just a bit longer. Note [Join points] ~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1390,7 +1390,6 @@ setNominalRole_maybe r co | case prov of PhantomProv _ -> False -- should always be phantom ProofIrrelProv _ -> True -- it's always safe PluginProv _ -> False -- who knows? This choice is conservative. - CorePrepProv _ -> True = Just $ UnivCo prov Nominal co1 co2 setNominalRole_maybe_helper _ = Nothing @@ -1516,7 +1515,6 @@ promoteCoercion co = case co of UnivCo (PhantomProv kco) _ _ _ -> kco UnivCo (ProofIrrelProv kco) _ _ _ -> kco UnivCo (PluginProv _) _ _ _ -> mkKindCo co - UnivCo (CorePrepProv _) _ _ _ -> mkKindCo co SymCo g -> mkSymCo (promoteCoercion g) @@ -2339,7 +2337,6 @@ seqProv :: UnivCoProvenance -> () seqProv (PhantomProv co) = seqCo co seqProv (ProofIrrelProv co) = seqCo co seqProv (PluginProv _) = () -seqProv (CorePrepProv _) = () seqCos :: [Coercion] -> () seqCos [] = () ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -622,7 +622,6 @@ opt_univ env sym prov role oty1 oty2 #endif ProofIrrelProv kco -> ProofIrrelProv $ opt_co4_wrap env sym False Nominal kco PluginProv _ -> prov - CorePrepProv _ -> prov ------------- opt_transList :: HasDebugCallStack => InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -410,7 +410,6 @@ orphNamesOfProv :: UnivCoProvenance -> NameSet orphNamesOfProv (PhantomProv co) = orphNamesOfCo co orphNamesOfProv (ProofIrrelProv co) = orphNamesOfCo co orphNamesOfProv (PluginProv _) = emptyNameSet -orphNamesOfProv (CorePrepProv _) = emptyNameSet orphNamesOfCos :: [Coercion] -> NameSet orphNamesOfCos = orphNamesOfThings orphNamesOfCo @@ -798,4 +797,3 @@ freeVars = go go (Type ty) = (tyCoVarsOfTypeDSet ty, AnnType ty) go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co) - ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2301,9 +2301,6 @@ lintCoercion co@(UnivCo prov r ty1 ty2) -- see #9122 for discussion of these checks checkTypes t1 t2 - | allow_ill_kinded_univ_co prov - = return () -- Skip kind checks - | otherwise = do { checkWarnL fixed_rep_1 (report "left-hand type does not have a fixed runtime representation") ; checkWarnL fixed_rep_2 @@ -2321,13 +2318,6 @@ lintCoercion co@(UnivCo prov r ty1 ty2) reps1 = typePrimRep t1 reps2 = typePrimRep t2 - -- CorePrep deliberately makes ill-kinded casts - -- e.g (case error @Int "blah" of {}) :: Int# - -- ==> (error @Int "blah") |> Unsafe Int Int# - -- See Note [Unsafe coercions] in GHC.Core.CoreToStg.Prep - allow_ill_kinded_univ_co (CorePrepProv homo_kind) = not homo_kind - allow_ill_kinded_univ_co _ = False - validateCoercion :: PrimRep -> PrimRep -> LintM () validateCoercion rep1 rep2 = do { platform <- getPlatform @@ -2357,8 +2347,7 @@ lintCoercion co@(UnivCo prov r ty1 ty2) ; check_kinds kco k1 k2 ; return (ProofIrrelProv kco') } - lint_prov _ _ prov@(PluginProv _) = return prov - lint_prov _ _ prov@(CorePrepProv _) = return prov + lint_prov _ _ prov@(PluginProv _) = return prov check_kinds kco k1 k2 = do { let Pair k1' k2' = coercionKind kco ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -661,7 +661,6 @@ tyCoFVsOfProv :: UnivCoProvenance -> FV tyCoFVsOfProv (PhantomProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfProv (PluginProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc -tyCoFVsOfProv (CorePrepProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc tyCoFVsOfCos :: [Coercion] -> FV tyCoFVsOfCos [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc @@ -731,8 +730,7 @@ almost_devoid_co_var_of_prov (PhantomProv co) cv = almost_devoid_co_var_of_co co cv almost_devoid_co_var_of_prov (ProofIrrelProv co) cv = almost_devoid_co_var_of_co co cv -almost_devoid_co_var_of_prov (PluginProv _) _ = True -almost_devoid_co_var_of_prov (CorePrepProv _) _ = True +almost_devoid_co_var_of_prov (PluginProv _) _ = True almost_devoid_co_var_of_type :: Type -> CoVar -> Bool almost_devoid_co_var_of_type (TyVarTy _) _ = True @@ -1131,9 +1129,6 @@ tyConsOfType ty go_prov (PhantomProv co) = go_co co go_prov (ProofIrrelProv co) = go_co co go_prov (PluginProv _) = emptyUniqSet - go_prov (CorePrepProv _) = emptyUniqSet - -- this last case can happen from the tyConsOfType used from - -- checkTauTvUpdate go_cos cos = foldr (unionUniqSets . go_co) emptyUniqSet cos @@ -1345,5 +1340,3 @@ occCheckExpand vs_to_avoid ty go_prov cxt (PhantomProv co) = PhantomProv <$> go_co cxt co go_prov cxt (ProofIrrelProv co) = ProofIrrelProv <$> go_co cxt co go_prov _ p@(PluginProv _) = return p - go_prov _ p@(CorePrepProv _) = return p - ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1437,17 +1437,12 @@ data UnivCoProvenance | PluginProv String -- ^ From a plugin, which asserts that this coercion -- is sound. The string is for the use of the plugin. - | CorePrepProv -- See Note [Unsafe coercions] in GHC.Core.CoreToStg.Prep - Bool -- True <=> the UnivCo must be homogeneously kinded - -- False <=> allow hetero-kinded, e.g. Int ~ Int# - deriving Data.Data instance Outputable UnivCoProvenance where ppr (PhantomProv _) = text "(phantom)" ppr (ProofIrrelProv _) = text "(proof irrel.)" ppr (PluginProv str) = parens (text "plugin" <+> brackets (text str)) - ppr (CorePrepProv _) = text "(CorePrep)" -- | A coercion to be filled in by the type-checker. See Note [Coercion holes] data CoercionHole @@ -1760,7 +1755,6 @@ foldTyCo (TyCoFolder { tcf_view = view go_prov env (PhantomProv co) = go_co env co go_prov env (ProofIrrelProv co) = go_co env co go_prov _ (PluginProv _) = mempty - go_prov _ (CorePrepProv _) = mempty -- | A view function that looks through nothing. noView :: Type -> Maybe Type @@ -1826,7 +1820,6 @@ provSize :: UnivCoProvenance -> Int provSize (PhantomProv co) = 1 + coercionSize co provSize (ProofIrrelProv co) = 1 + coercionSize co provSize (PluginProv _) = 1 -provSize (CorePrepProv _) = 1 {- ************************************************************************ ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -912,7 +912,6 @@ subst_co subst co go_prov (PhantomProv kco) = PhantomProv (go kco) go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco) go_prov p@(PluginProv _) = p - go_prov p@(CorePrepProv _) = p -- See Note [Substituting in a coercion hole] go_hole h@(CoercionHole { ch_co_var = cv }) ===================================== compiler/GHC/Core/TyCo/Tidy.hs ===================================== @@ -252,7 +252,6 @@ tidyCo env@(_, subst) co go_prov (PhantomProv co) = PhantomProv $! go co go_prov (ProofIrrelProv co) = ProofIrrelProv $! go co go_prov p@(PluginProv _) = p - go_prov p@(CorePrepProv _) = p tidyCos :: TidyEnv -> [Coercion] -> [Coercion] tidyCos env = strictMap (tidyCo env) ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -580,7 +580,6 @@ expandTypeSynonyms ty go_prov subst (PhantomProv co) = PhantomProv (go_co subst co) go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co) go_prov _ p@(PluginProv _) = p - go_prov _ p@(CorePrepProv _) = p -- the "False" and "const" are to accommodate the type of -- substForAllCoBndrUsing, which is general enough to @@ -998,7 +997,6 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar go_prov env (PhantomProv co) = PhantomProv <$> go_co env co go_prov env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co go_prov _ p@(PluginProv _) = return p - go_prov _ p@(CorePrepProv _) = return p {- ********************************************************************* ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -249,8 +249,11 @@ inlineBoringOk e , exprIsTrivial a = go (credit-1) f go credit (Tick _ e) = go credit e -- dubious go credit (Cast e _) = go credit e - go credit (Case scrut _ _ [Alt _ _ rhs]) -- See Note [Inline unsafeCoerce] - | isUnsafeEqualityProof scrut = go credit rhs + go credit (Case e b _ alts) + | null alts + = go credit e -- EmptyCase is like e + | Just rhs <- isUnsafeEqualityCase e b alts + = go credit rhs -- See Note [Inline unsafeCoerce] go _ (Var {}) = boringCxtOk go _ (Lit l) = litIsTrivial l && boringCxtOk go _ _ = boringCxtNotOk @@ -304,7 +307,7 @@ calcUnfoldingGuidance opts is_top_bottoming expr We really want to inline unsafeCoerce, even when applied to boring arguments. It doesn't look as if its RHS is smaller than the call unsafeCoerce x = case unsafeEqualityProof @a @b of UnsafeRefl -> x -but that case is discarded -- see Note [Implementing unsafeCoerce] +but that case is discarded in CoreToStg -- see Note [Implementing unsafeCoerce] in base:Unsafe.Coerce. Moreover, if we /don't/ inline it, we may be left with @@ -312,7 +315,9 @@ Moreover, if we /don't/ inline it, we may be left with which will build a thunk -- bad, bad, bad. Conclusion: we really want inlineBoringOk to be True of the RHS of -unsafeCoerce. This is (U4) in Note [Implementing unsafeCoerce]. +unsafeCoerce. And it really is, because we regard + case unsafeEqualityProof @a @b of UnsafeRefl -> rhs +as trivial iff rhs is. This is (U4) in Note [Implementing unsafeCoerce]. Note [Computing the size of an expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -59,7 +59,7 @@ module GHC.Core.Utils ( mkStrictFieldSeqs, shouldStrictifyIdForCbv, shouldUseCbvForId, -- * unsafeEqualityProof - isUnsafeEqualityProof, + isUnsafeEqualityCase, -- * Dumping stuff dumpIdInfoOfProgram @@ -79,7 +79,7 @@ import GHC.Core.Reduction import GHC.Core.TyCon import GHC.Core.Multiplicity -import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofIdKey ) +import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofIdKey, unsafeReflDataConKey ) import GHC.Builtin.PrimOps import GHC.Types.Var @@ -1072,7 +1072,11 @@ trivial_expr_fold k_id k_lit k_triv k_not_triv = go go (Lam b e) | not (isRuntimeVar b) = go e go (Tick t e) | not (tickishIsCode t) = go e -- See Note [Tick trivial] go (Cast e _) = go e - go (Case e _ _ []) = go e -- See Note [Empty case is trivial] + go (Case e b _ as) + | null as + = go e -- See Note [Empty case is trivial] + | Just rhs <- isUnsafeEqualityCase e b as + = go rhs -- See (U2) of Note [Implementing unsafeCoerce] in base:Unsafe.Coerce go _ = k_not_triv exprIsTrivial :: CoreExpr -> Bool @@ -2707,11 +2711,22 @@ wantCbvForId cbv_for_strict v * * ********************************************************************* -} -isUnsafeEqualityProof :: CoreExpr -> Bool +isUnsafeEqualityCase :: CoreExpr -> Id -> [CoreAlt] -> Maybe CoreExpr -- See (U3) and (U4) in -- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce -isUnsafeEqualityProof e - | Var v `App` Type _ `App` Type _ `App` Type _ <- e - = v `hasKey` unsafeEqualityProofIdKey - | otherwise - = False +isUnsafeEqualityCase scrut bndr [Alt ac _ rhs] + | DataAlt dc <- ac + , not (dc `hasKey` unsafeReflDataConKey) + = Nothing -- fast path for DataAlt + + | isDeadBinder bndr + -- We can only discard the case if the case-binder is dead + -- It usually is, but see #18227 + , Var v `App` _ `App` _ `App` _ <- scrut + , v `hasKey` unsafeEqualityProofIdKey + -- Check that the scrutinee really is unsafeEqualityProof + -- and not, say, error + = Just rhs + +isUnsafeEqualityCase _ _ _ + = Nothing ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -321,7 +321,6 @@ toIfaceCoercionX fr co go_prov (PhantomProv co) = IfacePhantomProv (go co) go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co) go_prov (PluginProv str) = IfacePluginProv str - go_prov (CorePrepProv b) = IfaceCorePrepProv b toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs toIfaceTcArgs = toIfaceTcArgsX emptyVarSet ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -19,8 +19,7 @@ module GHC.CoreToStg ( CoreToStgOpts (..), coreToStg ) where import GHC.Prelude import GHC.Core -import GHC.Core.Utils ( exprType, findDefault, isJoinBind - , exprIsTickedString_maybe ) +import GHC.Core.Utils import GHC.Core.Opt.Arity ( manifestArity ) import GHC.Core.Type import GHC.Core.TyCon @@ -49,7 +48,7 @@ import GHC.Unit.Module import GHC.Data.FastString import GHC.Platform ( Platform ) import GHC.Platform.Ways -import GHC.Builtin.PrimOps ( PrimCall(..), primOpWrapperId ) +import GHC.Builtin.PrimOps import GHC.Utils.Outputable import GHC.Utils.Monad @@ -430,30 +429,23 @@ coreToStgExpr (Cast expr _) = coreToStgExpr expr -- Cases require a little more real work. - -{- -coreToStgExpr (Case scrut _ _ []) +coreToStgExpr (Case scrut bndr _ alts) + | null alts + -- See Note [Empty case alternatives] in GHC.Core If the case + -- alternatives are empty, the scrutinee must diverge or raise an + -- exception, so we can just dive into it. + -- + -- Of course this may seg-fault if the scrutinee *does* return. A + -- belt-and-braces approach would be to move this case into the + -- code generator, and put a return point anyway that calls a + -- runtime system error function. = coreToStgExpr scrut - -- See Note [Empty case alternatives] in GHC.Core If the case - -- alternatives are empty, the scrutinee must diverge or raise an - -- exception, so we can just dive into it. - -- - -- Of course this may seg-fault if the scrutinee *does* return. A - -- belt-and-braces approach would be to move this case into the - -- code generator, and put a return point anyway that calls a - -- runtime system error function. - -coreToStgExpr e0@(Case scrut bndr _ [alt]) = do - | isUnsafeEqualityProof scrut - , isDeadBinder bndr -- We can only discard the case if the case-binder is dead - -- It usually is, but see #18227 - , (_,_,rhs) <- alt + + | Just rhs <- isUnsafeEqualityCase scrut bndr alts + -- See (U2) in Note [Implementing unsafeCoerce] in base:Unsafe.Coerce = coreToStgExpr rhs - -- See (U2) in Note [Implementing unsafeCoerce] in base:Unsafe.Coerce --} --- The normal case for case-expressions -coreToStgExpr (Case scrut bndr _ alts) + | otherwise = do { scrut2 <- coreToStgExpr scrut ; alts2 <- extendVarEnvCts [(bndr, LambdaBound)] (mapM vars_alt alts) ; return (StgCase scrut2 bndr (mkStgAltType bndr alts) alts2) } @@ -574,6 +566,15 @@ coreToStgApp f args ticks = do -- This is the guy that turns applications into A-normal form -- --------------------------------------------------------------------------- +getStgArgFromTrivialArg :: HasDebugCallStack => CoreArg -> StgArg +-- A (non-erased) trivial CoreArg corresponds to an atomic StgArg. +-- CoreArgs may not immediately look trivial, e.g., `case e of {}` or +-- `case unsafeequalityProof of UnsafeRefl -> e` might intervene. +-- Good thing we can just call `trivial_expr_fold` here. +getStgArgFromTrivialArg e = trivial_expr_fold StgVarArg StgLitArg panic panic e + where + panic = pprPanic "getStgArgFromTrivialArg" (ppr e) + coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish]) coreToStgArgs [] = return ([], []) @@ -586,42 +587,29 @@ coreToStgArgs (Coercion _ : args) -- Coercion argument; See Note [Coercion token = do { (args', ts) <- coreToStgArgs args ; return (StgVarArg coercionTokenId : args', ts) } -coreToStgArgs (Tick t e : args) - = assert (not (tickishIsCode t)) $ - do { (args', ts) <- coreToStgArgs (e : args) - ; let !t' = coreToStgTick (exprType e) t - ; return (args', t':ts) } - coreToStgArgs (arg : args) = do -- Non-type argument (stg_args, ticks) <- coreToStgArgs args - arg' <- coreToStgExpr arg - let - (aticks, arg'') = stripStgTicksTop tickishFloatable arg' - stg_arg = case arg'' of - StgApp v [] -> StgVarArg v - StgConApp con _ [] _ -> StgVarArg (dataConWorkId con) - StgOpApp (StgPrimOp op) [] _ -> StgVarArg (primOpWrapperId op) - StgLit lit -> StgLitArg lit - _ -> pprPanic "coreToStgArgs" (ppr arg $$ pprStgExpr panicStgPprOpts arg' $$ pprStgExpr panicStgPprOpts arg'') - - -- WARNING: what if we have an argument like (v `cast` co) - -- where 'co' changes the representation type? - -- (This really only happens if co is unsafe.) - -- Then all the getArgAmode stuff in CgBindery will set the - -- cg_rep of the CgIdInfo based on the type of v, rather - -- than the type of 'co'. - -- This matters particularly when the function is a primop - -- or foreign call. - -- Wanted: a better solution than this hacky warning - + -- We know that `arg` must be trivial, but it may contain Ticks. + -- Example from test case `decodeMyStack`: + -- $ @... ((src Data.Tuple.snd) @Int @[..]) + -- Note that unfortunately the Tick is not at the top. + -- So we'll traverse the expression twice: + -- * Once with `stripTicksT` (which collects *all* ticks from the expression) + -- * and another time with `getStgArgFromTrivialArg`. + -- Since the argument is trivial, the only place the Tick can occur is + -- somehow wrapping a variable (give or take type args, as above). platform <- getPlatform - let - arg_rep = typePrimRep (exprType arg) - stg_arg_rep = typePrimRep (stgArgType stg_arg) + let arg_ty = exprType arg + ticks' = map (coreToStgTick arg_ty) (stripTicksT (not . tickishIsCode) arg) + arg' = getStgArgFromTrivialArg arg + arg_rep = typePrimRep arg_ty + stg_arg_rep = typePrimRep (stgArgType arg') bad_args = not (primRepsCompatible platform arg_rep stg_arg_rep) - warnPprTrace bad_args "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" (ppr arg) $ - return (stg_arg : stg_args, ticks ++ aticks) + massertPpr (length ticks' <= 1) (text "More than one Tick in trivial arg:" <+> ppr arg) + warnPprTraceM bad_args "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" (ppr arg) + + return (arg' : stg_args, ticks' ++ ticks) coreToStgTick :: Type -- type of the ticked expression -> CoreTickish @@ -959,6 +947,9 @@ myCollectBinders expr -- | If the argument expression is (potential chain of) 'App', return the head -- of the app chain, and collect ticks/args along the chain. +-- INVARIANT: If the app head is trivial, return the atomic Var/Lit that was +-- wrapped in casts, empty case, ticks, etc. +-- So keep in sync with 'exprIsTrivial'. myCollectArgs :: HasDebugCallStack => CoreExpr -> (CoreExpr, [CoreArg], [CoreTickish]) myCollectArgs expr = go expr [] [] @@ -970,8 +961,14 @@ myCollectArgs expr -- See Note [Ticks in applications] go e as (t:ts) -- ticks can appear in type apps go (Cast e _) as ts = go e as ts + go (Case e b _ alts) as ts + | null alts + = assertPpr (null as) (ppr e $$ ppr as $$ ppr expr) $ + go e [] ts -- NB: Empty case discards arguments + | Just rhs <- isUnsafeEqualityCase e b alts + = go rhs as ts -- Discards unsafeCoerce in App heads go (Lam b e) as ts - | isTyVar b = go e as ts -- Note [Collect args] + | isTyVar b = go e (drop 1 as) ts -- Note [Collect args] go e as ts = (e, as, ts) {- Note [Collect args] ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -40,12 +40,10 @@ import GHC.Core.Coercion import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.Opt.OccurAnal -import GHC.Core.TyCo.Rep( UnivCoProvenance(..) ) import GHC.Data.Maybe import GHC.Data.OrdList import GHC.Data.FastString -import GHC.Data.Pair import GHC.Data.Graph.UnVar import GHC.Utils.Error @@ -70,8 +68,7 @@ import GHC.Types.Tickish import GHC.Types.TyThing import GHC.Types.Unique.Supply -import Data.List ( unfoldr ) -import Data.Functor.Identity +import Data.List ( unfoldr, partition ) import Control.Monad {- @@ -142,10 +139,7 @@ The goal of this pass is to prepare for code generation. profiling mode. We have to do this here because we won't have unfoldings after this pass (see `trimUnfolding` and Note [Drop unfoldings and rules]. -12. Eliminate case clutter in favour of unsafe coercions. - See Note [Unsafe coercions] - -13. Eliminate some magic Ids, specifically +12. Eliminate some magic Ids, specifically runRW# (\s. e) ==> e[readWorldId/s] lazy e ==> e (see Note [lazyId magic] in GHC.Types.Id.Make) noinline e ==> e @@ -157,48 +151,6 @@ This is all done modulo type applications and abstractions, so that when type erasure is done for conversion to STG, we don't end up with any trivial or useless bindings. -Note [Unsafe coercions] -~~~~~~~~~~~~~~~~~~~~~~~ -CorePrep does these two transformations: - -1. Convert empty case to cast with an unsafe coercion - (case e of {}) ===> e |> unsafe-co - See Note [Empty case alternatives] in GHC.Core: if the case - alternatives are empty, the scrutinee must diverge or raise an - exception, so we can just dive into it. - - Of course, if the scrutinee *does* return, we may get a seg-fault. - A belt-and-braces approach would be to persist empty-alternative - cases to code generator, and put a return point anyway that calls a - runtime system error function. - - Notice that eliminating empty case can lead to an ill-kinded coercion - case error @Int "foo" of {} :: Int# - ===> error @Int "foo" |> unsafe-co - where unsafe-co :: Int ~ Int# - But that's fine because the expression diverges anyway. And it's - no different to what happened before. - -2. Eliminate unsafeEqualityProof in favour of an unsafe coercion - case unsafeEqualityProof of UnsafeRefl g -> e - ===> e[unsafe-co/g] - See (U2) in Note [Implementing unsafeCoerce] in base:Unsafe.Coerce - - Note that this requires us to substitute 'unsafe-co' for 'g', and - that is the main (current) reason for cpe_tyco_env in CorePrepEnv. - Tiresome, but not difficult. - -These transformations get rid of "case clutter", leaving only casts. -We are doing no further significant transformations, so the reasons -for the case forms have disappeared. And it is extremely helpful for -the ANF-ery, CoreToStg, and backends, if trivial expressions really do -look trivial. #19700 was an example. - -In both cases, the "unsafe-co" is just (UnivCo ty1 ty2 (CorePrepProv b)), -The boolean 'b' says whether the unsafe coercion is supposed to be -kind-homogeneous (yes for (2), no for (1). This information is used -/only/ by Lint. - Note [CorePrep invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~ Here is the syntax of the Core produced by CorePrep: @@ -628,11 +580,14 @@ cpeBind top_lvl env (Rec pairs) bndrs1 rhss ; let (floats_s, rhss1) = unzip stuff - all_pairs = foldrOL add_float (bndrs1 `zip` rhss1) - (concatFloats floats_s) + (strs, floats) = partitionOL isFloatString (concatFloats floats_s) + str_floats = mkFloats strs + all_pairs = foldrOL add_float (bndrs1 `zip` rhss1) floats + + -- use env below, so that we reset cpe_rec_ids ; return (extendCorePrepEnvList env (bndrs `zip` bndrs1), - unitFloat (FloatLet (Rec all_pairs)), + str_floats `appendFloats` unitFloat (FloatLet (Rec all_pairs)), Nothing) } | otherwise -- See Note [Join points and floating] @@ -652,7 +607,8 @@ cpeBind top_lvl env (Rec pairs) -- group into a single giant Rec add_float (FloatLet (NonRec b r)) prs2 = (b,r) : prs2 add_float (FloatLet (Rec prs1)) prs2 = prs1 ++ prs2 - add_float b _ = pprPanic "cpeBind" (ppr b) + add_float (FloatString r b) prs2 = (b,r):prs2 + add_float b _ = pprPanic "cpeBind" (ppr b) --------------- cpePair :: TopLevelFlag -> RecFlag -> Demand -> Bool @@ -785,10 +741,10 @@ cpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs) -- For example -- f (g x) ===> ([v = g x], f v) -cpeRhsE env (Type ty) - = return (emptyFloats, Type (cpSubstTy env ty)) -cpeRhsE env (Coercion co) - = return (emptyFloats, Coercion (cpSubstCo env co)) +cpeRhsE _ (Type ty) + = return (emptyFloats, Type ty) +cpeRhsE _ (Coercion co) + = return (emptyFloats, Coercion co) cpeRhsE env expr@(Lit (LitNumber nt i)) = case cp_convertNumLit (cpe_config env) nt i of Nothing -> return (emptyFloats, expr) @@ -822,7 +778,7 @@ cpeRhsE env (Tick tickish expr) cpeRhsE env (Cast expr co) = do { (floats, expr') <- cpeRhsE env expr - ; return (floats, Cast expr' (cpSubstCo env co)) } + ; return (floats, Cast expr' co) } cpeRhsE env expr@(Lam {}) = do { let (bndrs,body) = collectBinders expr @@ -830,36 +786,6 @@ cpeRhsE env expr@(Lam {}) ; body' <- cpeBodyNF env' body ; return (emptyFloats, mkLams bndrs' body') } --- Eliminate empty case --- See Note [Unsafe coercions] -cpeRhsE env (Case scrut _ ty []) - = do { (floats, scrut') <- cpeRhsE env scrut - ; let ty' = cpSubstTy env ty - scrut_ty' = exprType scrut' - co' = mkUnivCo prov Representational scrut_ty' ty' - prov = CorePrepProv False - -- False says that the kinds of two types may differ - -- E.g. we might cast Int to Int#. This is fine - -- because the scrutinee is guaranteed to diverge - - ; return (floats, Cast scrut' co') } - -- This can give rise to - -- Warning: Unsafe coercion: between unboxed and boxed value - -- but it's fine because 'scrut' diverges - --- Eliminate unsafeEqualityProof --- See Note [Unsafe coercions] -cpeRhsE env (Case scrut bndr _ alts) - | isUnsafeEqualityProof scrut - , isDeadBinder bndr -- We can only discard the case if the case-binder - -- is dead. It usually is, but see #18227 - , [Alt _ [co_var] rhs] <- alts - , let Pair ty1 ty2 = coVarTypes co_var - the_co = mkUnivCo prov Nominal (cpSubstTy env ty1) (cpSubstTy env ty2) - prov = CorePrepProv True -- True <=> kind homogeneous - env' = extendCoVarEnv env co_var the_co - = cpeRhsE env' rhs - cpeRhsE env (Case scrut bndr ty alts) = do { (floats, scrut') <- cpeBody env scrut ; (env', bndr2) <- cpCloneBndr env bndr @@ -1205,14 +1131,10 @@ cpeApp top_env expr in rebuild_app' env (a : as) tick_fun floats ss rt_ticks req_depth CpeApp (Type arg_ty) - -> rebuild_app' env as (App fun' (Type arg_ty')) floats ss rt_ticks req_depth - where - arg_ty' = cpSubstTy env arg_ty + -> rebuild_app' env as (App fun' (Type arg_ty)) floats ss rt_ticks req_depth CpeApp (Coercion co) - -> rebuild_app' env as (App fun' (Coercion co')) floats (drop 1 ss) rt_ticks req_depth - where - co' = cpSubstCo env co + -> rebuild_app' env as (App fun' (Coercion co)) floats (drop 1 ss) rt_ticks req_depth CpeApp arg -> do let (ss1, ss_rest) -- See Note [lazyId magic] in GHC.Types.Id.Make @@ -1224,9 +1146,7 @@ cpeApp top_env expr rebuild_app' env as (App fun' arg') (fs `appendFloats` floats) ss_rest rt_ticks (req_depth-1) CpeCast co - -> rebuild_app' env as (Cast fun' co') floats ss rt_ticks req_depth - where - co' = cpSubstCo env co + -> rebuild_app' env as (Cast fun' co) floats ss rt_ticks req_depth -- See Note [Ticks and mandatory eta expansion] CpeTick tickish | tickishPlace tickish == PlaceRuntime @@ -1478,9 +1398,8 @@ But actually, it doesn't, because "turtle"# is already an HNF. Here is the Cmm: Sp = Sp + 8; call Control.Exception.Base.petError_info(R2) args: 8, res: 0, upd: 8; -Besides, with -O, FloatOut will already have already floated "turtle"# to the -top-level, where CSE has a chance to deduplicate strings early (before the -linker, that is). +Besides, with -O, FloatOut will have floated "turtle"# to the top-level, where +CSE has a chance to deduplicate strings early (before the linker, that is). -} -- This is where we arrange that a non-trivial argument is let-bound @@ -1502,11 +1421,32 @@ cpeArg env dmd arg ; if exprIsTrivial arg2 then return (floats2, arg2) else do { v <- newVar arg_ty - ; let arg3 = cpeEtaExpand (exprArity arg2) arg2 + -- See Note [Eta expansion of arguments in CorePrep] + ; let arity | Just ao <- cp_arityOpts (cpe_config env) -- Just <=> -O2 + , not (is_join_head arg2) + -- See Note [Eta expansion for join points] + -- Eta expanding the join point would + -- introduce crap that we can't generate + -- code for + = case exprEtaExpandArity ao arg2 of + Nothing -> 0 + Just at -> arityTypeArity at + | otherwise + = exprArity arg2 -- this is cheap enough for -O0 and -O1 + arg3 = cpeEtaExpand arity arg2 arg_float = mkFloat env dmd is_unlifted v arg3 ; return (addFloat floats2 arg_float, varToCoreExpr v) } } +is_join_head :: CoreExpr -> Bool +-- ^ Identify the cases where our mishandling described in +-- Note [Eta expansion for join points] would generate crap +is_join_head (Let bs e) = isJoinBind bs || is_join_head e +is_join_head (Cast e _) = is_join_head e +is_join_head (Tick _ e) = is_join_head e +is_join_head (Case _ _ _ alts) = any is_join_head (rhssOfAlts alts) +is_join_head _ = False + {- Note [Floating unlifted arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1624,6 +1564,44 @@ and now we do NOT want eta expansion to give Instead GHC.Core.Opt.Arity.etaExpand gives f = /\a -> \y -> let s = h 3 in g s y +Note [Eta expansion of arguments in CorePrep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose `g = \x y. blah` and consider the expression `f (g x)`; we ANFise to + + let t = g x + in f t + +We really don't want that `t` to be a thunk! That just wastes runtime, updating +a thunk with a PAP etc. The code generator could in principle allocate a PAP, +but in fact it does not know how to do that -- it's easier just to eta-expand: + + let t = \y. g x y + in f t + +To what arity should we eta-expand the argument? `cpeArg` uses two strategies, +governed by the presence of `-fdo-clever-arg-eta-expansion` (implied by -O): + + 1. Cheap, with -O0: just use `exprArity`. + 2. More clever but expensive, with -O1 -O2: use `exprEtaExpandArity`, + same function the Simplifier uses to eta expand RHSs and lambda bodies. + +The only reason for using (1) rather than (2) is to keep compile times down. +Using (2) in -O0 bumped up compiler allocations by 2-3% in tests T4801 and +T5321*. However, Plan (2) catches cases that (1) misses. +For example (#23083, assuming -fno-pedantic-bottoms): + + let t = case z of __DEFAULT -> g x + in f t + +to + + let t = \y -> case z of __DEFAULT -> g x y + in f t + +Note that there is a missed opportunity in eta expanding `t` earlier, in the +Simplifier: It would allow us to inline `g`, potentially enabling further +simplification. But then we could have inlined `g` into the PAP to begin with, +and that is discussed in #23150; hence we needn't worry about that in CorePrep. -} cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs @@ -1728,24 +1706,36 @@ where marking recursive DFuns (of undecidable *instances*) strict in dictionary -} data FloatingBind - = FloatLet CoreBind -- Rhs of bindings are CpeRhss - -- They are always of lifted type; - -- unlifted ones are done with FloatCase - - | FloatCase - CpeBody -- Always ok-for-speculation - Id -- Case binder - AltCon [Var] -- Single alternative - Bool -- Ok-for-speculation; False of a strict, - -- but lifted binding - - -- | See Note [Floating Ticks in CorePrep] - | FloatTick CoreTickish + -- | Rhs of bindings are CpeRhss + -- They are always of lifted type; + -- unlifted ones are done with FloatCase + = FloatLet CoreBind + + -- | Float a literal string binding. + -- INVARIANT: The `CoreExpr` matches `Lit LitString{}`. + -- It's just more convenient to keep around the expr than the + -- wrapped `ByteString`. + -- This is a special case of `FloatCase` that is unconditionally ok-for-spec. + -- We want to float out strings quite aggressively because they don't + -- allocate. + -- See Note [ANF-ising literal string arguments]. + | FloatString !CoreExpr !Id + + | FloatCase + CpeBody -- ^ Always ok-for-speculation + Id -- ^ Case binder + AltCon [Var] -- ^ Single alternative + Bool -- ^ Ok-for-speculation; False of a strict, + -- but lifted binding + + -- | See Note [Floating Ticks in CorePrep] + | FloatTick CoreTickish data Floats = Floats OkToSpec (OrdList FloatingBind) instance Outputable FloatingBind where ppr (FloatLet b) = ppr b + ppr (FloatString e b) = text "string" <> braces (ppr b <> char '=' <> ppr e) ppr (FloatCase r b k bs ok) = text "case" <> braces (ppr ok) <+> ppr r <+> text "of"<+> ppr b <> text "@" <> case bs of @@ -1774,12 +1764,14 @@ data OkToSpec mkFloat :: CorePrepEnv -> Demand -> Bool -> Id -> CpeRhs -> FloatingBind mkFloat env dmd is_unlifted bndr rhs + | Lit LitString{} <- rhs = FloatString rhs bndr + | is_strict || ok_for_spec -- See Note [Speculative evaluation] - , not is_hnf = FloatCase rhs bndr DEFAULT [] ok_for_spec + , not is_hnf = FloatCase rhs bndr DEFAULT [] ok_for_spec -- Don't make a case for a HNF binding, even if it's strict -- Otherwise we get case (\x -> e) of ...! - | is_unlifted = FloatCase rhs bndr DEFAULT [] True + | is_unlifted = FloatCase rhs bndr DEFAULT [] True -- we used to assertPpr ok_for_spec (ppr rhs) here, but it is now disabled -- because exprOkForSpeculation isn't stable under ANF-ing. See for -- example #19489 where the following unlifted expression: @@ -1794,8 +1786,8 @@ mkFloat env dmd is_unlifted bndr rhs -- -- which isn't ok-for-spec because of the let-expression. - | is_hnf = FloatLet (NonRec bndr rhs) - | otherwise = FloatLet (NonRec (setIdDemandInfo bndr dmd) rhs) + | is_hnf = FloatLet (NonRec bndr rhs) + | otherwise = FloatLet (NonRec (setIdDemandInfo bndr dmd) rhs) -- See Note [Pin demand info on floats] where is_hnf = exprIsHNF rhs @@ -1814,6 +1806,7 @@ wrapBinds (Floats _ binds) body = foldrOL mk_bind body binds where mk_bind (FloatCase rhs bndr con bs _) body = Case rhs bndr (exprType body) [Alt con bs body] + mk_bind (FloatString rhs bndr) body = Case rhs bndr (exprType body) [Alt DEFAULT [] body] mk_bind (FloatLet bind) body = Let bind body mk_bind (FloatTick tickish) body = mkTick tickish body @@ -1821,12 +1814,12 @@ addFloat :: Floats -> FloatingBind -> Floats addFloat (Floats ok_to_spec floats) new_float = Floats (combine ok_to_spec (check new_float)) (floats `snocOL` new_float) where - check (FloatLet {}) = OkToSpec - check (FloatCase rhs _ _ _ ok_for_spec) - | Lit LitString{} <- rhs = OkToSpec - | ok_for_spec = IfUnliftedOk - | otherwise = NotOkToSpec - check FloatTick{} = OkToSpec + check FloatLet {} = OkToSpec + check FloatTick{} = OkToSpec + check FloatString{} = OkToSpec + check (FloatCase _ _ _ _ ok_for_spec) + | ok_for_spec = IfUnliftedOk + | otherwise = NotOkToSpec -- The ok-for-speculation flag says that it's safe to -- float this Case out of a let, and thereby do it more eagerly -- We need the IfUnliftedOk flag because it's never ok to float @@ -1834,6 +1827,9 @@ addFloat (Floats ok_to_spec floats) new_float -- There is one exception: String literals! Hence we keep OkToSpec -- See Note [ANF-ising literal string arguments] +mkFloats :: Foldable f => f FloatingBind -> Floats +mkFloats = foldr (flip addFloat) emptyFloats + unitFloat :: FloatingBind -> Floats unitFloat = addFloat emptyFloats @@ -1844,6 +1840,11 @@ appendFloats (Floats spec1 floats1) (Floats spec2 floats2) concatFloats :: [Floats] -> OrdList FloatingBind concatFloats = foldr (\ (Floats _ bs1) bs2 -> appOL bs1 bs2) nilOL +partitionOL :: (a -> Bool) -> OrdList a -> (OrdList a, OrdList a) +partitionOL p ol = (toOL l, toOL r) + where + (!l, !r) = partition p (fromOL ol) + combine :: OkToSpec -> OkToSpec -> OkToSpec combine NotOkToSpec _ = NotOkToSpec combine _ NotOkToSpec = NotOkToSpec @@ -1857,6 +1858,7 @@ deFloatTop (Floats _ floats) = foldrOL get [] floats where get (FloatLet b) bs = get_bind b : bs + get (FloatString body var) bs = get_bind (NonRec var body) : bs get (FloatCase body var _ _ _) bs = get_bind (NonRec var body) : bs get b _ = pprPanic "corePrepPgm" (ppr b) @@ -1882,7 +1884,7 @@ canFloat (Floats ok_to_spec fs) rhs go fbs_out (fb@(FloatLet _) : fbs_in) = go (fbs_out `snocOL` fb) fbs_in - go fbs_out (fb@(FloatCase (Lit LitString{}) _ _ _ _) : fbs_in) + go fbs_out (fb at FloatString{} : fbs_in) -- See Note [ANF-ising literal string arguments] = go (fbs_out `snocOL` fb) fbs_in @@ -1902,18 +1904,20 @@ wantFloatNested is_rec dmd rhs_is_unlifted floats rhs -- we don't want to float the case, even if f has arity 2, -- because floating the case would make it evaluated too early. where - worth_floating (Floats _ fs) rhs = exprIsHNF rhs || all is_lit_string fs + worth_floating (Floats _ fs) rhs = exprIsHNF rhs || all isFloatString fs -- Only float out of a RHS that becomes a NF in doing so. Otherwise we -- potentially make 2 thunks (e.g., `[let t = g x, let u = f t]`) where we -- had a single nested one before (e.g., `[let u = let t = g x in f t]`. -- We relax when it's a LitString that we float out, because that doesn't -- allocate. See Note [ANF-ising literal string arguments] - -- The LitString check is a bit crude, because wantFloatNested is + -- The FloatString check is a bit crude, because wantFloatNested is -- all-or-nothing. We might want to refactor to something more like -- FloatOut.partitionByLevel for selective floating, but compiler perf -- implications are unclear. - is_lit_string (FloatCase (Lit LitString{}) _ _ _ _) = True - is_lit_string _ = False + +isFloatString :: FloatingBind -> Bool +isFloatString FloatString{} = True +isFloatString _ = False allLazyTop :: Floats -> Bool allLazyTop (Floats OkToSpec _) = True @@ -2007,6 +2011,11 @@ data CorePrepConfig = CorePrepConfig , cp_convertNumLit :: !(LitNumType -> Integer -> Maybe CoreExpr) -- ^ Convert some numeric literals (Integer, Natural) into their final -- Core form. + + , cp_arityOpts :: !(Maybe ArityOpts) + -- ^ Configuration for arity analysis ('exprEtaExpandArity'). + -- See Note [Eta expansion of arguments in CorePrep] + -- When 'Nothing' (e.g., -O0, -O1), use the cheaper 'exprArity' instead } data CorePrepEnv @@ -2017,6 +2026,7 @@ data CorePrepEnv -- enabled we instead produce an 'error' expression to catch -- the case where a function we think should bottom -- unexpectedly returns. + , cpe_env :: IdEnv CoreExpr -- Clone local Ids -- ^ This environment is used for three operations: -- @@ -2030,8 +2040,6 @@ data CorePrepEnv -- see Note [lazyId magic], Note [Inlining in CorePrep] -- and Note [CorePrep inlines trivial CoreExpr not Id] (#12076) - , cpe_tyco_env :: Maybe CpeTyCoEnv -- See Note [CpeTyCoEnv] - , cpe_rec_ids :: UnVarSet -- Faster OutIdSet; See Note [Speculative evaluation] } @@ -2039,7 +2047,6 @@ mkInitialCorePrepEnv :: CorePrepConfig -> CorePrepEnv mkInitialCorePrepEnv cfg = CPE { cpe_config = cfg , cpe_env = emptyVarEnv - , cpe_tyco_env = Nothing , cpe_rec_ids = emptyUnVarSet } @@ -2066,117 +2073,6 @@ enterRecGroupRHSs :: CorePrepEnv -> [OutId] -> CorePrepEnv enterRecGroupRHSs env grp = env { cpe_rec_ids = extendUnVarSetList grp (cpe_rec_ids env) } ------------------------------------------------------------------------------- --- CpeTyCoEnv --- --------------------------------------------------------------------------- - -{- Note [CpeTyCoEnv] -~~~~~~~~~~~~~~~~~~~~ -The cpe_tyco_env :: Maybe CpeTyCoEnv field carries a substitution -for type and coercion variables - -* We need the coercion substitution to support the elimination of - unsafeEqualityProof (see Note [Unsafe coercions]) - -* We need the type substitution in case one of those unsafe - coercions occurs in the kind of tyvar binder (sigh) - -We don't need an in-scope set because we don't clone any of these -binders at all, so no new capture can take place. - -The cpe_tyco_env is almost always empty -- it only gets populated -when we get under an usafeEqualityProof. Hence the Maybe CpeTyCoEnv, -which makes everything into a no-op in the common case. --} - -data CpeTyCoEnv = TCE TvSubstEnv CvSubstEnv - -emptyTCE :: CpeTyCoEnv -emptyTCE = TCE emptyTvSubstEnv emptyCvSubstEnv - -extend_tce_cv :: CpeTyCoEnv -> CoVar -> Coercion -> CpeTyCoEnv -extend_tce_cv (TCE tv_env cv_env) cv co - = TCE tv_env (extendVarEnv cv_env cv co) - -extend_tce_tv :: CpeTyCoEnv -> TyVar -> Type -> CpeTyCoEnv -extend_tce_tv (TCE tv_env cv_env) tv ty - = TCE (extendVarEnv tv_env tv ty) cv_env - -lookup_tce_cv :: CpeTyCoEnv -> CoVar -> Coercion -lookup_tce_cv (TCE _ cv_env) cv - = case lookupVarEnv cv_env cv of - Just co -> co - Nothing -> mkCoVarCo cv - -lookup_tce_tv :: CpeTyCoEnv -> TyVar -> Type -lookup_tce_tv (TCE tv_env _) tv - = case lookupVarEnv tv_env tv of - Just ty -> ty - Nothing -> mkTyVarTy tv - -extendCoVarEnv :: CorePrepEnv -> CoVar -> Coercion -> CorePrepEnv -extendCoVarEnv cpe@(CPE { cpe_tyco_env = mb_tce }) cv co - = cpe { cpe_tyco_env = Just (extend_tce_cv tce cv co) } - where - tce = mb_tce `orElse` emptyTCE - - -cpSubstTy :: CorePrepEnv -> Type -> Type -cpSubstTy (CPE { cpe_tyco_env = mb_env }) ty - = case mb_env of - Just env -> runIdentity (subst_ty env ty) - Nothing -> ty - -cpSubstCo :: CorePrepEnv -> Coercion -> Coercion -cpSubstCo (CPE { cpe_tyco_env = mb_env }) co - = case mb_env of - Just tce -> runIdentity (subst_co tce co) - Nothing -> co - -subst_tyco_mapper :: TyCoMapper CpeTyCoEnv Identity -subst_tyco_mapper = TyCoMapper - { tcm_tyvar = \env tv -> return (lookup_tce_tv env tv) - , tcm_covar = \env cv -> return (lookup_tce_cv env cv) - , tcm_hole = \_ hole -> pprPanic "subst_co_mapper:hole" (ppr hole) - , tcm_tycobinder = \env tcv _vis -> if isTyVar tcv - then return (subst_tv_bndr env tcv) - else return (subst_cv_bndr env tcv) - , tcm_tycon = \tc -> return tc } - -subst_ty :: CpeTyCoEnv -> Type -> Identity Type -subst_co :: CpeTyCoEnv -> Coercion -> Identity Coercion -(subst_ty, _, subst_co, _) = mapTyCoX subst_tyco_mapper - -cpSubstTyVarBndr :: CorePrepEnv -> TyVar -> (CorePrepEnv, TyVar) -cpSubstTyVarBndr env@(CPE { cpe_tyco_env = mb_env }) tv - = case mb_env of - Nothing -> (env, tv) - Just tce -> (env { cpe_tyco_env = Just tce' }, tv') - where - (tce', tv') = subst_tv_bndr tce tv - -subst_tv_bndr :: CpeTyCoEnv -> TyVar -> (CpeTyCoEnv, TyVar) -subst_tv_bndr tce tv - = (extend_tce_tv tce tv (mkTyVarTy tv'), tv') - where - tv' = mkTyVar (tyVarName tv) kind' - kind' = runIdentity $ subst_ty tce $ tyVarKind tv - -cpSubstCoVarBndr :: CorePrepEnv -> CoVar -> (CorePrepEnv, CoVar) -cpSubstCoVarBndr env@(CPE { cpe_tyco_env = mb_env }) cv - = case mb_env of - Nothing -> (env, cv) - Just tce -> (env { cpe_tyco_env = Just tce' }, cv') - where - (tce', cv') = subst_cv_bndr tce cv - -subst_cv_bndr :: CpeTyCoEnv -> CoVar -> (CpeTyCoEnv, CoVar) -subst_cv_bndr tce cv - = (extend_tce_cv tce cv (mkCoVarCo cv'), cv') - where - cv' = mkCoVar (varName cv) ty' - ty' = runIdentity (subst_ty tce $ varType cv) - ------------------------------------------------------------------------------ -- Cloning binders -- --------------------------------------------------------------------------- @@ -2186,12 +2082,8 @@ cpCloneBndrs env bs = mapAccumLM cpCloneBndr env bs cpCloneBndr :: CorePrepEnv -> InVar -> UniqSM (CorePrepEnv, OutVar) cpCloneBndr env bndr - | isTyVar bndr - = return (cpSubstTyVarBndr env bndr) - - | isCoVar bndr - = return (cpSubstCoVarBndr env bndr) - + | isTyCoVar bndr + = return (env, bndr) | otherwise = do { bndr' <- clone_it bndr @@ -2211,8 +2103,7 @@ cpCloneBndr env bndr clone_it bndr | isLocalId bndr = do { uniq <- getUniqueM - ; let ty' = cpSubstTy env (idType bndr) - ; return (setVarUnique (setIdType bndr ty') uniq) } + ; return (setVarUnique bndr uniq) } | otherwise -- Top level things, which we don't want -- to clone, have become GlobalIds by now ===================================== compiler/GHC/Driver/Config/CoreToStg/Prep.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint +import GHC.Driver.Config.Core.Opt.Arity import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Utils.Outputable ( alwaysQualify ) @@ -17,14 +18,18 @@ import GHC.CoreToStg.Prep initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig hsc_env = do + let dflags = hsc_dflags hsc_env convertNumLit <- do - let platform = targetPlatform $ hsc_dflags hsc_env + let platform = targetPlatform dflags home_unit = hsc_home_unit hsc_env lookup_global = lookupGlobal hsc_env mkConvertNumLiteral platform home_unit lookup_global return $ CorePrepConfig - { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env + { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases dflags , cp_convertNumLit = convertNumLit + , cp_arityOpts = if gopt Opt_DoCleverArgEtaExpansion dflags + then Just (initArityOpts dflags) + else Nothing } initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -262,6 +262,7 @@ data GeneralFlag | Opt_SpecConstr | Opt_SpecConstrKeen | Opt_DoLambdaEtaExpansion + | Opt_DoCleverArgEtaExpansion -- More sophisticated eta expansion of arguments in CorePrep | Opt_IgnoreAsserts | Opt_DoEtaReduction | Opt_CaseMerge ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3467,6 +3467,7 @@ fFlagsDeps = [ Opt_DmdTxDictSel "effect is now unconditionally enabled", flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, + flagSpec "do-clever-arg-eta-expansion" Opt_DoCleverArgEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, @@ -4059,6 +4060,7 @@ optLevelFlags :: [([Int], GeneralFlag)] -- Default settings of flags, before any command-line overrides optLevelFlags -- see Note [Documenting optimisation flags] = [ ([0,1,2], Opt_DoLambdaEtaExpansion) + , ([1,2], Opt_DoCleverArgEtaExpansion) , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] , ([0,1,2], Opt_LlvmTBAA) , ([0,1,2], Opt_ProfManualCcs ) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -1748,7 +1748,6 @@ freeNamesIfProv :: IfaceUnivCoProv -> NameSet freeNamesIfProv (IfacePhantomProv co) = freeNamesIfCoercion co freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co freeNamesIfProv (IfacePluginProv _) = emptyNameSet -freeNamesIfProv (IfaceCorePrepProv _) = emptyNameSet freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet freeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -402,7 +402,6 @@ data IfaceUnivCoProv = IfacePhantomProv IfaceCoercion | IfaceProofIrrelProv IfaceCoercion | IfacePluginProv String - | IfaceCorePrepProv Bool -- See defn of CorePrepProv {- Note [Holes in IfaceCoercion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -624,7 +623,6 @@ substIfaceType env ty go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co) go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co) go_prov co@(IfacePluginProv _) = co - go_prov co@(IfaceCorePrepProv _) = co substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs substIfaceAppArgs env args @@ -1860,8 +1858,6 @@ pprIfaceUnivCoProv (IfaceProofIrrelProv co) = text "irrel" <+> pprParendIfaceCoercion co pprIfaceUnivCoProv (IfacePluginProv s) = text "plugin" <+> doubleQuotes (text s) -pprIfaceUnivCoProv (IfaceCorePrepProv _) - = text "CorePrep" ------------------- instance Outputable IfaceTyCon where @@ -2229,9 +2225,6 @@ instance Binary IfaceUnivCoProv where put_ bh (IfacePluginProv a) = do putByte bh 3 put_ bh a - put_ bh (IfaceCorePrepProv a) = do - putByte bh 4 - put_ bh a get bh = do tag <- getByte bh @@ -2242,8 +2235,6 @@ instance Binary IfaceUnivCoProv where return $ IfaceProofIrrelProv a 3 -> do a <- get bh return $ IfacePluginProv a - 4 -> do a <- get bh - return (IfaceCorePrepProv a) _ -> panic ("get IfaceUnivCoProv " ++ show tag) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1520,7 +1520,6 @@ tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance tcIfaceUnivCoProv (IfacePhantomProv kco) = PhantomProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv str -tcIfaceUnivCoProv (IfaceCorePrepProv b) = return $ CorePrepProv b {- ************************************************************************ ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -53,7 +53,6 @@ import GHC.Utils.Misc import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import Control.Monad ( unless, void ) import Control.Arrow ( first ) @@ -1028,7 +1027,7 @@ cgIdApp fun_id args = do (text "TagCheck failed on entry in" <+> ppr mod <+> text "- value:" <> ppr fun_id <+> pdoc platform fun)) fun - EnterIt -> assert (null args) $ -- Discarding arguments + EnterIt -> assertPpr (null args) (ppr fun_id $$ ppr args) $ -- Discarding arguments emitEnter fun SlowCall -> do -- A slow function call via the RTS apply routines ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -156,7 +156,6 @@ synonymTyConsOfType ty go_prov (PhantomProv co) = go_co co go_prov (ProofIrrelProv co) = go_co co go_prov (PluginProv _) = emptyNameEnv - go_prov (CorePrepProv _) = emptyNameEnv go_tc tc | isTypeSynonymTyCon tc = unitNameEnv (tyConName tc) tc | otherwise = emptyNameEnv ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1578,7 +1578,6 @@ collect_cand_qtvs_co orig_ty cur_lvl bound = go_co go_prov dv (PhantomProv co) = go_co dv co go_prov dv (ProofIrrelProv co) = go_co dv co go_prov dv (PluginProv _) = return dv - go_prov dv (CorePrepProv _) = return dv go_cv :: CandidatesQTvs -> CoVar -> TcM CandidatesQTvs go_cv dv@(DV { dv_cvs = cvs }) cv ===================================== compiler/GHC/Utils/Trace.hs ===================================== @@ -8,6 +8,7 @@ module GHC.Utils.Trace , pprSTrace , pprTraceException , warnPprTrace + , warnPprTraceM , pprTraceUserWarning , trace ) @@ -84,6 +85,9 @@ warnPprTrace True s msg x (text s $$ msg $$ withFrozenCallStack traceCallStackDoc ) x +warnPprTraceM :: (Applicative f, HasCallStack) => Bool -> String -> SDoc -> f () +warnPprTraceM b s doc = withFrozenCallStack warnPprTrace b s doc (pure ()) + -- | For when we want to show the user a non-fatal WARNING so that they can -- report a GHC bug, but don't want to panic. pprTraceUserWarning :: HasCallStack => SDoc -> a -> a ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -467,6 +467,17 @@ by saying ``-fno-wombat``. Eta-expand let-bindings to increase their arity. +.. ghc-flag:: -fdo-clever-arg-eta-expansion + :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O2`. + :type: dynamic + :reverse: -fno-do-clever-arg-eta-expansion + :category: + + :default: off + + Eta-expand arguments to increase their arity to avoid allocating unnecessary + thunks for them. + .. ghc-flag:: -feager-blackholing :shortdesc: Turn on :ref:`eager blackholing ` :type: dynamic ===================================== libraries/base/Unsafe/Coerce.hs ===================================== @@ -88,13 +88,13 @@ several ways (U1) unsafeEqualityProof is /never/ inlined. -(U2) In CoreToStg.Prep, we transform +(U2) In CoreToStg, we transform case unsafeEqualityProof of UnsafeRefl g -> blah ==> - blah[unsafe-co/g] + blah - This eliminates the overhead of evaluating the unsafe - equality proof. + This eliminates the overhead of evaluating the unsafe equality proof. + (It follows that the Case is trivial iff `blah` is.) Any /other/ occurrence of unsafeEqualityProof is left alone. For example you could write @@ -131,9 +131,11 @@ several ways Floating the case is OK here, even though it broadens the scope, because we are done with simplification. -(U4) Ditto GHC.Core.Unfold.inlineBoringOk we want to treat - the RHS of unsafeCoerce as very small; see - Note [Inline unsafeCoerce] in that module. +(U4) We regard `case unsafeEqualityProof of UnsafeRefl -> rhs` as trivial iff + `rhs` is. One reason is that we want to treat the RHS of unsafeCoerce as + very small; see Note [Inline unsafeCoerce] in GHC.Core.Unfold. + Another is that we do not want to allocate a thunk in CorePrep when we + wouldn't do so for `rhs`, because we discard the case in CoreToStg anyway. (U5) The definition of unsafeEqualityProof in Unsafe.Coerce looks very strange: ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,10 @@ +module T23083 where + +-- Just ($), but NOINLINE so that we don't inline it eagerly, subverting the +-- test case +($$) :: (a -> b) -> a -> b +($$) f x = f x +{-# NOINLINE ($$) #-} + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $$)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,47 @@ + +==================== CorePrep ==================== +Result size of CorePrep = {terms: 34, types: 34, coercions: 0, joins: 0/1} + +-- RHS size: {terms: 6, types: 5, coercions: 0, joins: 0/0} +(T23083.$$) [InlPrag=NOINLINE] :: forall a b. (a -> b) -> a -> b +[GblId, Arity=2, Str=<1C(1,L)>, Unf=OtherCon []] +(T23083.$$) = \ (@a) (@b) (f [Occ=Once1!] :: a -> b) (x [Occ=Once1] :: a) -> f x + +-- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/1} +T23083.g :: ((GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) -> (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=OtherCon []] +T23083.g + = \ (f [Occ=Once1!] :: (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) (h [Occ=OnceL1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> + let { + sat [Occ=Once1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer + [LclId] + sat = \ (eta [Occ=Once1] :: GHC.Num.Integer.Integer) -> case h of h1 [Occ=Once1] { __DEFAULT -> T23083.$$ @GHC.Num.Integer.Integer @GHC.Num.Integer.Integer h1 eta } } in + f sat + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=OtherCon []] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=OtherCon []] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=OtherCon []] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23083', [ grep_errmsg(r'eta.+::.+Integer') ], compile, ['-O -ddump-prep -dsuppress-uniques -dppr-cols=99999']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bbd970a15e892833b551ce95a74fa7e803b3a0c...fd286b5029a42ddb70bb4ae21d000fd03889fd49 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bbd970a15e892833b551ce95a74fa7e803b3a0c...fd286b5029a42ddb70bb4ae21d000fd03889fd49 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 21:36:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 02 May 2023 17:36:48 -0400 Subject: [Git][ghc/ghc][wip/T19146] 2 commits: rts: Don't sanity-check StgTSO.global_link Message-ID: <64518270c9dcc_3c911551f681525d9@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: 7b175e36 by Ben Gamari at 2023-05-02T17:36:43-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - e7c285ce by Ben Gamari at 2023-05-02T17:36:43-04:00 rts: Introduce printGlobalThreads - - - - - 4 changed files: - rts/Threads.c - rts/Threads.h - rts/include/MachDeps.h - rts/sm/Sanity.c Changes: ===================================== rts/Threads.c ===================================== @@ -1008,6 +1008,20 @@ printAllThreads(void) } } +void +printGlobalThreads(void) +{ + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + debugBelch("\ngen %d\n", g); + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu)\n", t, t->id); + } + for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + } + } +} + // useful from gdb void printThreadQueue(StgTSO *t) ===================================== rts/Threads.h ===================================== @@ -46,6 +46,7 @@ bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value); void printThreadBlockage (StgTSO *tso); void printThreadStatus (StgTSO *t); void printAllThreads (void); +void printGlobalThreads(void); void printThreadQueue (StgTSO *t); #endif ===================================== rts/include/MachDeps.h ===================================== @@ -107,9 +107,11 @@ #endif #endif -// This is the bit-pattern used by the RTS to clear freed memory -// when +RTS -DZ is in use. The LOOKS_LIKE_*_PTR utilities use this -// macro to catch clearly invalid pointers +/* + * INVALID_GHC_POINTER is the bit-pattern used by the RTS to clear freed memory + * when +RTS -DZ is in use. The LOOKS_LIKE_*_PTR utilities use this macro to + * catch clearly invalid pointers + */ #if !defined(INVALID_GHC_POINTER) #if SIZEOF_HSWORD == 4 #define INVALID_GHC_POINTER 0xaaaaaaaa ===================================== rts/sm/Sanity.c ===================================== @@ -737,6 +737,27 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* + * Note [Avoid dangling global_link pointers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * TSOs are a bit odd in that they have a global_link pointer field + * which is not scavenged by the GC. This field is used to track the + * generations[_].[old_]threads lists and is ultimately updated by + * MarkWeak.c:tidyThreadList. + + * Typically the fact that this field is not scavenged is fine as all reachable + * TSOs on the heap are guaranteed to be on some generation's thread list and + * therefore will be scavenged by tidyThreadList. However, the sanity checker + * poses a bit of a challenge here as it walks heap blocks directly and + * therefore may encounter TSOs which aren't reachable via the heap. + * For this reason, checkTSO does not check global_link. Instead, we only do + * so in checkGlobalTSOList, which by definition will only look at + * threads which are reachable via a thread list (and therefore must have won + * the forwarding-pointer race). + * + * See #19146. + */ + void checkTSO(StgTSO *tso) { @@ -761,9 +782,11 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && - (tso->global_link == END_TSO_QUEUE || - get_itbl((StgClosure*)tso->global_link)->type == TSO)); + + // This assertion is sadly not viable. See Note [Sanity-checking global_link]. + //ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && + // (tso->global_link == END_TSO_QUEUE || + // get_itbl((StgClosure*)tso->global_link)->type == TSO)); if (tso->label) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->label)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/280bace467a531d00be6e5d448c528b09b0dbc5a...e7c285ce394d4e856045a72c597d8754afab9ba0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/280bace467a531d00be6e5d448c528b09b0dbc5a...e7c285ce394d4e856045a72c597d8754afab9ba0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 2 21:37:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 02 May 2023 17:37:40 -0400 Subject: [Git][ghc/ghc][wip/T19146] 3 commits: rts: Assert that pointers aren't cleared Message-ID: <645182a4cee11_3c911551e14152921@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: 5347837a by Ben Gamari at 2023-05-02T17:37:33-04:00 rts: Assert that pointers aren't cleared This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 3dbd45e3 by Ben Gamari at 2023-05-02T17:37:33-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - 4a117ab9 by Ben Gamari at 2023-05-02T17:37:33-04:00 rts: Introduce printGlobalThreads - - - - - 6 changed files: - rts/Threads.c - rts/Threads.h - rts/include/Cmm.h - rts/include/MachDeps.h - rts/include/rts/storage/ClosureMacros.h - rts/sm/Sanity.c Changes: ===================================== rts/Threads.c ===================================== @@ -1008,6 +1008,20 @@ printAllThreads(void) } } +void +printGlobalThreads(void) +{ + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + debugBelch("\ngen %d\n", g); + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu)\n", t, t->id); + } + for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + } + } +} + // useful from gdb void printThreadQueue(StgTSO *t) ===================================== rts/Threads.h ===================================== @@ -46,6 +46,7 @@ bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value); void printThreadBlockage (StgTSO *tso); void printThreadStatus (StgTSO *t); void printAllThreads (void); +void printGlobalThreads(void); void printThreadQueue (StgTSO *t); #endif ===================================== rts/include/Cmm.h ===================================== @@ -605,16 +605,20 @@ #define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK) #define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT) +#define LOOKS_LIKE_PTR(p) ((p) != NULL && (p) != INVALID_GHC_POINTER) + /* Debugging macros */ #define LOOKS_LIKE_INFO_PTR(p) \ - ((p) != NULL && \ + (LOOKS_LIKE_PTR(p) && \ LOOKS_LIKE_INFO_PTR_NOT_NULL(p)) #define LOOKS_LIKE_INFO_PTR_NOT_NULL(p) \ ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \ (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES)) -#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) +#define LOOKS_LIKE_CLOSURE_PTR(p) \ + ( LOOKS_LIKE_PTR(p) && \ + LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) /* * The layout of the StgFunInfoExtra part of an info table changes ===================================== rts/include/MachDeps.h ===================================== @@ -107,6 +107,19 @@ #endif #endif +/* + * INVALID_GHC_POINTER is the bit-pattern used by the RTS to clear freed memory + * when +RTS -DZ is in use. The LOOKS_LIKE_*_PTR utilities use this macro to + * catch clearly invalid pointers + */ +#if !defined(INVALID_GHC_POINTER) +#if SIZEOF_HSWORD == 4 +#define INVALID_GHC_POINTER 0xaaaaaaaa +#else +#define INVALID_GHC_POINTER 0xaaaaaaaaaaaaaaaa +#endif +#endif + #if !defined(TAG_BITS) #if SIZEOF_HSWORD == 4 #define TAG_BITS 2 ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -270,6 +270,12 @@ EXTERN_INLINE StgClosure *TAG_CLOSURE(StgWord tag,StgClosure * p) make sense... -------------------------------------------------------------------------- */ +EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p); +EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p) +{ + return p && (p != (const void*) INVALID_GHC_POINTER); +} + EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) { @@ -280,12 +286,13 @@ EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p) { - return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); + return LOOKS_LIKE_PTR((const void*) p) && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); } EXTERN_INLINE bool LOOKS_LIKE_CLOSURE_PTR (const void *p); EXTERN_INLINE bool LOOKS_LIKE_CLOSURE_PTR (const void *p) { + if (!LOOKS_LIKE_PTR(p)) return false; const StgInfoTable *info = RELAXED_LOAD(&UNTAG_CONST_CLOSURE((const StgClosure *) (p))->header.info); return LOOKS_LIKE_INFO_PTR((StgWord) info); } ===================================== rts/sm/Sanity.c ===================================== @@ -737,6 +737,27 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* + * Note [Avoid dangling global_link pointers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * TSOs are a bit odd in that they have a global_link pointer field + * which is not scavenged by the GC. This field is used to track the + * generations[_].[old_]threads lists and is ultimately updated by + * MarkWeak.c:tidyThreadList. + + * Typically the fact that this field is not scavenged is fine as all reachable + * TSOs on the heap are guaranteed to be on some generation's thread list and + * therefore will be scavenged by tidyThreadList. However, the sanity checker + * poses a bit of a challenge here as it walks heap blocks directly and + * therefore may encounter TSOs which aren't reachable via the heap. + * For this reason, checkTSO does not check global_link. Instead, we only do + * so in checkGlobalTSOList, which by definition will only look at + * threads which are reachable via a thread list (and therefore must have won + * the forwarding-pointer race). + * + * See #19146. + */ + void checkTSO(StgTSO *tso) { @@ -761,9 +782,11 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && - (tso->global_link == END_TSO_QUEUE || - get_itbl((StgClosure*)tso->global_link)->type == TSO)); + + // This assertion is sadly not viable. See Note [Sanity-checking global_link]. + //ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && + // (tso->global_link == END_TSO_QUEUE || + // get_itbl((StgClosure*)tso->global_link)->type == TSO)); if (tso->label) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->label)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e7c285ce394d4e856045a72c597d8754afab9ba0...4a117ab986e128d4f409c6be94a0d7f1c6d8912b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e7c285ce394d4e856045a72c597d8754afab9ba0...4a117ab986e128d4f409c6be94a0d7f1c6d8912b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 00:30:46 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Tue, 02 May 2023 20:30:46 -0400 Subject: [Git][ghc/ghc][wip/T23329] Fix type variable substitution in gen_Newtype_fam_insts Message-ID: <6451ab361745c_3c911597950168920@gitlab.mail> Ryan Scott pushed to branch wip/T23329 at Glasgow Haskell Compiler / GHC Commits: 134d4e65 by Ryan Scott at 2023-05-02T20:23:14-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 5 changed files: - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/TyCl/Class.hs - + testsuite/tests/deriving/should_compile/T23329.hs - + testsuite/tests/deriving/should_compile/T23329_M.hs - testsuite/tests/deriving/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -46,6 +46,7 @@ import GHC.Prelude import GHC.Hs +import GHC.Tc.TyCl.Class ( substATBndrs ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Instantiate( newFamInst ) import GHC.Tc.Utils.Env @@ -2100,8 +2101,8 @@ gen_Newtype_fam_insts loc' cls inst_tvs inst_tys rhs_ty newFamInst SynFamilyInst axiom where fam_tvs = tyConTyVars fam_tc - rep_lhs_tys = substTyVars lhs_subst fam_tvs - rep_rhs_tys = substTyVars rhs_subst fam_tvs + (_, rep_lhs_tys) = substATBndrs lhs_subst fam_tvs + (_, rep_rhs_tys) = substATBndrs rhs_subst fam_tvs rep_rhs_ty = mkTyConApp fam_tc rep_rhs_tys rep_tcvs = tyCoVarsOfTypesList rep_lhs_tys (rep_tvs, rep_cvs) = partition isTyVar rep_tcvs ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -22,6 +22,7 @@ module GHC.Tc.TyCl.Class , instDeclCtxt2 , instDeclCtxt3 , tcATDefault + , substATBndrs ) where @@ -58,7 +59,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.Var -import GHC.Types.Var.Env +import GHC.Types.Var.Env ( lookupVarEnv ) import GHC.Types.SourceFile (HscSource(..)) import GHC.Types.SrcLoc import GHC.Types.Basic @@ -501,8 +502,7 @@ tcATDefault loc inst_subst defined_ats (ATI fam_tc defs) -- instance C [x] -- Then we want to generate the decl: type F [x] b = () | Just (rhs_ty, _loc) <- defs - = do { let (subst', pat_tys') = mapAccumL subst_tv inst_subst - (tyConTyVars fam_tc) + = do { let (subst', pat_tys') = substATBndrs inst_subst (tyConTyVars fam_tc) rhs' = substTyUnchecked subst' rhs_ty tcv' = tyCoVarsOfTypesList pat_tys' (tv', cv') = partition isTyVar tcv' @@ -525,14 +525,73 @@ tcATDefault loc inst_subst defined_ats (ATI fam_tc defs) | otherwise -- defs = Nothing = do { warnMissingAT (tyConName fam_tc) ; return [] } + +-- | Apply a substitution to the type variable binders of an associated type +-- family. This is used to compute default instances for associated type +-- families (see 'tcATDefault') as well as @newtype at -derived associated type +-- family instances (see @gen_Newtype_fam_insts@ in "GHC.Tc.Deriv.Generate"). +-- +-- As a concrete example, consider the following class and associated type +-- family: +-- +-- @ +-- class C k (a :: k) where +-- type F k a (b :: k) :: Type +-- type F j p q = (Proxy @j p, Proxy @j (q :: j)) +-- @ +-- +-- If a user defines this instance: +-- +-- @ +-- instance C (Type -> Type) Maybe where {} +-- @ +-- +-- Then in order to typecheck the default @F@ instance, we must apply the +-- substitution @[k :-> (Type -> Type), a :-> Maybe]@ to @F@'s binders, which +-- are @[k, a, (b :: k)]@. The result should look like this: +-- +-- @ +-- type F (Type -> Type) Maybe (b :: Type -> Type) = +-- (Proxy @(Type -> Type) Maybe, Proxy @(Type -> Type) (b :: Type -> Type)) +-- @ +-- +-- Making this work requires some care. There are two cases: +-- +-- 1. If we encounter a type variable in the domain of the substitution (e.g., +-- @k@ or @a@), then we apply the substitution directly. +-- +-- 2. Otherwise, we substitute into the type variable's kind (e.g., turn +-- @b :: k@ to @b :: Type -> Type@). We then return an extended substitution +-- where the old @b@ (of kind @k@) maps to the new @b@ (of kind @Type -> Type@). +-- +-- This step is important to do in case there are later occurrences of @b@, +-- which we must ensure have the correct kind. Otherwise, we might end up +-- with @Proxy \@(Type -> Type) (b :: k)@ on the right-hand side of the +-- default instance, which would be completely wrong. +-- +-- Contrast 'substATBndrs' function with similar substitution functions: +-- +-- * 'substTyVars' does not substitute into the kinds of each type variable, +-- nor does it extend the substitution. 'substTyVars' is meant for occurrences +-- of type variables, whereas 'substATBndr's is meant for binders. +-- +-- * 'substTyVarBndrs' does substitute into kinds and extends the substitution, +-- but it does not apply the substitution to the variables themselves. As +-- such, 'substTyVarBndrs' returns a list of 'TyVar's rather than a list of +-- 'Type's. +substATBndrs :: Subst -> [TyVar] -> (Subst, [Type]) +substATBndrs = mapAccumL substATBndr where - subst_tv subst tc_tv + substATBndr :: Subst -> TyVar -> (Subst, Type) + substATBndr subst tc_tv + -- Case (1) in the Haddocks | Just ty <- lookupVarEnv (getTvSubstEnv subst) tc_tv = (subst, ty) + -- Case (2) in the Haddocks | otherwise = (extendTvSubst subst tc_tv ty', ty') where - ty' = mkTyVarTy (updateTyVarKind (substTyUnchecked subst) tc_tv) + ty' = mkTyVarTy (updateTyVarKind (substTy subst) tc_tv) warnMissingAT :: Name -> TcM () warnMissingAT name ===================================== testsuite/tests/deriving/should_compile/T23329.hs ===================================== @@ -0,0 +1,9 @@ +module T23329 where + +import Data.Kind (Type) +import Data.Proxy (Proxy(Proxy)) + +import T23329_M + +foo :: () +foo = myMethod @Type @MyMaybe @() () Proxy Proxy ===================================== testsuite/tests/deriving/should_compile/T23329_M.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T23329_M where + +import Data.Kind (Type) +import Data.Proxy (Proxy) + +class MyClass (f :: k -> Type) where + type MyTypeFamily f (i :: k) :: Type + myMethod :: MyTypeFamily f i -> Proxy f -> Proxy i -> () + +instance MyClass Maybe where + type MyTypeFamily Maybe i = () + myMethod = undefined + +newtype MyMaybe a = MyMaybe (Maybe a) + deriving MyClass ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -141,3 +141,4 @@ test('T20994', normal, compile, ['']) test('T22167', normal, compile, ['']) test('T22696a', normal, compile, ['']) test('T22696c', normal, compile, ['']) +test('T23329', normal, multimod_compile, ['T23329', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/134d4e6583a3c6b0659eeeddd1ab969d47eab42c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/134d4e6583a3c6b0659eeeddd1ab969d47eab42c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 06:06:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 May 2023 02:06:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add structured error messages for GHC.Rename.Names Message-ID: <6451f9c8e0cfa_3c911515e88c9819878b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0459e0c3 by Ben Orchard at 2023-05-03T02:05:30-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - 49f2332b by Bodigrim at 2023-05-03T02:05:34-04:00 Document instances of Double - - - - - 5e9ce68d by Sylvain Henry at 2023-05-03T02:05:45-04:00 Bump Cabal submodule (#22356) - - - - - 30dc982c by sheaf at 2023-05-03T02:05:50-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - f64c919d by amesgen at 2023-05-03T02:05:55-04:00 Fix unlit path in cross bindists - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - docs/users_guide/9.8.1-notes.rst - + docs/users_guide/exts/extended_literals.rst - docs/users_guide/exts/literals.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/stolen_syntax.rst - hadrian/bindist/Makefile - libraries/Cabal - libraries/base/GHC/Float.hs - libraries/base/GHC/Real.hs - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/deriving/should_compile/T17324.stderr - testsuite/tests/driver/T4437.hs - testsuite/tests/driver/t22391/t22391.stderr - testsuite/tests/driver/t22391/t22391j.stderr - + testsuite/tests/extendedliterals/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef4c44f038657ae3a51e859a5e571386a5be34d5...f64c919de724052ad7943615e7aeabe9eda3b9f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef4c44f038657ae3a51e859a5e571386a5be34d5...f64c919de724052ad7943615e7aeabe9eda3b9f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 08:33:17 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 03 May 2023 04:33:17 -0400 Subject: [Git][ghc/ghc][wip/t22884] Suggestions Message-ID: <64521c4da0419_3c911519fceb582215c5@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: f936f148 by sheaf at 2023-05-03T08:33:15+00:00 Suggestions - - - - - 2 changed files: - compiler/GHC/Iface/Errors/Ppr.hs - ghc/GHCi/UI/Exception.hs Changes: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -135,20 +135,20 @@ cantFindError :: IfaceMessageOpts -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindError opts = cantFindErrorX (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts)) (mayShowLocations "-v" (ifaceShowTriedFiles opts)) - where +cantFindError opts = + cantFindErrorX + (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts)) + (mayShowLocations "-v" (ifaceShowTriedFiles opts)) -pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage - -> Maybe UnitInfo -> SDoc -pkgHiddenHint hint using_cabal (Just pkg) - | using_cabal == YesBuildingCabalPackage - = text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - | otherwise - = hint pkg -pkgHiddenHint _ _ Nothing = empty +pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage + -> UnitInfo -> SDoc +pkgHiddenHint _hint YesBuildingCabalPackage pkg + = text "Perhaps you need to add" <+> + quotes (ppr (unitPackageName pkg)) <+> + text "to the build-depends in your .cabal file." +pkgHiddenHint hint _not_cabal pkg + = hint pkg mayShowLocations :: String -> Bool -> [FilePath] -> SDoc mayShowLocations option verbose files @@ -161,8 +161,8 @@ mayShowLocations option verbose files -- | General version of cantFindError which has some holes which allow GHC/GHCi to display slightly different -- error messages. -cantFindErrorX :: (Maybe UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstalled mod_name cfir) = +cantFindErrorX :: (UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc +cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInstalled mod_name cfir) = let ambig = isAmbiguousInstalledReason cfir find_or_load = isLoadOrFindReason cfir ppr_what = prettyCantFindWhat find_or_load mod_or_interface ambig @@ -194,7 +194,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal MissingPackageWayFiles build pkg files -> text "Perhaps you haven't installed the " <> text build <+> text "libraries for package " <> quotes (ppr pkg) <> char '?' $$ - mayShowLocations files + may_show_locations files ModuleSuggestion ms fps -> let pp_suggestions :: [ModuleSuggestion] -> SDoc @@ -236,7 +236,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> ppr (mkUnit pkg)) | otherwise = empty - in pp_suggestions ms $$ mayShowLocations fps + in pp_suggestions ms $$ may_show_locations fps NotAModule -> text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> vcat (map text fps) MultiplePackages mods @@ -254,7 +254,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal vcat (map pkg_hidden pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ vcat (map unusable unusables) $$ - mayShowLocations files + may_show_locations files where pprMod (m, o) = text "it is bound as" <+> ppr m <+> text "by" <+> pprOrigin m o @@ -274,7 +274,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> quotes (ppr uid) --FIXME: we don't really want to show the unit id here we should -- show the source package id or installed package id if it's ambiguous - <> dot $$ pkg_hidden_hint uif + <> dot $$ maybe empty pkg_hidden_hint uif mod_hidden pkg = ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -4,21 +4,29 @@ module GHCi.UI.Exception(printGhciException) where import GHC.Prelude -import GHC.Utils.Logger -import Control.Monad.IO.Class -import GHC.Driver.Session -import GHC.Types.SourceError + +import GHC.Driver.Config.Diagnostic +import GHC.Driver.Errors import GHC.Driver.Errors.Types -import GHC.Types.Error +import GHC.Driver.Session + +import GHC.Iface.Errors.Ppr import GHC.Iface.Errors.Types -import GHC.Tc.Errors.Types + import GHC.Tc.Errors.Ppr -import GHC.Iface.Errors.Ppr -import GHC.Driver.Config.Diagnostic -import GHC.Driver.Errors -import GHC.Utils.Outputable +import GHC.Tc.Errors.Types + +import GHC.Types.Error +import GHC.Types.SourceError + import GHC.Unit.State +import GHC.Utils.Logger +import GHC.Utils.Outputable + +import Control.Monad.IO.Class + + -- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting -- for some error messages. printGhciException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f936f1486533581027073040256693477766703b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f936f1486533581027073040256693477766703b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 08:42:01 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 03 May 2023 04:42:01 -0400 Subject: [Git][ghc/ghc][wip/t22884] 43 commits: JS: fix thread-related primops Message-ID: <64521e591b64b_3c911519fcfaa8222081@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 704d0cf5 by Matthew Pickering at 2023-05-03T09:35:28+01:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 829ef895 by Matthew Pickering at 2023-05-03T09:35:28+01:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - b7305383 by Matthew Pickering at 2023-05-03T09:40:32+01:00 error messages: Don't display ghci specific hints for missing packages I am unsure about whether the approach taken here is the best of most maintainable solution. I put it up here for review and comment. Fixes #22884 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f936f1486533581027073040256693477766703b...b730538390c7bec8d286b965394fd3b69d4dc606 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f936f1486533581027073040256693477766703b...b730538390c7bec8d286b965394fd3b69d4dc606 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 08:48:20 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 03 May 2023 04:48:20 -0400 Subject: [Git][ghc/ghc][wip/t22884] error messages: Don't display ghci specific hints for missing packages Message-ID: <64521fd428e3f_3c911519f6773c2225cb@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: 5ca31f41 by Matthew Pickering at 2023-05-03T09:46:57+01:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 23 changed files: - compiler/GHC/Iface/Errors/Ppr.hs - ghc/GHCi/UI/Exception.hs - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - + testsuite/tests/package/T22884.hs - + testsuite/tests/package/T22884.stderr - + testsuite/tests/package/T22884_interactive.script - + testsuite/tests/package/T22884_interactive.stderr - testsuite/tests/package/T4806.stderr - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/all.T - testsuite/tests/package/package01e.stderr - testsuite/tests/package/package06e.stderr - testsuite/tests/package/package07e.stderr - testsuite/tests/package/package08e.stderr - testsuite/tests/perf/compiler/parsing001.stderr - testsuite/tests/plugins/T11244.stderr - testsuite/tests/plugins/plugins03.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr - testsuite/tests/typecheck/should_fail/tcfail082.stderr Changes: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -19,6 +19,11 @@ module GHC.Iface.Errors.Ppr , missingInterfaceErrorReason , missingInterfaceErrorDiagnostic , readInterfaceErrorDiagnostic + + , lookingForHerald + , cantFindErrorX + , mayShowLocations + , pkgHiddenHint ) where @@ -130,34 +135,34 @@ cantFindError :: IfaceMessageOpts -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindError opts = cantFindErrorX (pkg_hidden_hint (ifaceBuildingCabalPackage opts)) (mayShowLocations (ifaceShowTriedFiles opts)) - where - pkg_hidden_hint using_cabal (Just pkg) - | using_cabal == YesBuildingCabalPackage - = text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - -- MP: This is ghci specific, remove - | otherwise - = text "You can run" <+> - quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> - text "to expose it." $$ - text "(Note: this unloads all the modules in the current scope.)" - pkg_hidden_hint _ Nothing = empty - -mayShowLocations :: Bool -> [FilePath] -> SDoc -mayShowLocations verbose files +cantFindError opts = + cantFindErrorX + (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts)) + (mayShowLocations "-v" (ifaceShowTriedFiles opts)) + + +pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage + -> UnitInfo -> SDoc +pkgHiddenHint _hint YesBuildingCabalPackage pkg + = text "Perhaps you need to add" <+> + quotes (ppr (unitPackageName pkg)) <+> + text "to the build-depends in your .cabal file." +pkgHiddenHint hint _not_cabal pkg + = hint pkg + +mayShowLocations :: String -> Bool -> [FilePath] -> SDoc +mayShowLocations option verbose files | null files = empty | not verbose = - text "Use -v (or `:set -v` in ghci) " <> + text "Use" <+> text option <+> text "to see a list of the files searched for." | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) -- | General version of cantFindError which has some holes which allow GHC/GHCi to display slightly different -- error messages. -cantFindErrorX :: (Maybe UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstalled mod_name cfir) = +cantFindErrorX :: (UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc +cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInstalled mod_name cfir) = let ambig = isAmbiguousInstalledReason cfir find_or_load = isLoadOrFindReason cfir ppr_what = prettyCantFindWhat find_or_load mod_or_interface ambig @@ -185,11 +190,11 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal text "There are files missing in the " <> quotes (ppr pkg) <+> text "package," $$ text "try running 'ghc-pkg check'." $$ - mayShowLocations files + may_show_locations files MissingPackageWayFiles build pkg files -> text "Perhaps you haven't installed the " <> text build <+> text "libraries for package " <> quotes (ppr pkg) <> char '?' $$ - mayShowLocations files + may_show_locations files ModuleSuggestion ms fps -> let pp_suggestions :: [ModuleSuggestion] -> SDoc @@ -231,7 +236,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> ppr (mkUnit pkg)) | otherwise = empty - in pp_suggestions ms $$ mayShowLocations fps + in pp_suggestions ms $$ may_show_locations fps NotAModule -> text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> vcat (map text fps) MultiplePackages mods @@ -249,7 +254,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal vcat (map pkg_hidden pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ vcat (map unusable unusables) $$ - mayShowLocations files + may_show_locations files where pprMod (m, o) = text "it is bound as" <+> ppr m <+> text "by" <+> pprOrigin m o @@ -269,7 +274,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> quotes (ppr uid) --FIXME: we don't really want to show the unit id here we should -- show the source package id or installed package id if it's ambiguous - <> dot $$ pkg_hidden_hint uif + <> dot $$ maybe empty pkg_hidden_hint uif mod_hidden pkg = @@ -286,17 +291,17 @@ interfaceErrorDiagnostic opts = \ case Can'tFindNameInInterface name relevant_tyThings -> missingDeclInInterface name relevant_tyThings Can'tFindInterface err looking_for -> + hangNotEmpty (lookingForHerald looking_for) 2 (missingInterfaceErrorDiagnostic opts err) + +lookingForHerald :: InterfaceLookingFor -> SDoc +lookingForHerald looking_for = case looking_for of - LookingForName {} -> - missingInterfaceErrorDiagnostic opts err - LookingForModule {} -> - missingInterfaceErrorDiagnostic opts err + LookingForName {} -> empty + LookingForModule {} -> empty LookingForHiBoot mod -> - hang (text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon) - 2 (missingInterfaceErrorDiagnostic opts err) + text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon LookingForSig sig -> - hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) - 2 (missingInterfaceErrorDiagnostic opts err) + text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc readInterfaceErrorDiagnostic = \ case ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -4,14 +4,28 @@ module GHCi.UI.Exception(printGhciException) where import GHC.Prelude -import GHC.Utils.Logger -import Control.Monad.IO.Class -import GHC.Driver.Session -import GHC.Types.SourceError -import GHC.Driver.Errors.Types -import GHC.Types.Error + import GHC.Driver.Config.Diagnostic import GHC.Driver.Errors +import GHC.Driver.Errors.Types +import GHC.Driver.Session + +import GHC.Iface.Errors.Ppr +import GHC.Iface.Errors.Types + +import GHC.Tc.Errors.Ppr +import GHC.Tc.Errors.Types + +import GHC.Types.Error +import GHC.Types.SourceError + +import GHC.Unit.State + +import GHC.Utils.Logger +import GHC.Utils.Outputable + +import Control.Monad.IO.Class + -- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting -- for some error messages. @@ -24,14 +38,14 @@ printGhciException err = do liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err)) -newtype GHCiMessage = GHCiMessage { getGhciMessage :: GhcMessage } +newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage } instance Diagnostic GHCiMessage where type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage defaultDiagnosticOpts = defaultDiagnosticOpts @GhcMessage - diagnosticMessage opts (GHCiMessage msg) = diagnosticMessage opts msg + diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg diagnosticReason (GHCiMessage msg) = diagnosticReason msg @@ -39,4 +53,38 @@ instance Diagnostic GHCiMessage where diagnosticCode (GHCiMessage msg) = diagnosticCode msg +-- Modifications to error messages which we want to display in GHCi +ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc +ghciDiagnosticMessage ghc_opts msg = + case msg of + GhcTcRnMessage (TcRnInterfaceError err) -> + case ghciInterfaceError err of + Just sdoc -> mkSimpleDecorated sdoc + Nothing -> diagnosticMessage ghc_opts msg + GhcDriverMessage (DriverInterfaceError err) -> + case ghciInterfaceError err of + Just sdoc -> mkSimpleDecorated sdoc + Nothing -> diagnosticMessage ghc_opts msg + _ -> diagnosticMessage ghc_opts msg + where + opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts) + + ghciInterfaceError (Can'tFindInterface err looking_for) = + hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err + ghciInterfaceError _ = Nothing + + ghciMissingInterfaceErrorDiagnostic reason = + case reason of + CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi) + _ -> Nothing + where + + may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts) + pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts) + where + hidden_msg pkg = + text "You can run" <+> + quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> + text "to expose it." $$ + text "(Note: this unloads all the modules in the current scope.)" ===================================== testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr ===================================== @@ -2,4 +2,4 @@ module-visibility-import/MV.hs:5:1: error: [GHC-87110] Could not load module ‘MV2’. it is a hidden module in the package ‘mv’ - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.stderr ===================================== @@ -18,7 +18,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z A.hs:3:1: error: [GHC-87110] Could not find module ‘B’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. == Dep_DM_AB == Dep_Error_DM_AB @@ -27,7 +27,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z A.hs:3:1: error: [GHC-87110] Could not find module ‘B’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. == Dep_MD_AB == Dep_Error_MD_AB ===================================== testsuite/tests/ghc-e/should_run/T2636.stderr ===================================== @@ -1,4 +1,4 @@ T2636.hs:1:1: error: [GHC-87110] Could not find module ‘MissingModule’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/module/mod1.stderr ===================================== @@ -1,4 +1,4 @@ mod1.hs:3:1: error: [GHC-87110] Could not find module ‘N’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/module/mod2.stderr ===================================== @@ -1,4 +1,4 @@ mod2.hs:3:1: error: [GHC-87110] Could not find module ‘N’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T22884.hs ===================================== @@ -0,0 +1,3 @@ +module T22884 where + +import Data.Text ===================================== testsuite/tests/package/T22884.stderr ===================================== @@ -0,0 +1,5 @@ + +T22884.hs:3:1: error: [GHC-87110] + Could not load module ‘Data.Text’. + It is a member of the hidden package ‘text-2.0.2’. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T22884_interactive.script ===================================== @@ -0,0 +1,3 @@ +:set -hide-all-packages + +import Data.Text ===================================== testsuite/tests/package/T22884_interactive.stderr ===================================== @@ -0,0 +1,6 @@ + +: error: [GHC-87110] + Could not load module ‘Data.Text’. + It is a member of the hidden package ‘text-2.0.2’. + You can run ‘:set -package text’ to expose it. + (Note: this unloads all the modules in the current scope.) ===================================== testsuite/tests/package/T4806.stderr ===================================== @@ -3,4 +3,4 @@ T4806.hs:1:1: error: [GHC-87110] Could not load module ‘Data.Map’. It is a member of the package ‘containers-0.6.7’ which is ignored due to an -ignore-package flag - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -4,4 +4,4 @@ T4806a.hs:1:1: error: [GHC-87110] It is a member of the package ‘containers-0.6.7’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: deepseq-1.4.8.1 template-haskell-2.20.0.0 - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/all.T ===================================== @@ -20,3 +20,5 @@ test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers']) test('T4806a', normalise_version('deepseq', 'containers'), compile_fail, ['-ignore-package deepseq']) +test('T22884', normalise_version('text'), compile_fail, ['-hide-package text']) +test('T22884_interactive', normalise_version('text'), ghci_script, ['T22884_interactive.script']) ===================================== testsuite/tests/package/package01e.stderr ===================================== @@ -2,13 +2,9 @@ package01e.hs:2:1: error: [GHC-87110] Could not load module ‘Data.Map’. It is a member of the hidden package ‘containers-0.6.7’. - You can run ‘:set -package containers’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package01e.hs:3:1: error: [GHC-87110] Could not load module ‘Data.IntMap’. It is a member of the hidden package ‘containers-0.6.7’. - You can run ‘:set -package containers’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package06e.stderr ===================================== @@ -2,13 +2,9 @@ package06e.hs:2:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package06e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package07e.stderr ===================================== @@ -5,25 +5,19 @@ package07e.hs:2:1: error: [GHC-61948] GHC.Hs.Type (needs flag -package-id ghc-9.7) GHC.Tc.Types (needs flag -package-id ghc-9.7) GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:4:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Utils’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:5:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package08e.stderr ===================================== @@ -5,25 +5,19 @@ package08e.hs:2:1: error: [GHC-61948] GHC.Hs.Type (needs flag -package-id ghc-9.7) GHC.Tc.Types (needs flag -package-id ghc-9.7) GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:4:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Utils’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:5:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/perf/compiler/parsing001.stderr ===================================== @@ -1,4 +1,4 @@ parsing001.hs:3:1: error: [GHC-87110] Could not find module ‘Wibble’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/plugins/T11244.stderr ===================================== @@ -1,5 +1,3 @@ : Could not load module ‘RuleDefiningPlugin’. It is a member of the hidden package ‘rule-defining-plugin-0.1’. -You can run ‘:set -package rule-defining-plugin’ to expose it. -(Note: this unloads all the modules in the current scope.) -Use -v (or `:set -v` in ghci) to see a list of the files searched for. +Use -v to see a list of the files searched for. ===================================== testsuite/tests/plugins/plugins03.stderr ===================================== @@ -1,2 +1,2 @@ : Could not find module ‘Simple.NonExistentPlugin’. -Use -v (or `:set -v` in ghci) to see a list of the files searched for. +Use -v to see a list of the files searched for. ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr ===================================== @@ -4,4 +4,4 @@ SafeLang07.hs:2:14: warning: SafeLang07.hs:15:1: error: [GHC-87110] Could not find module ‘SafeLang07_A’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/typecheck/should_fail/tcfail082.stderr ===================================== @@ -1,12 +1,12 @@ tcfail082.hs:2:1: error: [GHC-87110] Could not find module ‘Data82’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. tcfail082.hs:3:1: error: [GHC-87110] Could not find module ‘Inst82_1’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. tcfail082.hs:4:1: error: [GHC-87110] Could not find module ‘Inst82_2’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ca31f4164adeb6393aa249d633f548bf775399f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ca31f4164adeb6393aa249d633f548bf775399f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 08:56:24 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 03 May 2023 04:56:24 -0400 Subject: [Git][ghc/ghc][wip/js-boundsCheck] Fix remaining issues with bound checking (#23123) Message-ID: <645221b82dd4c_3c911519fceb58228691@gitlab.mail> Sylvain Henry pushed to branch wip/js-boundsCheck at Glasgow Haskell Compiler / GHC Commits: eed582b5 by Sylvain Henry at 2023-05-03T10:55:20+02:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 9 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,219 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsCheckedLen bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsCheckedLen bound a (byteIndex64 i) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsCheckedRangeLen bound a1 o1 n - . boundsCheckedRangeLen bound a2 o2 n + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsCheckedRangeLen bound a1 o1 n - . boundsCheckedRangeLen bound a2 o2 n - . checkOverlapByteArray bound a1 o1 a2 o2 n - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsCheckedRangeLen bound a o n $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -757,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -918,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1032,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsCheckedLen bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsCheckedLen bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsCheckedLen bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsCheckedLen bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsCheckedLen bound a i . boundsCheckedLen bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex16 i) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsCheckedLen bound a (byteIndex32 i) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsCheckedLen bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1368,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1392,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1407,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1417,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1432,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1445,73 +1387,151 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked' +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound :: JExpr -- ^ Max index expression -> Bool -- ^ Should we do bounds checking? -> JExpr -- ^ Index -> JStat -- ^ Result -> JStat -boundsChecked' _ False _ r = r -boundsChecked' max_index True i r = - ifS ((i .>=. zero_) .&&. (i .<. max_index)) r $ - returnS (app "h$exitProcess" [Int 134]) +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] -- | Bounds checking using ".length" property (Arrays) -boundsChecked +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range :: Bool -- ^ Should we do bounds checking? -> JExpr -- ^ Array -> JExpr -- ^ Index + -> JExpr -- ^ Range size -> JStat -- ^ Result -> JStat -boundsChecked do_check arr = boundsChecked' (arr .^ "length") do_check +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) -- | Bounds checking using ".len" property (ByteArrays) -boundsCheckedLen +bnd_ba :: Bool -- ^ Should we do bounds checking? -> JExpr -- ^ Array -> JExpr -- ^ Index -> JStat -- ^ Result -> JStat -boundsCheckedLen do_check arr = boundsChecked' (arr .^ "len") do_check +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r -- | Bounds checking on a range and using ".len" property (ByteArrays) -- -- Empty ranges trivially pass the check -boundsCheckedRangeLen +bnd_ba_range :: Bool -- ^ Should we do bounds checking? -> JExpr -- ^ Array -> JExpr -- ^ Index -> JExpr -- ^ Range size -> JStat -- ^ Result -> JStat -boundsCheckedRangeLen False _ _ _ r = r -boundsCheckedRangeLen True xs i n r = +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ - ifS (n .===. zero_) -- We can always fill zero elements, even if it seems out-of-bounds + -- Empty ranges trivially pass the check + ifS (n .===. zero_) r - (boundsCheckedLen True xs (Add i (Sub n 1)) (boundsCheckedLen True xs i r)) + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) checkOverlapByteArray :: Bool -- ^ Should we do bounds checking? @@ -1522,20 +1542,18 @@ checkOverlapByteArray -> JExpr -- ^ Range size -> JStat -- ^ Result -> JStat -checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray False _ _ _ _ _ r = r checkOverlapByteArray True a1 o1 a2 o2 n r = ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) -byteIndex16 :: JExpr -> JExpr -byteIndex16 i = Add 1 (Mul 2 i) - -byteIndex32 :: JExpr -> JExpr -byteIndex32 i = Add 3 (Mul 4 i) - -byteIndex64 :: JExpr -> JExpr -byteIndex64 i = Add 7 (Mul 8 i) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; return true; } ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(21142), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eed582b504a14b307bef635b25a10e2ce2c9110e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eed582b504a14b307bef635b25a10e2ce2c9110e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 09:25:14 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 03 May 2023 05:25:14 -0400 Subject: [Git][ghc/ghc][wip/unitidset] 27 commits: testsuite/T20137: Avoid impl.-defined behavior Message-ID: <6452287aeb4e4_3c911519f6773c2321ed@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 4fd0540c by Josh Meredith at 2023-05-03T09:23:46+00:00 Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Hs.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e398305cf56890538eedaa0da43d3d8f98c5b197...4fd0540ce926b7e41e9378cb54b0545ce6665a07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e398305cf56890538eedaa0da43d3d8f98c5b197...4fd0540ce926b7e41e9378cb54b0545ce6665a07 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 10:26:11 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 03 May 2023 06:26:11 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <645236c3550ed_3c91151cf4c2b82425cb@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 721877cf by Josh Meredith at 2023-05-03T10:25:58+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 6 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS @@ -22,7 +23,6 @@ module GHC.JS.Transform , composOpM_ , composOpFold , satJExpr - , satJStat ) where @@ -33,7 +33,6 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict @@ -200,66 +199,61 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) - where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v - +jsSaturate :: Maybe FastString -> JStat -> Sat.JStat +jsSaturate str x = evalState (jsSaturateS x) (newIdentSupply str) + +jsSaturateS :: JStat -> State [Ident] Sat.JStat +jsSaturateS = \case + DeclStat i rhs -> Sat.DeclStat i <$> mapM jsSaturateE rhs + ReturnStat e -> Sat.ReturnStat <$> jsSaturateE e + IfStat c t e -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e + WhileStat is_do c e -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e + ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body + SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct + <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps + <*> jsSaturateS def + TryStat t i c f -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f + BlockStat bs -> fmap Sat.BlockStat $! mapM jsSaturateS bs + ApplStat rator rand -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand + UOpStat rator rand -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand + AssignStat lhs rhs -> Sat.AssignStat <$> jsSaturateE lhs <*> jsSaturateE rhs + LabelStat lbl stmt -> Sat.LabelStat lbl <$> jsSaturateS stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + UnsatBlock us -> jsSaturateS =<< runIdentSupply us + +jsSaturateE :: JExpr -> State [Ident] Sat.JExpr +jsSaturateE = \case + ValExpr v -> Sat.ValExpr <$> jsSaturateV v + SelExpr obj i -> Sat.SelExpr <$> jsSaturateE obj <*> pure i + IdxExpr o i -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i + InfixExpr op l r -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r + UOpExpr op r -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r + IfExpr c t e -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e + ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands + UnsatExpr us -> jsSaturateE =<< runIdentSupply us + +jsSaturateV :: JVal -> State [Ident] Sat.JVal +jsSaturateV = \case + JVar i -> return $ Sat.JVar i + JList xs -> Sat.JList <$> mapM jsSaturateE xs + JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) + JInt i -> return $ Sat.JInt i + JStr s -> return $ Sat.JStr s + JRegEx f -> return $ Sat.JRegEx f + JHash m -> return $ Sat.JHash (satJExpr <$> m) + JFunc args body -> Sat.JFunc args <$> jsSaturateS body + UnsatVal us -> jsSaturateV =<< runIdentSupply us + -------------------------------------------------------------------------------- -- Translation -- -- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - satJExpr :: JExpr -> Sat.JExpr -satJExpr = go - where - go (ValExpr v) = Sat.ValExpr (satJVal v) - go (SelExpr obj i) = Sat.SelExpr (satJExpr obj) i - go (IdxExpr o i) = Sat.IdxExpr (satJExpr o) (satJExpr i) - go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r) - go (UOpExpr op r) = Sat.UOpExpr (satJUOp op) (satJExpr r) - go (IfExpr c t e) = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e) - go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands) - go UnsatExpr{} = error "satJExpr: discovered an Unsat...impossibly" +satJExpr x = evalState (jsSaturateE x) (newIdentSupply $ error "satJExpr: discovered an Unsat...impossibly") satJOp :: JOp -> Sat.Op satJOp = go @@ -305,15 +299,3 @@ satJUOp = go go PreDecOp = Sat.PreDecOp go PostDecOp = Sat.PostDecOp -satJVal :: JVal -> Sat.JVal -satJVal = go - where - go (JVar i) = Sat.JVar i - go (JList xs) = Sat.JList (satJExpr <$> xs) - go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) - go (JInt i) = Sat.JInt i - go (JStr f) = Sat.JStr f - go (JRegEx f) = Sat.JRegEx f - go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) - go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a +saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat +rtsDecls :: Sat.JStat rtsDecls = jsSaturate (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread @@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat +rts :: StgToJSConfig -> Sat.JStat rts = jsSaturate (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/721877cffd0db35e95f1dd93a176baa35232c5d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/721877cffd0db35e95f1dd93a176baa35232c5d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 11:01:09 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 03 May 2023 07:01:09 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <64523ef5755fa_3c91151e33e3e8253084@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 5c79cd4d by Josh Meredith at 2023-05-03T11:00:57+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 6 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS @@ -22,7 +23,6 @@ module GHC.JS.Transform , composOpM_ , composOpFold , satJExpr - , satJStat ) where @@ -33,7 +33,6 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict @@ -200,18 +199,51 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) - where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v +jsSaturate :: Maybe FastString -> JStat -> Sat.JStat +jsSaturate str x = evalState (jsSaturateS x) (newIdentSupply str) + +jsSaturateS :: JStat -> State [Ident] Sat.JStat +jsSaturateS = \case + DeclStat i rhs -> Sat.DeclStat i <$> mapM jsSaturateE rhs + ReturnStat e -> Sat.ReturnStat <$> jsSaturateE e + IfStat c t e -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e + WhileStat is_do c e -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e + ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body + SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct + <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps + <*> jsSaturateS def + TryStat t i c f -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f + BlockStat bs -> fmap Sat.BlockStat $! mapM jsSaturateS bs + ApplStat rator rand -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand + UOpStat rator rand -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand + AssignStat lhs rhs -> Sat.AssignStat <$> jsSaturateE lhs <*> jsSaturateE rhs + LabelStat lbl stmt -> Sat.LabelStat lbl <$> jsSaturateS stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + UnsatBlock us -> jsSaturateS =<< runIdentSupply us + +jsSaturateE :: JExpr -> State [Ident] Sat.JExpr +jsSaturateE = \case + ValExpr v -> Sat.ValExpr <$> jsSaturateV v + SelExpr obj i -> Sat.SelExpr <$> jsSaturateE obj <*> pure i + IdxExpr o i -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i + InfixExpr op l r -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r + UOpExpr op r -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r + IfExpr c t e -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e + ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands + UnsatExpr us -> jsSaturateE =<< runIdentSupply us + +jsSaturateV :: JVal -> State [Ident] Sat.JVal +jsSaturateV = \case + JVar i -> return $ Sat.JVar i + JList xs -> Sat.JList <$> mapM jsSaturateE xs + JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) + JInt i -> return $ Sat.JInt i + JStr s -> return $ Sat.JStr s + JRegEx f -> return $ Sat.JRegEx f + JHash m -> return $ Sat.JHash (satJExpr <$> m) + JFunc args body -> Sat.JFunc args <$> jsSaturateS body + UnsatVal us -> jsSaturateV =<< runIdentSupply us -------------------------------------------------------------------------------- @@ -219,47 +251,9 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) -- -- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - satJExpr :: JExpr -> Sat.JExpr -satJExpr = go - where - go (ValExpr v) = Sat.ValExpr (satJVal v) - go (SelExpr obj i) = Sat.SelExpr (satJExpr obj) i - go (IdxExpr o i) = Sat.IdxExpr (satJExpr o) (satJExpr i) - go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r) - go (UOpExpr op r) = Sat.UOpExpr (satJUOp op) (satJExpr r) - go (IfExpr c t e) = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e) - go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands) - go UnsatExpr{} = error "satJExpr: discovered an Unsat...impossibly" +satJExpr x = evalState (jsSaturateE x) (newIdentSupply $ error "satJExpr: discovered an Unsat...impossibly") satJOp :: JOp -> Sat.Op satJOp = go @@ -305,15 +299,3 @@ satJUOp = go go PreDecOp = Sat.PreDecOp go PostDecOp = Sat.PostDecOp -satJVal :: JVal -> Sat.JVal -satJVal = go - where - go (JVar i) = Sat.JVar i - go (JList xs) = Sat.JList (satJExpr <$> xs) - go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) - go (JInt i) = Sat.JInt i - go (JStr f) = Sat.JStr f - go (JRegEx f) = Sat.JRegEx f - go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) - go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a +saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat +rtsDecls :: Sat.JStat rtsDecls = jsSaturate (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread @@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat +rts :: StgToJSConfig -> Sat.JStat rts = jsSaturate (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c79cd4d57bdf27c6ab98f201fe65be2181266f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c79cd4d57bdf27c6ab98f201fe65be2181266f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 11:33:42 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Wed, 03 May 2023 07:33:42 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv-increase-CI-happiness] Fix compiler warning about importing GHC.Utils.Panic.Plain in CodeGen.Platform.h Message-ID: <6452469697f50_3c91151dfe08cc265974@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv-increase-CI-happiness at Glasgow Haskell Compiler / GHC Commits: c5024bcb by Sven Tennie at 2023-05-03T11:32:39+00:00 Fix compiler warning about importing GHC.Utils.Panic.Plain in CodeGen.Platform.h - - - - - 1 changed file: - compiler/CodeGen.Platform.h Changes: ===================================== compiler/CodeGen.Platform.h ===================================== @@ -1,7 +1,8 @@ import GHC.Cmm.Expr #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \ - || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64)) + || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64) \ + || defined(MACHREGS_riscv64)) import GHC.Utils.Panic.Plain #endif import GHC.Platform.Reg View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5024bcbe41c5cab6429185fa4d65c67f87b8aa1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5024bcbe41c5cab6429185fa4d65c67f87b8aa1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 11:34:14 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 03 May 2023 07:34:14 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <645246b6e2684_3c91151e147bd42662f0@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 2f81fe5a by Josh Meredith at 2023-05-03T11:34:04+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 6 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS @@ -22,7 +23,6 @@ module GHC.JS.Transform , composOpM_ , composOpFold , satJExpr - , satJStat ) where @@ -33,11 +33,12 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) +import Data.List (sortBy) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique.Map +import GHC.Types.Unique.FM {-# INLINE identsS #-} @@ -200,18 +201,53 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) - where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v +jsSaturate :: Maybe FastString -> JStat -> Sat.JStat +jsSaturate str x = evalState (jsSaturateS x) (newIdentSupply str) + +jsSaturateS :: JStat -> State [Ident] Sat.JStat +jsSaturateS = \case + DeclStat i rhs -> Sat.DeclStat i <$> mapM jsSaturateE rhs + ReturnStat e -> Sat.ReturnStat <$> jsSaturateE e + IfStat c t e -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e + WhileStat is_do c e -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e + ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body + SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct + <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps + <*> jsSaturateS def + TryStat t i c f -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f + BlockStat bs -> fmap Sat.BlockStat $! mapM jsSaturateS bs + ApplStat rator rand -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand + UOpStat rator rand -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand + AssignStat lhs rhs -> Sat.AssignStat <$> jsSaturateE lhs <*> jsSaturateE rhs + LabelStat lbl stmt -> Sat.LabelStat lbl <$> jsSaturateS stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + UnsatBlock us -> jsSaturateS =<< runIdentSupply us + +jsSaturateE :: JExpr -> State [Ident] Sat.JExpr +jsSaturateE = \case + ValExpr v -> Sat.ValExpr <$> jsSaturateV v + SelExpr obj i -> Sat.SelExpr <$> jsSaturateE obj <*> pure i + IdxExpr o i -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i + InfixExpr op l r -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r + UOpExpr op r -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r + IfExpr c t e -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e + ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands + UnsatExpr us -> jsSaturateE =<< runIdentSupply us + +jsSaturateV :: JVal -> State [Ident] Sat.JVal +jsSaturateV = \case + JVar i -> return $ Sat.JVar i + JList xs -> Sat.JList <$> mapM jsSaturateE xs + JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) + JInt i -> return $ Sat.JInt i + JStr s -> return $ Sat.JStr s + JRegEx f -> return $ Sat.JRegEx f + JHash (UniqMap m) -> Sat.JHash . UniqMap . listToUFM + <$> ( mapM (\(f, x) -> jsSaturateE x >>= \x' -> return (f, (f, x')) ) + . sortBy (\x y -> fst x `lexicalCompareFS` fst y) $ nonDetEltsUFM m ) + JFunc args body -> Sat.JFunc args <$> jsSaturateS body + UnsatVal us -> jsSaturateV =<< runIdentSupply us -------------------------------------------------------------------------------- @@ -219,47 +255,9 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) -- -- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - satJExpr :: JExpr -> Sat.JExpr -satJExpr = go - where - go (ValExpr v) = Sat.ValExpr (satJVal v) - go (SelExpr obj i) = Sat.SelExpr (satJExpr obj) i - go (IdxExpr o i) = Sat.IdxExpr (satJExpr o) (satJExpr i) - go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r) - go (UOpExpr op r) = Sat.UOpExpr (satJUOp op) (satJExpr r) - go (IfExpr c t e) = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e) - go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands) - go UnsatExpr{} = error "satJExpr: discovered an Unsat...impossibly" +satJExpr x = evalState (jsSaturateE x) (newIdentSupply $ error "satJExpr: discovered an Unsat...impossibly") satJOp :: JOp -> Sat.Op satJOp = go @@ -305,15 +303,3 @@ satJUOp = go go PreDecOp = Sat.PreDecOp go PostDecOp = Sat.PostDecOp -satJVal :: JVal -> Sat.JVal -satJVal = go - where - go (JVar i) = Sat.JVar i - go (JList xs) = Sat.JList (satJExpr <$> xs) - go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) - go (JInt i) = Sat.JInt i - go (JStr f) = Sat.JStr f - go (JRegEx f) = Sat.JRegEx f - go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) - go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a +saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat +rtsDecls :: Sat.JStat rtsDecls = jsSaturate (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread @@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat +rts :: StgToJSConfig -> Sat.JStat rts = jsSaturate (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f81fe5a13703ae2d57470238396f5d12bdce0cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f81fe5a13703ae2d57470238396f5d12bdce0cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 11:52:31 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 03 May 2023 07:52:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/23305 Message-ID: <64524aff41b4a_3c91151dfe08cc2923f1@gitlab.mail> Matthew Pickering pushed new branch wip/23305 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/23305 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 12:20:51 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 03 May 2023 08:20:51 -0400 Subject: [Git][ghc/ghc][wip/T19146] 21 commits: ci: update ci.sh to actually run the entire testsuite for wasm backend Message-ID: <645251a3f3d8b_3c91151e33fbf831088c@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 2b7114a4 by Ben Gamari at 2023-05-03T08:20:41-04:00 rts: Clear block_info when unblocking Otherwise we may end up with dangling pointers which may complicate debugging. - - - - - 98137a48 by Ben Gamari at 2023-05-03T08:20:41-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - 95d05eb1 by Ben Gamari at 2023-05-03T08:20:41-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - 7b8aaee0 by Ben Gamari at 2023-05-03T08:20:41-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 604c09d1 by Ben Gamari at 2023-05-03T08:20:45-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 981401a9 by Ben Gamari at 2023-05-03T08:20:45-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - a786945f by Ben Gamari at 2023-05-03T08:20:45-04:00 rts: Introduce printGlobalThreads - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/9.8.1-notes.rst - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/GHC/TypeError.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a117ab986e128d4f409c6be94a0d7f1c6d8912b...a786945f3b976bcb451476f8b1710c4cc313fa4d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a117ab986e128d4f409c6be94a0d7f1c6d8912b...a786945f3b976bcb451476f8b1710c4cc313fa4d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 13:10:04 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 03 May 2023 09:10:04 -0400 Subject: [Git][ghc/ghc][wip/T19146] 2 commits: rts: Don't sanity-check StgTSO.global_link Message-ID: <64525d2ce4c3e_3c91151e119aa43175ec@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: b7999e92 by Ben Gamari at 2023-05-03T09:10:00-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - c69e7e6d by Ben Gamari at 2023-05-03T09:10:00-04:00 rts: Introduce printGlobalThreads - - - - - 3 changed files: - rts/Threads.c - rts/Threads.h - rts/sm/Sanity.c Changes: ===================================== rts/Threads.c ===================================== @@ -1008,6 +1008,20 @@ printAllThreads(void) } } +void +printGlobalThreads(void) +{ + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + debugBelch("\ngen %d\n", g); + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu)\n", t, t->id); + } + for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + } + } +} + // useful from gdb void printThreadQueue(StgTSO *t) ===================================== rts/Threads.h ===================================== @@ -46,6 +46,7 @@ bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value); void printThreadBlockage (StgTSO *tso); void printThreadStatus (StgTSO *t); void printAllThreads (void); +void printGlobalThreads(void); void printThreadQueue (StgTSO *t); #endif ===================================== rts/sm/Sanity.c ===================================== @@ -737,6 +737,27 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* + * Note [Sanity-checking global_link] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * TSOs are a bit odd in that they have a global_link pointer field + * which is not scavenged by the GC. This field is used to track the + * generations[_].[old_]threads lists and is ultimately updated by + * MarkWeak.c:tidyThreadList. + + * Typically the fact that this field is not scavenged is fine as all reachable + * TSOs on the heap are guaranteed to be on some generation's thread list and + * therefore will be scavenged by tidyThreadList. However, the sanity checker + * poses a bit of a challenge here as it walks heap blocks directly and + * therefore may encounter TSOs which aren't reachable via the heap. + * For this reason, checkTSO does not check global_link. Instead, we only do + * so in checkGlobalTSOList, which by definition will only look at + * threads which are reachable via a thread list (and therefore must have won + * the forwarding-pointer race). + * + * See #19146. + */ + void checkTSO(StgTSO *tso) { @@ -761,9 +782,11 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && - (tso->global_link == END_TSO_QUEUE || - get_itbl((StgClosure*)tso->global_link)->type == TSO)); + + // This assertion is sadly not viable. See Note [Sanity-checking global_link]. + //ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && + // (tso->global_link == END_TSO_QUEUE || + // get_itbl((StgClosure*)tso->global_link)->type == TSO)); if (tso->label) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->label)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a786945f3b976bcb451476f8b1710c4cc313fa4d...c69e7e6d86c7528d6cb321bb24be52633560acfb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a786945f3b976bcb451476f8b1710c4cc313fa4d...c69e7e6d86c7528d6cb321bb24be52633560acfb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 13:18:42 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 03 May 2023 09:18:42 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 22 commits: DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) Message-ID: <64525f3235eda_3c91151e119aa4318155@gitlab.mail> Matthew Pickering pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - c3a110fc by Matthew Pickering at 2023-05-03T13:18:38+00:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 9ed40a1d by romes at 2023-05-03T13:18:38+00:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 818dfe48 by romes at 2023-05-03T13:18:38+00:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 95ed5487 by romes at 2023-05-03T13:18:38+00:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 4363a87e by Matthew Pickering at 2023-05-03T13:18:38+00:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/CSE.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Lift.hs - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/Stg/Lift/Monad.hs - compiler/GHC/Stg/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e794a65877eee0df6ee9aa7eb04bfbc0a5af67e...4363a87ea1d616f4405ed4e69937161e0b340495 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e794a65877eee0df6ee9aa7eb04bfbc0a5af67e...4363a87ea1d616f4405ed4e69937161e0b340495 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 15:19:48 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 03 May 2023 11:19:48 -0400 Subject: [Git][ghc/ghc][wip/unitidset] Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) Message-ID: <64527b943899b_3c91151e2766903556a3@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: df356143 by Josh Meredith at 2023-05-03T15:19:26+00:00 Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) - - - - - 21 changed files: - compiler/GHC.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -395,6 +395,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -418,8 +419,6 @@ import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as S import qualified Data.Sequence as Seq import System.Directory @@ -604,7 +603,7 @@ setSessionDynFlags dflags0 = do logger <- getLogger dflags <- checkNewDynFlags logger dflags0 let all_uids = hsc_all_home_unit_ids hsc_env - case S.toList all_uids of + case uniqDSetToList all_uids of [uid] -> do setUnitDynFlagsNoCheck uid dflags modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags)) @@ -1379,7 +1378,7 @@ data ModuleInfo = ModuleInfo { -- | Request information about a loaded 'Module' getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X getModuleInfo mdl = withSession $ \hsc_env -> do - if moduleUnitId mdl `S.member` hsc_all_home_unit_ids hsc_env + if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env then liftIO $ getHomeModuleInfo hsc_env mdl else liftIO $ getPackageModuleInfo hsc_env mdl @@ -1756,7 +1755,7 @@ isModuleTrusted m = withSession $ \hsc_env -> liftIO $ hscCheckSafe hsc_env m noSrcSpan -- | Return if a module is trusted and the pkgs it depends on to be trusted. -moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId) +moduleTrustReqs :: GhcMonad m => Module -> m (Bool, UnitIdSet) moduleTrustReqs m = withSession $ \hsc_env -> liftIO $ hscGetSafe hsc_env m noSrcSpan ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -56,12 +56,11 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre import GHC.Types.ForeignStubs import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) +import GHC.Types.Unique.DSet import System.Directory import System.FilePath import System.IO -import Data.Set (Set) -import qualified Data.Set as Set {- ************************************************************************ @@ -84,7 +83,7 @@ codeOutput -> (a -> ForeignStubs) -> [(ForeignSrcLang, FilePath)] -- ^ additional files to be compiled with the C compiler - -> Set UnitId -- ^ Dependencies + -> UnitIdSet -- ^ Dependencies -> Stream IO RawCmmGroup a -- Compiled C-- -> IO (FilePath, (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}), @@ -161,11 +160,11 @@ outputC :: Logger -> DynFlags -> FilePath -> Stream IO RawCmmGroup a - -> Set UnitId + -> UnitIdSet -> IO a outputC logger dflags filenm cmm_stream unit_deps = withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do - let pkg_names = map unitIdString (Set.toAscList unit_deps) + let pkg_names = map unitIdString (uniqDSetToAscList unit_deps) doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h "#include \"Stg.h\"\n" ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -127,7 +127,7 @@ hsc_HUE = ue_currentHomeUnitEnv . hsc_unit_env hsc_HUG :: HscEnv -> HomeUnitGraph hsc_HUG = ue_home_unit_graph . hsc_unit_env -hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId +hsc_all_home_unit_ids :: HscEnv -> UnitIdSet hsc_all_home_unit_ids = unitEnv_keys . hsc_HUG hscUpdateHPT_lazy :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -245,6 +245,7 @@ import GHC.Types.Name.Ppr import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.TyThing import GHC.Types.HpcInfo +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint ( Fingerprint ) import GHC.Utils.Panic @@ -274,7 +275,6 @@ import Data.IORef import System.FilePath as FilePath import System.Directory import qualified Data.Set as S -import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) @@ -1457,15 +1457,15 @@ checkSafeImports tcg_env clearDiagnostics -- Check safe imports are correct - safePkgs <- S.fromList <$> mapMaybeM checkSafe safeImps + safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps safeErrs <- getDiagnostics clearDiagnostics -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] (infErrs, infPkgs) <- case (safeInferOn dflags) of - False -> return (emptyMessages, S.empty) - True -> do infPkgs <- S.fromList <$> mapMaybeM checkSafe regImps + False -> return (emptyMessages, emptyUniqDSet) + True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps infErrs <- getDiagnostics clearDiagnostics return (infErrs, infPkgs) @@ -1516,12 +1516,12 @@ checkSafeImports tcg_env checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l -- what pkg's to add to our trust requirements - pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId -> + pkgTrustReqs :: DynFlags -> UnitIdSet -> UnitIdSet -> Bool -> ImportAvails pkgTrustReqs dflags req inf infPassed | safeInferOn dflags && not (safeHaskellModeEnabled dflags) && infPassed = emptyImportAvails { - imp_trust_pkgs = req `S.union` inf + imp_trust_pkgs = req `unionUniqDSets` inf } pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe = emptyImportAvails @@ -1540,12 +1540,12 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do return $ isEmptyMessages errs -- | Return if a module is trusted and the pkgs it depends on to be trusted. -hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId) +hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, UnitIdSet) hscGetSafe hsc_env m l = runHsc hsc_env $ do (self, pkgs) <- hscCheckSafe' m l good <- isEmptyMessages `fmap` getDiagnostics clearDiagnostics -- don't want them printed... - let pkgs' | Just p <- self = S.insert p pkgs + let pkgs' | Just p <- self = addOneToUniqDSet pkgs p | otherwise = pkgs return (good, pkgs') @@ -1554,7 +1554,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do -- own package be trusted and a list of other packages required to be trusted -- (these later ones haven't been checked) but the own package trust has been. hscCheckSafe' :: Module -> SrcSpan - -> Hsc (Maybe UnitId, Set UnitId) + -> Hsc (Maybe UnitId, UnitIdSet) hscCheckSafe' m l = do hsc_env <- getHscEnv let home_unit = hsc_home_unit hsc_env @@ -1566,7 +1566,7 @@ hscCheckSafe' m l = do -- Not necessary if that is reflected in dependencies | otherwise -> return (Just $ toUnitId (moduleUnit m), pkgs) where - isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId) + isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, UnitIdSet) isModSafe home_unit m l = do hsc_env <- getHscEnv dflags <- getDynFlags @@ -1648,10 +1648,10 @@ hscCheckSafe' m l = do -- | Check the list of packages are trusted. -checkPkgTrust :: Set UnitId -> Hsc () +checkPkgTrust :: UnitIdSet -> Hsc () checkPkgTrust pkgs = do hsc_env <- getHscEnv - let errors = S.foldr go emptyBag pkgs + let errors = foldr go emptyBag $ uniqDSetToList pkgs state = hsc_units hsc_env go pkg acc | unitIsTrusted $ unsafeLookupUnitId state pkg @@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do False -> return tcg_env where - wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = S.empty } + wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet } pprMod = ppr $ moduleName $ tcg_mod tcg_env whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" @@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs in NoStubs `appendStubC` ip_init | otherwise = NoStubs (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) - <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty + <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet rawCmms return stub_c_exists where ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -107,6 +107,7 @@ import GHC.Types.SourceFile import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Types.PkgQual import GHC.Unit @@ -490,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much mkBatchMsg :: HscEnv -> Messager mkBatchMsg hsc_env = - if length (hsc_all_home_unit_ids hsc_env) > 1 + if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 -- This also displays what unit each module is from. then batchMultiMsg else batchMsg @@ -1735,25 +1736,25 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- This function checks then important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -checkHomeUnitsClosed :: UnitEnv -> Set.Set UnitId -> [(UnitId, UnitId)] -> [DriverMessages] +checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages] -- Fast path, trivially closed. checkHomeUnitsClosed ue home_id_set home_imp_ids - | Set.size home_id_set == 1 = [] + | sizeUniqDSet home_id_set == 1 = [] | otherwise = - let res = foldMap loop home_imp_ids + let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids -- Now check whether everything which transitively depends on a home_unit is actually a home_unit -- These units are the ones which we need to load as home packages but failed to do for some reason, -- it's a bug in the tool invoking GHC. - bad_unit_ids = Set.difference res home_id_set - in if Set.null bad_unit_ids + bad_unit_ids = res `minusUniqDSet` home_id_set + in if isEmptyUniqDSet bad_unit_ids then [] - else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)] + else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)] where rootLoc = mkGeneralSrcSpan (fsLit "") -- TODO: This could repeat quite a bit of work but I struggled to write this function. -- Which units transitively depend on a home unit - loop :: (UnitId, UnitId) -> Set.Set UnitId -- The units which transitively depend on a home unit + loop :: (UnitId, UnitId) -> UnitIdSet -- The units which transitively depend on a home unit loop (from_uid, uid) = let us = ue_findHomeUnitEnv from_uid ue in let um = unitInfoMap (homeUnitEnv_units us) in @@ -1761,20 +1762,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids Nothing -> pprPanic "uid not found" (ppr uid) Just ui -> let depends = unitDepends ui - home_depends = Set.fromList depends `Set.intersection` home_id_set - other_depends = Set.fromList depends `Set.difference` home_id_set + home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set + other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set in -- Case 1: The unit directly depends on a home_id - if not (null home_depends) + if not (isEmptyUniqDSet home_depends) then - let res = foldMap (loop . (from_uid,)) other_depends - in Set.insert uid res + let res :: UnitIdSet + res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends + in addOneToUniqDSet res uid -- Case 2: Check the rest of the dependencies, and then see if any of them depended on else - let res = foldMap (loop . (from_uid,)) other_depends + let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends in - if not (Set.null res) - then Set.insert uid res + if not (isEmptyUniqDSet res) + then addOneToUniqDSet res uid else res -- | Update the every ModSummary that is depended on ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -108,6 +108,7 @@ import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceError +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -125,7 +126,7 @@ import Control.Monad import qualified Control.Monad.Catch as MC (handle) import Data.Maybe import Data.Either ( partitionEithers ) -import qualified Data.Set as Set +import Data.List ( sort ) import Data.Time ( getCurrentTime ) import GHC.Iface.Recomp @@ -408,8 +409,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt home_mod_infos = eltsHpt hpt -- the packages we depend on - pkg_deps = Set.toList - $ Set.unions + pkg_deps = uniqDSetToList + $ unionManyUniqDSets $ fmap (dep_direct_pkgs . mi_deps . hm_iface) $ home_mod_infos @@ -418,7 +419,7 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt debugTraceMsg logger 3 (text "link: hmi ..." $$ vcat (map (ppr . mi_module . hm_iface) home_mod_infos)) debugTraceMsg logger 3 (text "link: linkables are ..." $$ vcat (map ppr linkables)) - debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr pkg_deps)) + debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr $ sort pkg_deps)) -- check for the -no-link flag if isNoLink (ghcLink dflags) ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -40,7 +41,6 @@ import Data.IORef import Data.List (sortBy) import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.Set as Set import GHC.Linker.Types import GHC.Unit.Finder @@ -196,7 +196,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do mk_mod_usage_info :: UsageConfig -> HomeUnit - -> Set.Set UnitId + -> UnitIdSet -> Module -> ImportedMods -> NameSet @@ -255,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names -- (need to recompile if its export list changes: export_fprint) mkUsage :: Module -> ModIface -> Maybe Usage mkUsage mod iface - | toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids + | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -504,7 +504,7 @@ loadInterface doc_str mod from -- overlapping instances. ; massertPpr ((isOneShot (ghcMode (hsc_dflags hsc_env))) - || moduleUnitId mod `notElem` hsc_all_home_unit_ids hsc_env + || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env) || mod == gHC_PRIM) (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Types.SrcLoc import GHC.Types.Unique.Set import GHC.Types.Fixity.Env import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.State @@ -617,8 +618,8 @@ checkDependencies hsc_env summary iface all_home_units = hsc_all_home_unit_ids hsc_env units = hsc_units hsc_env prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) + prev_dep_pkgs = uniqDSetToList (unionUniqDSets (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) @@ -633,7 +634,7 @@ checkDependencies hsc_env summary iface classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) + | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -324,20 +324,20 @@ loadCmdLineLibs interp hsc_env = do loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState loadCmdLineLibs' interp hsc_env pls = snd <$> foldM - (\(done', pls') cur_uid -> load done' cur_uid pls') - (Set.empty, pls) - (hsc_all_home_unit_ids hsc_env) + (\(done', pls') cur_uid -> load done' cur_uid pls') + (emptyUniqDSet, pls) + (uniqDSetToList $ hsc_all_home_unit_ids hsc_env) where - load :: Set.Set UnitId -> UnitId -> LoaderState -> IO (Set.Set UnitId, LoaderState) - load done uid pls | uid `Set.member` done = return (done, pls) + load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState) + load done uid pls | uid `elementOfUniqDSet` done = return (done, pls) load done uid pls = do let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) - (homeUnitDepends (hsc_units hsc')) + (homeUnitDepends (hsc_units hsc')) pls'' <- loadCmdLineLibs'' interp hsc' pls' - return $ (Set.insert uid done', pls'') + return $ (addOneToUniqDSet done' uid, pls'') loadCmdLineLibs'' :: Interp @@ -685,7 +685,7 @@ getLinkDeps :: HscEnv -> Maybe FilePath -- replace object suffixes? -> SrcSpan -- for error messages -> [Module] -- If you need these - -> IO ([Linkable], [Linkable], [UnitId], UniqDSet UnitId) -- ... then link these first + -> IO ([Linkable], [Linkable], [UnitId], UnitIdSet) -- ... then link these first -- The module and package dependencies for the needed modules are returned. -- See Note [Object File Dependencies] -- Fails with an IO exception if it can't find enough files @@ -737,7 +737,7 @@ getLinkDeps hsc_env pls replace_osuf span mods -- It is also a matter of correctness to use the module graph so that dependencies between home units -- is resolved correctly. - make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) + make_deps_loop :: (UnitIdSet, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UnitIdSet, Set.Set NodeKey) make_deps_loop found [] = found make_deps_loop found@(found_units, found_mods) (nk:nexts) | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts @@ -766,7 +766,7 @@ getLinkDeps hsc_env pls replace_osuf span mods HsBootFile -> link_boot_mod_error (mi_module iface) _ -> return $ Just (mi_module iface) - in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod + in (dep_direct_pkgs (mi_deps iface),) <$> mmod Nothing -> let err = text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid in throwGhcExceptionIO (ProgramError (showSDoc dflags err)) @@ -780,9 +780,9 @@ getLinkDeps hsc_env pls replace_osuf span mods -- dependencies of that. Hence we need to traverse the dependency -- tree recursively. See bug #936, testcase ghci/prog007. follow_deps :: [Module] -- modules to follow - -> UniqDSet Module -- accum. module dependencies - -> UniqDSet UnitId -- accum. package dependencies - -> IO ([Module], UniqDSet UnitId) -- result + -> UniqDSet Module -- accum. module dependencies + -> UnitIdSet -- accum. package dependencies + -> IO ([Module], UnitIdSet) -- result follow_deps [] acc_mods acc_pkgs = return (uniqDSetToList acc_mods, acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs @@ -814,7 +814,7 @@ getLinkDeps hsc_env pls replace_osuf span mods acc_mods' = case hsc_home_unit_maybe hsc_env of Nothing -> acc_mods Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) + acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps) case hsc_home_unit_maybe hsc_env of Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Linker.Types where import GHC.Prelude -import GHC.Unit ( UnitId, Module ) +import GHC.Unit ( UnitId, Module, UnitIdSet ) import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) import GHC.Fingerprint.Type ( Fingerprint ) import GHCi.RemoteTypes ( ForeignHValue ) @@ -53,7 +53,6 @@ import Control.Concurrent.MVar import Data.Time ( UTCTime ) import Data.Maybe import GHC.Unit.Module.Env -import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Unit.Module.WholeCoreBindings @@ -146,7 +145,7 @@ data LoadedPkgInfo { loaded_pkg_uid :: !UnitId , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] - , loaded_pkg_trans_deps :: UniqDSet UnitId + , loaded_pkg_trans_deps :: UnitIdSet } instance Outputable LoadedPkgInfo where ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Types.Id import GHC.Types.HpcInfo import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Module.Warnings @@ -212,8 +213,8 @@ rnImports imports = do let merged_import_avail = clobberSourceImports imp_avails dflags <- getDynFlags let final_import_avail = - merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags) - `S.union` imp_dep_direct_pkgs merged_import_avail} + merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags) + `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail} return (decls, rdr_env, final_import_avail, hpc_usage) where @@ -480,7 +481,7 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of -- | Calculate the 'ImportAvails' induced by an import of a particular -- interface, but without 'imp_mods'. calculateAvails :: HomeUnit - -> S.Set UnitId + -> UnitIdSet -> ModIface -> IsSafeImport -> IsBootInterface @@ -535,7 +536,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by -- Trusted packages are a lot like orphans. trusted_pkgs | mod_safe' = dep_trusted_pkgs deps - | otherwise = S.empty + | otherwise = emptyUniqDSet pkg = moduleUnit (mi_module iface) @@ -548,11 +549,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by | isHomeUnit home_unit pkg = ptrust | otherwise = False - dependent_pkgs = if toUnitId pkg `S.member` other_home_units - then S.empty - else S.singleton ipkg + dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units + then emptyUniqDSet + else unitUniqDSet ipkg - direct_mods = mkModDeps $ if toUnitId pkg `S.member` other_home_units + direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) else S.empty ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -148,6 +148,7 @@ import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -185,7 +186,6 @@ import Data.List ( sortBy, sort ) import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE import Data.Ord -import qualified Data.Set as S import Data.Traversable ( for ) @@ -3134,7 +3134,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports) , text "Dependent packages:" <+> - ppr (S.toList $ imp_dep_direct_pkgs imports)] + ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)] -- The use of sort is just to reduce unnecessary -- wobbling in testsuite output ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -142,6 +142,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Basic import GHC.Types.CostCentre.State import GHC.Types.HpcInfo @@ -1367,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_direct_dep_mods = emptyInstalledModuleEnv, - imp_dep_direct_pkgs = S.empty, + imp_dep_direct_pkgs = emptyUniqDSet, imp_sig_mods = [], - imp_trust_pkgs = S.empty, + imp_trust_pkgs = emptyUniqDSet, imp_trust_own_pkg = False, imp_boot_mods = emptyInstalledModuleEnv, imp_orphs = [], @@ -1398,8 +1399,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, - imp_dep_direct_pkgs = ddpkgs1 `S.union` ddpkgs2, - imp_trust_pkgs = tpkgs1 `S.union` tpkgs2, + imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2, + imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, ===================================== compiler/GHC/Types/Unique/DSet.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Types.Unique.DSet ( isEmptyUniqDSet, lookupUniqDSet, uniqDSetToList, + uniqDSetToAscList, partitionUniqDSet, mapUniqDSet ) where @@ -43,8 +44,11 @@ import GHC.Types.Unique.DFM import GHC.Types.Unique.Set import GHC.Types.Unique +import GHC.Utils.Binary + import Data.Coerce import Data.Data +import Data.List (sort) -- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here. -- Beyond preserving invariants, we may also want to 'override' typeclass @@ -120,6 +124,9 @@ lookupUniqDSet = lookupUDFM . getUniqDSet uniqDSetToList :: UniqDSet a -> [a] uniqDSetToList = eltsUDFM . getUniqDSet +uniqDSetToAscList :: Ord a => UniqDSet a -> [a] +uniqDSetToAscList = sort . uniqDSetToList + partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a) partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet @@ -140,3 +147,7 @@ instance Outputable a => Outputable (UniqDSet a) where pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList + +instance (Uniquable a, Binary a, Ord a) => Binary (UniqDSet a) where + put_ bh = put_ bh . uniqDSetToAscList + get bh = mkUniqDSet <$> get bh ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -81,6 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.Session import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) +import GHC.Types.Unique.DSet import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -339,8 +340,8 @@ unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env) unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env -unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey -unitEnv_keys env = Map.keysSet (unitEnv_graph env) +unitEnv_keys :: UnitEnvGraph v -> UnitIdSet +unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) @@ -443,7 +444,7 @@ ue_unitHomeUnit_maybe uid ue_env = ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env -ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId +ue_all_home_unit_ids :: UnitEnv -> UnitIdSet ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph -- ------------------------------------------------------- -- Query and modify the currently active unit ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -28,6 +28,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -53,13 +54,13 @@ data Dependencies = Deps -- ^ All home-package modules which are directly imported by this one. -- This may include modules from other units when using multiple home units - , dep_direct_pkgs :: Set UnitId + , dep_direct_pkgs :: UnitIdSet -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. -- Does not include other home units when using multiple home units. -- Modules from these units will go in `dep_direct_mods` - , dep_plugin_pkgs :: Set UnitId + , dep_plugin_pkgs :: UnitIdSet -- ^ All units needed for plugins ------------------------------------ @@ -69,7 +70,7 @@ data Dependencies = Deps -- ^ Transitive closure of hsig files in the home package - , dep_trusted_pkgs :: Set UnitId + , dep_trusted_pkgs :: UnitIdSet -- Packages which we are required to trust -- when the module is imported as a safe import -- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names @@ -110,7 +111,7 @@ data Dependencies = Deps mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods - plugin_units = Set.fromList (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -197,12 +198,12 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps - { dep_direct_mods = Set.empty - , dep_direct_pkgs = Set.empty - , dep_plugin_pkgs = Set.empty + { dep_direct_mods = mempty + , dep_direct_pkgs = emptyUniqDSet + , dep_plugin_pkgs = emptyUniqDSet , dep_sig_mods = [] - , dep_boot_mods = Set.empty - , dep_trusted_pkgs = Set.empty + , dep_boot_mods = mempty + , dep_trusted_pkgs = emptyUniqDSet , dep_orphs = [] , dep_finsts = [] } @@ -220,11 +221,11 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods = pprWithUnitState unit_state $ vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods, text "boot module dependencies:" <+> ppr_set ppr bmods, - text "direct package dependencies:" <+> ppr_set ppr pkgs, - text "plugin package dependencies:" <+> ppr_set ppr plgns, - if null tps + text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, + text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, + if isEmptyUniqDSet tps then empty - else text "trusted package dependencies:" <+> ppr_set ppr tps, + else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), text "family instance modules:" <+> fsep (map ppr finsts) ] @@ -235,6 +236,9 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc ppr_set w = fsep . fmap w . Set.toAscList + ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc + ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance -- @@ -491,7 +495,7 @@ data ImportAvails imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot, -- ^ Home-package modules directly imported by the module being compiled. - imp_dep_direct_pkgs :: Set UnitId, + imp_dep_direct_pkgs :: UnitIdSet, -- ^ Packages directly needed by the module being compiled imp_trust_own_pkg :: Bool, @@ -502,7 +506,7 @@ data ImportAvails -- Transitive information below here - imp_trust_pkgs :: Set UnitId, + imp_trust_pkgs :: UnitIdSet, -- ^ This records the -- packages the current module needs to trust for Safe Haskell -- compilation to succeed. A package is required to be trusted if ===================================== compiler/GHC/Unit/Module/ModGuts.hs ===================================== @@ -37,8 +37,6 @@ import GHC.Types.SourceFile ( HscSource(..), hscSourceToIsBoot ) import GHC.Types.SrcLoc import GHC.Types.CostCentre -import Data.Set (Set) - -- | A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module @@ -137,7 +135,7 @@ data CgGuts cg_ccs :: [CostCentre], -- List of cost centres used in bindings and rules cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs cg_foreign_files :: ![(ForeignSrcLang, FilePath)], - cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to + cg_dep_pkgs :: !UnitIdSet, -- ^ Dependent packages, used to -- generate #includes for C code gen cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -346,10 +346,10 @@ data UnitConfig = UnitConfig , unitConfigFlagsIgnored :: [IgnorePackageFlag] -- ^ Ignored units , unitConfigFlagsTrusted :: [TrustFlag] -- ^ Trusted units , unitConfigFlagsPlugins :: [PackageFlag] -- ^ Plugins exposed units - , unitConfigHomeUnits :: Set.Set UnitId + , unitConfigHomeUnits :: UnitIdSet } -initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig +initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> UnitConfig initUnitConfig dflags cached_dbs home_units = let !hu_id = homeUnitId_ dflags !hu_instanceof = homeUnitInstanceOf_ dflags @@ -626,7 +626,7 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) +initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) initUnits logger dflags cached_dbs home_units = do let forceUnitInfoMap (state, _) = unitInfoMap state `seq` () @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (Set.toList override_set) $ \pkg -> + forM_ (uniqDSetToList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1374,9 +1374,9 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- The set of UnitIds which appear in both db and pkgs. These are the -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 - override_set :: Set UnitId - override_set = Set.intersection (nonDetUniqMapToKeySet db_map) - (nonDetUniqMapToKeySet pkg_map) + override_set :: UnitIdSet + override_set = intersectUniqDSets (mkUniqDSet $ nonDetKeysUniqMap db_map) + (mkUniqDSet $ nonDetKeysUniqMap pkg_map) -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1688,7 +1688,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = Set.toList home_unit_deps + , homeUnitDepends = uniqDSetToList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,15 +1701,15 @@ mkUnitState logger cfg = do } return (state, raw_dbs) -selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True +selectHptFlag :: UnitIdSet -> PackageFlag -> Bool +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True selectHptFlag _ _ = False -selectHomeUnits :: Set.Set UnitId -> [PackageFlag] -> Set.Set UnitId -selectHomeUnits home_units flags = foldl' go Set.empty flags +selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet +selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags where - go :: Set.Set UnitId -> PackageFlag -> Set.Set UnitId - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = Set.insert (toUnitId uid) cur + go :: UnitIdSet -> PackageFlag -> UnitIdSet + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Unit.Types , GenInstantiatedUnit (..) , InstantiatedUnit , DefUnitId + , UnitIdSet , Instantiations , GenInstantiations , mkInstantiatedUnit @@ -538,6 +539,8 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId +type UnitIdSet = UniqDSet UnitId + unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS ===================================== ghc/GHCi/UI.hs ===================================== @@ -105,6 +105,7 @@ import GHC.Utils.Misc import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Bag (unitBag) import qualified GHC.Data.Strict as Strict +import GHC.Types.Unique.DSet -- Haskell Libraries import System.Console.Haskeline as Haskeline @@ -125,7 +126,6 @@ import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) import Data.List ( elemIndices, find, intercalate, intersperse, minimumBy, isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) ) import qualified Data.List.NonEmpty as NE -import qualified Data.Set as S import Data.Maybe import qualified Data.Map as M import Data.IntMap.Strict (IntMap) @@ -561,7 +561,7 @@ interactiveUI config srcs maybe_exprs = do -- Set to True because Prelude is implicitly imported. impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession - let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 + let in_multi = sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 empty_cache <- liftIO newIfaceCache startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, @@ -2568,15 +2568,15 @@ isSafeModule m = do -- print info to user... liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")" liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off") - when (not $ S.null good) + when (not $ isEmptyUniqDSet good) (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++ - (intercalate ", " $ map (showPpr dflags) (S.toList good))) - case msafe && S.null bad of + (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good))) + case msafe && isEmptyUniqDSet bad of True -> liftIO $ putStrLn $ mname ++ " is trusted!" False -> do - when (not $ null bad) + when (not $ isEmptyUniqDSet bad) (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): " - ++ (intercalate ", " $ map (showPpr dflags) (S.toList bad))) + ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad))) liftIO $ putStrLn $ mname ++ " is NOT trusted!" where @@ -2586,8 +2586,8 @@ isSafeModule m = do | isHomeModule (hsc_home_unit hsc_env) md = True | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) - tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty) - | otherwise = S.partition part deps + tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet) + | otherwise = partitionUniqDSet part deps where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df356143037d434abca9118e6ebb47a443069dee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df356143037d434abca9118e6ebb47a443069dee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 3 15:46:37 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Wed, 03 May 2023 11:46:37 -0400 Subject: [Git][ghc/ghc][wip/supersven/aarch64_stackFrameSize] 51 commits: Show an error when we cannot default a concrete tyvar Message-ID: <645281ddf2293_3c91151dfe08cc3700f7@gitlab.mail> Sven Tennie pushed to branch wip/supersven/aarch64_stackFrameSize at Glasgow Haskell Compiler / GHC Commits: 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - ce03892e by Sven Tennie at 2023-05-03T15:46:32+00:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d192e9413544f45d164e896b2f736f65f3de965...ce03892ec20c695313d852794ae21627b4764754 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d192e9413544f45d164e896b2f736f65f3de965...ce03892ec20c695313d852794ae21627b4764754 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 00:16:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 May 2023 20:16:46 -0400 Subject: [Git][ghc/ghc][master] Add sized primitive literal syntax Message-ID: <6452f96ebb97b_e3e0651e784172b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - 26 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - docs/users_guide/9.8.1-notes.rst - + docs/users_guide/exts/extended_literals.rst - docs/users_guide/exts/literals.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/stolen_syntax.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/extendedliterals/all.T - + testsuite/tests/extendedliterals/extendedliterals01.hs - + testsuite/tests/extendedliterals/extendedliterals02.hs - + testsuite/tests/extendedliterals/extendedliterals03.hs - + testsuite/tests/extendedliterals/extendedliterals03.stdout - − testsuite/tests/ghci/should_run/SizedLiterals.hs - − testsuite/tests/ghci/should_run/SizedLiteralsA.hs - testsuite/tests/ghci/should_run/all.T - testsuite/tests/printer/Ppr038.hs - utils/check-exact/ExactPrint.hs - utils/haddock Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3758,6 +3758,7 @@ xFlagsDeps = [ flagSpec "ExplicitForAll" LangExt.ExplicitForAll, flagSpec "ExplicitNamespaces" LangExt.ExplicitNamespaces, flagSpec "ExtendedDefaultRules" LangExt.ExtendedDefaultRules, + flagSpec "ExtendedLiterals" LangExt.ExtendedLiterals, flagSpec "FlexibleContexts" LangExt.FlexibleContexts, flagSpec "FlexibleInstances" LangExt.FlexibleInstances, flagSpec "ForeignFunctionInterface" LangExt.ForeignFunctionInterface, ===================================== compiler/GHC/Hs/Lit.hs ===================================== @@ -50,7 +50,13 @@ type instance XHsStringPrim (GhcPass _) = SourceText type instance XHsInt (GhcPass _) = NoExtField type instance XHsIntPrim (GhcPass _) = SourceText type instance XHsWordPrim (GhcPass _) = SourceText +type instance XHsInt8Prim (GhcPass _) = SourceText +type instance XHsInt16Prim (GhcPass _) = SourceText +type instance XHsInt32Prim (GhcPass _) = SourceText type instance XHsInt64Prim (GhcPass _) = SourceText +type instance XHsWord8Prim (GhcPass _) = SourceText +type instance XHsWord16Prim (GhcPass _) = SourceText +type instance XHsWord32Prim (GhcPass _) = SourceText type instance XHsWord64Prim (GhcPass _) = SourceText type instance XHsInteger (GhcPass _) = SourceText type instance XHsRat (GhcPass _) = NoExtField @@ -128,14 +134,20 @@ hsLitNeedsParens p = go go (HsString {}) = False go (HsStringPrim {}) = False go (HsInt _ x) = p > topPrec && il_neg x - go (HsIntPrim {}) = False - go (HsWordPrim {}) = False - go (HsInt64Prim {}) = False - go (HsWord64Prim {}) = False go (HsInteger _ x _) = p > topPrec && x < 0 go (HsRat _ x _) = p > topPrec && fl_neg x go (HsFloatPrim {}) = False go (HsDoublePrim {}) = False + go (HsIntPrim {}) = False + go (HsInt8Prim {}) = False + go (HsInt16Prim {}) = False + go (HsInt32Prim {}) = False + go (HsInt64Prim {}) = False + go (HsWordPrim {}) = False + go (HsWord8Prim {}) = False + go (HsWord16Prim {}) = False + go (HsWord64Prim {}) = False + go (HsWord32Prim {}) = False go (XLit _) = False -- | Convert a literal from one index type to another @@ -147,7 +159,13 @@ convertLit (HsStringPrim a x) = HsStringPrim a x convertLit (HsInt a x) = HsInt a x convertLit (HsIntPrim a x) = HsIntPrim a x convertLit (HsWordPrim a x) = HsWordPrim a x +convertLit (HsInt8Prim a x) = HsInt8Prim a x +convertLit (HsInt16Prim a x) = HsInt16Prim a x +convertLit (HsInt32Prim a x) = HsInt32Prim a x convertLit (HsInt64Prim a x) = HsInt64Prim a x +convertLit (HsWord8Prim a x) = HsWord8Prim a x +convertLit (HsWord16Prim a x) = HsWord16Prim a x +convertLit (HsWord32Prim a x) = HsWord32Prim a x convertLit (HsWord64Prim a x) = HsWord64Prim a x convertLit (HsInteger a x b) = HsInteger a x b convertLit (HsRat a x b) = HsRat a x b @@ -182,8 +200,14 @@ instance Outputable (HsLit (GhcPass p)) where ppr (HsFloatPrim _ f) = ppr f <> primFloatSuffix ppr (HsDoublePrim _ d) = ppr d <> primDoubleSuffix ppr (HsIntPrim st i) = pprWithSourceText st (pprPrimInt i) - ppr (HsWordPrim st w) = pprWithSourceText st (pprPrimWord w) + ppr (HsInt8Prim st i) = pprWithSourceText st (pprPrimInt8 i) + ppr (HsInt16Prim st i) = pprWithSourceText st (pprPrimInt16 i) + ppr (HsInt32Prim st i) = pprWithSourceText st (pprPrimInt32 i) ppr (HsInt64Prim st i) = pprWithSourceText st (pprPrimInt64 i) + ppr (HsWordPrim st w) = pprWithSourceText st (pprPrimWord w) + ppr (HsWord8Prim st w) = pprWithSourceText st (pprPrimWord8 w) + ppr (HsWord16Prim st w) = pprWithSourceText st (pprPrimWord16 w) + ppr (HsWord32Prim st w) = pprWithSourceText st (pprPrimWord32 w) ppr (HsWord64Prim st w) = pprWithSourceText st (pprPrimWord64 w) -- in debug mode, print the expression that it's resolved to, too @@ -211,7 +235,13 @@ pmPprHsLit (HsStringPrim _ s) = pprHsBytes s pmPprHsLit (HsInt _ i) = integer (il_value i) pmPprHsLit (HsIntPrim _ i) = integer i pmPprHsLit (HsWordPrim _ w) = integer w +pmPprHsLit (HsInt8Prim _ i) = integer i +pmPprHsLit (HsInt16Prim _ i) = integer i +pmPprHsLit (HsInt32Prim _ i) = integer i pmPprHsLit (HsInt64Prim _ i) = integer i +pmPprHsLit (HsWord8Prim _ w) = integer w +pmPprHsLit (HsWord16Prim _ w) = integer w +pmPprHsLit (HsWord32Prim _ w) = integer w pmPprHsLit (HsWord64Prim _ w) = integer w pmPprHsLit (HsInteger _ i _) = integer i pmPprHsLit (HsRat _ f _) = ppr f ===================================== compiler/GHC/Hs/Syn/Type.hs ===================================== @@ -77,7 +77,13 @@ hsLitType (HsStringPrim _ _) = addrPrimTy hsLitType (HsInt _ _) = intTy hsLitType (HsIntPrim _ _) = intPrimTy hsLitType (HsWordPrim _ _) = wordPrimTy +hsLitType (HsInt8Prim _ _) = int8PrimTy +hsLitType (HsInt16Prim _ _) = int16PrimTy +hsLitType (HsInt32Prim _ _) = int32PrimTy hsLitType (HsInt64Prim _ _) = int64PrimTy +hsLitType (HsWord8Prim _ _) = word8PrimTy +hsLitType (HsWord16Prim _ _) = word16PrimTy +hsLitType (HsWord32Prim _ _) = word32PrimTy hsLitType (HsWord64Prim _ _) = word64PrimTy hsLitType (HsInteger _ _ ty) = ty hsLitType (HsRat _ _ ty) = ty ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -106,7 +106,13 @@ dsLit l = do HsCharPrim _ c -> return (Lit (LitChar c)) HsIntPrim _ i -> return (Lit (mkLitIntWrap platform i)) HsWordPrim _ w -> return (Lit (mkLitWordWrap platform w)) + HsInt8Prim _ i -> return (Lit (mkLitInt8Wrap i)) + HsInt16Prim _ i -> return (Lit (mkLitInt16Wrap i)) + HsInt32Prim _ i -> return (Lit (mkLitInt32Wrap i)) HsInt64Prim _ i -> return (Lit (mkLitInt64Wrap i)) + HsWord8Prim _ w -> return (Lit (mkLitWord8Wrap w)) + HsWord16Prim _ w -> return (Lit (mkLitWord16Wrap w)) + HsWord32Prim _ w -> return (Lit (mkLitWord32Wrap w)) HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap w)) -- This can be slow for very large literals. See Note [FractionalLit representation] @@ -455,10 +461,23 @@ getSimpleIntegralLit :: HsLit GhcTc -> Maybe (Integer, Type) getSimpleIntegralLit (HsInt _ IL{ il_value = i }) = Just (i, intTy) getSimpleIntegralLit (HsIntPrim _ i) = Just (i, intPrimTy) getSimpleIntegralLit (HsWordPrim _ i) = Just (i, wordPrimTy) +getSimpleIntegralLit (HsInt8Prim _ i) = Just (i, int8PrimTy) +getSimpleIntegralLit (HsInt16Prim _ i) = Just (i, int16PrimTy) +getSimpleIntegralLit (HsInt32Prim _ i) = Just (i, int32PrimTy) getSimpleIntegralLit (HsInt64Prim _ i) = Just (i, int64PrimTy) +getSimpleIntegralLit (HsWord8Prim _ i) = Just (i, word8PrimTy) +getSimpleIntegralLit (HsWord16Prim _ i) = Just (i, word16PrimTy) +getSimpleIntegralLit (HsWord32Prim _ i) = Just (i, word32PrimTy) getSimpleIntegralLit (HsWord64Prim _ i) = Just (i, word64PrimTy) getSimpleIntegralLit (HsInteger _ i ty) = Just (i, ty) -getSimpleIntegralLit _ = Nothing + +getSimpleIntegralLit HsChar{} = Nothing +getSimpleIntegralLit HsCharPrim{} = Nothing +getSimpleIntegralLit HsString{} = Nothing +getSimpleIntegralLit HsStringPrim{} = Nothing +getSimpleIntegralLit HsRat{} = Nothing +getSimpleIntegralLit HsFloatPrim{} = Nothing +getSimpleIntegralLit HsDoublePrim{} = Nothing -- | Extract the Char if the expression is a Char literal. getLHsCharLit :: LHsExpr GhcTc -> Maybe Char @@ -638,7 +657,13 @@ hsLitKey :: Platform -> HsLit GhcTc -> Literal -- HsLit does not. hsLitKey platform (HsIntPrim _ i) = mkLitIntWrap platform i hsLitKey platform (HsWordPrim _ w) = mkLitWordWrap platform w +hsLitKey _ (HsInt8Prim _ i) = mkLitInt8Wrap i +hsLitKey _ (HsInt16Prim _ i) = mkLitInt16Wrap i +hsLitKey _ (HsInt32Prim _ i) = mkLitInt32Wrap i hsLitKey _ (HsInt64Prim _ i) = mkLitInt64Wrap i +hsLitKey _ (HsWord8Prim _ w) = mkLitWord8Wrap w +hsLitKey _ (HsWord16Prim _ w) = mkLitWord16Wrap w +hsLitKey _ (HsWord32Prim _ w) = mkLitWord32Wrap w hsLitKey _ (HsWord64Prim _ w) = mkLitWord64Wrap w hsLitKey _ (HsCharPrim _ c) = mkLitChar c -- This following two can be slow. See Note [FractionalLit representation] ===================================== compiler/GHC/Parser.y ===================================== @@ -718,6 +718,14 @@ are the most common patterns, rewritten as regular expressions for clarity: PRIMSTRING { L _ (ITprimstring _ _) } PRIMINTEGER { L _ (ITprimint _ _) } PRIMWORD { L _ (ITprimword _ _) } + PRIMINTEGER8 { L _ (ITprimint8 _ _) } + PRIMINTEGER16 { L _ (ITprimint16 _ _) } + PRIMINTEGER32 { L _ (ITprimint32 _ _) } + PRIMINTEGER64 { L _ (ITprimint64 _ _) } + PRIMWORD8 { L _ (ITprimword8 _ _) } + PRIMWORD16 { L _ (ITprimword16 _ _) } + PRIMWORD32 { L _ (ITprimword32 _ _) } + PRIMWORD64 { L _ (ITprimword64 _ _) } PRIMFLOAT { L _ (ITprimfloat _) } PRIMDOUBLE { L _ (ITprimdouble _) } @@ -3873,6 +3881,22 @@ literal :: { Located (HsLit GhcPs) } $ getPRIMINTEGER $1 } | PRIMWORD { sL1 $1 $ HsWordPrim (getPRIMWORDs $1) $ getPRIMWORD $1 } + | PRIMINTEGER8 { sL1 $1 $ HsInt8Prim (getPRIMINTEGER8s $1) + $ getPRIMINTEGER8 $1 } + | PRIMINTEGER16 { sL1 $1 $ HsInt16Prim (getPRIMINTEGER16s $1) + $ getPRIMINTEGER16 $1 } + | PRIMINTEGER32 { sL1 $1 $ HsInt32Prim (getPRIMINTEGER32s $1) + $ getPRIMINTEGER32 $1 } + | PRIMINTEGER64 { sL1 $1 $ HsInt64Prim (getPRIMINTEGER64s $1) + $ getPRIMINTEGER64 $1 } + | PRIMWORD8 { sL1 $1 $ HsWord8Prim (getPRIMWORD8s $1) + $ getPRIMWORD8 $1 } + | PRIMWORD16 { sL1 $1 $ HsWord16Prim (getPRIMWORD16s $1) + $ getPRIMWORD16 $1 } + | PRIMWORD32 { sL1 $1 $ HsWord32Prim (getPRIMWORD32s $1) + $ getPRIMWORD32 $1 } + | PRIMWORD64 { sL1 $1 $ HsWord64Prim (getPRIMWORD64s $1) + $ getPRIMWORD64 $1 } | PRIMCHAR { sL1 $1 $ HsCharPrim (getPRIMCHARs $1) $ getPRIMCHAR $1 } | PRIMSTRING { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1) @@ -3913,43 +3937,59 @@ bars :: { ([SrcSpan],Int) } -- One or more bars happyError :: P a happyError = srcParseFail -getVARID (L _ (ITvarid x)) = x -getCONID (L _ (ITconid x)) = x -getVARSYM (L _ (ITvarsym x)) = x -getCONSYM (L _ (ITconsym x)) = x -getDO (L _ (ITdo x)) = x -getMDO (L _ (ITmdo x)) = x -getQVARID (L _ (ITqvarid x)) = x -getQCONID (L _ (ITqconid x)) = x -getQVARSYM (L _ (ITqvarsym x)) = x -getQCONSYM (L _ (ITqconsym x)) = x -getIPDUPVARID (L _ (ITdupipvarid x)) = x -getLABELVARID (L _ (ITlabelvarid _ x)) = x -getCHAR (L _ (ITchar _ x)) = x -getSTRING (L _ (ITstring _ x)) = x -getINTEGER (L _ (ITinteger x)) = x -getRATIONAL (L _ (ITrational x)) = x -getPRIMCHAR (L _ (ITprimchar _ x)) = x -getPRIMSTRING (L _ (ITprimstring _ x)) = x -getPRIMINTEGER (L _ (ITprimint _ x)) = x -getPRIMWORD (L _ (ITprimword _ x)) = x -getPRIMFLOAT (L _ (ITprimfloat x)) = x -getPRIMDOUBLE (L _ (ITprimdouble x)) = x -getINLINE (L _ (ITinline_prag _ inl conl)) = (inl,conl) -getSPEC_INLINE (L _ (ITspec_inline_prag src True)) = (Inline src,FunLike) -getSPEC_INLINE (L _ (ITspec_inline_prag src False)) = (NoInline src,FunLike) +getVARID (L _ (ITvarid x)) = x +getCONID (L _ (ITconid x)) = x +getVARSYM (L _ (ITvarsym x)) = x +getCONSYM (L _ (ITconsym x)) = x +getDO (L _ (ITdo x)) = x +getMDO (L _ (ITmdo x)) = x +getQVARID (L _ (ITqvarid x)) = x +getQCONID (L _ (ITqconid x)) = x +getQVARSYM (L _ (ITqvarsym x)) = x +getQCONSYM (L _ (ITqconsym x)) = x +getIPDUPVARID (L _ (ITdupipvarid x)) = x +getLABELVARID (L _ (ITlabelvarid _ x)) = x +getCHAR (L _ (ITchar _ x)) = x +getSTRING (L _ (ITstring _ x)) = x +getINTEGER (L _ (ITinteger x)) = x +getRATIONAL (L _ (ITrational x)) = x +getPRIMCHAR (L _ (ITprimchar _ x)) = x +getPRIMSTRING (L _ (ITprimstring _ x)) = x +getPRIMINTEGER (L _ (ITprimint _ x)) = x +getPRIMWORD (L _ (ITprimword _ x)) = x +getPRIMINTEGER8 (L _ (ITprimint8 _ x)) = x +getPRIMINTEGER16 (L _ (ITprimint16 _ x)) = x +getPRIMINTEGER32 (L _ (ITprimint32 _ x)) = x +getPRIMINTEGER64 (L _ (ITprimint64 _ x)) = x +getPRIMWORD8 (L _ (ITprimword8 _ x)) = x +getPRIMWORD16 (L _ (ITprimword16 _ x)) = x +getPRIMWORD32 (L _ (ITprimword32 _ x)) = x +getPRIMWORD64 (L _ (ITprimword64 _ x)) = x +getPRIMFLOAT (L _ (ITprimfloat x)) = x +getPRIMDOUBLE (L _ (ITprimdouble x)) = x +getINLINE (L _ (ITinline_prag _ inl conl)) = (inl,conl) +getSPEC_INLINE (L _ (ITspec_inline_prag src True)) = (Inline src,FunLike) +getSPEC_INLINE (L _ (ITspec_inline_prag src False)) = (NoInline src,FunLike) getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x -getVOCURLY (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l - -getINTEGERs (L _ (ITinteger (IL src _ _))) = src -getCHARs (L _ (ITchar src _)) = src -getSTRINGs (L _ (ITstring src _)) = src -getPRIMCHARs (L _ (ITprimchar src _)) = src -getPRIMSTRINGs (L _ (ITprimstring src _)) = src -getPRIMINTEGERs (L _ (ITprimint src _)) = src -getPRIMWORDs (L _ (ITprimword src _)) = src - -getLABELVARIDs (L _ (ITlabelvarid src _)) = src +getVOCURLY (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l + +getINTEGERs (L _ (ITinteger (IL src _ _))) = src +getCHARs (L _ (ITchar src _)) = src +getSTRINGs (L _ (ITstring src _)) = src +getPRIMCHARs (L _ (ITprimchar src _)) = src +getPRIMSTRINGs (L _ (ITprimstring src _)) = src +getPRIMINTEGERs (L _ (ITprimint src _)) = src +getPRIMWORDs (L _ (ITprimword src _)) = src +getPRIMINTEGER8s (L _ (ITprimint8 src _)) = src +getPRIMINTEGER16s (L _ (ITprimint16 src _)) = src +getPRIMINTEGER32s (L _ (ITprimint32 src _)) = src +getPRIMINTEGER64s (L _ (ITprimint64 src _)) = src +getPRIMWORD8s (L _ (ITprimword8 src _)) = src +getPRIMWORD16s (L _ (ITprimword16 src _)) = src +getPRIMWORD32s (L _ (ITprimword32 src _)) = src +getPRIMWORD64s (L _ (ITprimword64 src _)) = src + +getLABELVARIDs (L _ (ITlabelvarid src _)) = src -- See Note [Pragma source text] in "GHC.Types.SourceText" for the following getINLINE_PRAGs (L _ (ITinline_prag _ inl _)) = inlineSpecSource inl ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -194,6 +194,10 @@ $docsym = [\| \^ \* \$] @exponent = @numspc [eE] [\-\+]? @decimal @bin_exponent = @numspc [pP] [\-\+]? @decimal + at binarylit = 0[bB] @numspc @binary + at octallit = 0[oO] @numspc @octal + at hexadecimallit = 0[xX] @numspc @hexadecimal + @qual = (@conid \.)+ @qvarid = @qual @varid @qconid = @qual @conid @@ -517,15 +521,15 @@ $unigraphic / { isSmartQuote } { smart_quote_error } -- <0> { -- Normal integral literals (:: Num a => a, from Integer) - @decimal { tok_num positive 0 0 decimal } - 0[bB] @numspc @binary / { ifExtension BinaryLiteralsBit } { tok_num positive 2 2 binary } - 0[oO] @numspc @octal { tok_num positive 2 2 octal } - 0[xX] @numspc @hexadecimal { tok_num positive 2 2 hexadecimal } - @negative @decimal / { negLitPred } { tok_num negative 1 1 decimal } - @negative 0[bB] @numspc @binary / { negLitPred `alexAndPred` - ifExtension BinaryLiteralsBit } { tok_num negative 3 3 binary } - @negative 0[oO] @numspc @octal / { negLitPred } { tok_num negative 3 3 octal } - @negative 0[xX] @numspc @hexadecimal / { negLitPred } { tok_num negative 3 3 hexadecimal } + @decimal { tok_num positive 0 0 decimal } + @binarylit / { ifExtension BinaryLiteralsBit } { tok_num positive 2 2 binary } + @octallit { tok_num positive 2 2 octal } + @hexadecimallit { tok_num positive 2 2 hexadecimal } + @negative @decimal / { negLitPred } { tok_num negative 1 1 decimal } + @negative @binarylit / { negLitPred `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_num negative 3 3 binary } + @negative @octallit / { negLitPred } { tok_num negative 3 3 octal } + @negative @hexadecimallit / { negLitPred } { tok_num negative 3 3 hexadecimal } -- Normal rational literals (:: Fractional a => a, from Rational) @floating_point { tok_frac 0 tok_float } @@ -540,31 +544,116 @@ $unigraphic / { isSmartQuote } { smart_quote_error } -- Unboxed ints (:: Int#) and words (:: Word#) -- It's simpler (and faster?) to give separate cases to the negatives, -- especially considering octal/hexadecimal prefixes. - @decimal \# / { ifExtension MagicHashBit } { tok_primint positive 0 1 decimal } - 0[bB] @numspc @binary \# / { ifExtension MagicHashBit `alexAndPred` - ifExtension BinaryLiteralsBit } { tok_primint positive 2 3 binary } - 0[oO] @numspc @octal \# / { ifExtension MagicHashBit } { tok_primint positive 2 3 octal } - 0[xX] @numspc @hexadecimal \# / { ifExtension MagicHashBit } { tok_primint positive 2 3 hexadecimal } - @negative @decimal \# / { negHashLitPred } { tok_primint negative 1 2 decimal } - @negative 0[bB] @numspc @binary \# / { negHashLitPred `alexAndPred` - ifExtension BinaryLiteralsBit } { tok_primint negative 3 4 binary } - @negative 0[oO] @numspc @octal \# / { negHashLitPred } { tok_primint negative 3 4 octal } - @negative 0[xX] @numspc @hexadecimal \# - / { negHashLitPred } { tok_primint negative 3 4 hexadecimal } - - @decimal \# \# / { ifExtension MagicHashBit } { tok_primword 0 2 decimal } - 0[bB] @numspc @binary \# \# / { ifExtension MagicHashBit `alexAndPred` - ifExtension BinaryLiteralsBit } { tok_primword 2 4 binary } - 0[oO] @numspc @octal \# \# / { ifExtension MagicHashBit } { tok_primword 2 4 octal } - 0[xX] @numspc @hexadecimal \# \# / { ifExtension MagicHashBit } { tok_primword 2 4 hexadecimal } + @decimal \# / { ifExtension MagicHashBit } { tok_primint positive 0 1 decimal } + @binarylit \# / { ifExtension MagicHashBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint positive 2 3 binary } + @octallit \# / { ifExtension MagicHashBit } { tok_primint positive 2 3 octal } + @hexadecimallit \# / { ifExtension MagicHashBit } { tok_primint positive 2 3 hexadecimal } + @negative @decimal \# / { negHashLitPred MagicHashBit } { tok_primint negative 1 2 decimal } + @negative @binarylit \# / { negHashLitPred MagicHashBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint negative 3 4 binary } + @negative @octallit \# / { negHashLitPred MagicHashBit } { tok_primint negative 3 4 octal } + @negative @hexadecimallit \# / { negHashLitPred MagicHashBit } { tok_primint negative 3 4 hexadecimal } + + @decimal \# \# / { ifExtension MagicHashBit } { tok_primword 0 2 decimal } + @binarylit \# \# / { ifExtension MagicHashBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primword 2 4 binary } + @octallit \# \# / { ifExtension MagicHashBit } { tok_primword 2 4 octal } + @hexadecimallit \# \# / { ifExtension MagicHashBit } { tok_primword 2 4 hexadecimal } -- Unboxed floats and doubles (:: Float#, :: Double#) -- prim_{float,double} work with signed literals @floating_point \# / { ifExtension MagicHashBit } { tok_frac 1 tok_primfloat } @floating_point \# \# / { ifExtension MagicHashBit } { tok_frac 2 tok_primdouble } - @negative @floating_point \# / { negHashLitPred } { tok_frac 1 tok_primfloat } - @negative @floating_point \# \# / { negHashLitPred } { tok_frac 2 tok_primdouble } + @negative @floating_point \# / { negHashLitPred MagicHashBit } { tok_frac 1 tok_primfloat } + @negative @floating_point \# \# / { negHashLitPred MagicHashBit } { tok_frac 2 tok_primdouble } + + @decimal \#"Int8" / { ifExtension ExtendedLiteralsBit } { tok_primint8 positive 0 decimal } + @binarylit \#"Int8" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint8 positive 2 binary } + @octallit \#"Int8" / { ifExtension ExtendedLiteralsBit } { tok_primint8 positive 2 octal } + @hexadecimallit \#"Int8" / { ifExtension ExtendedLiteralsBit } { tok_primint8 positive 2 hexadecimal } + @negative @decimal \#"Int8" / { negHashLitPred ExtendedLiteralsBit } { tok_primint8 negative 1 decimal } + @negative @binarylit \#"Int8" / { negHashLitPred ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint8 negative 3 binary } + @negative @octallit \#"Int8" / { negHashLitPred ExtendedLiteralsBit } { tok_primint8 negative 3 octal } + @negative @hexadecimallit \#"Int8" / { negHashLitPred ExtendedLiteralsBit } { tok_primint8 negative 3 hexadecimal } + + @decimal \#"Int16" / { ifExtension ExtendedLiteralsBit } { tok_primint16 positive 0 decimal } + @binarylit \#"Int16" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint16 positive 2 binary } + @octallit \#"Int16" / { ifExtension ExtendedLiteralsBit } { tok_primint16 positive 2 octal } + @hexadecimallit \#"Int16" / { ifExtension ExtendedLiteralsBit } { tok_primint16 positive 2 hexadecimal } + @negative @decimal \#"Int16" / { negHashLitPred ExtendedLiteralsBit} { tok_primint16 negative 1 decimal } + @negative @binarylit \#"Int16" / { negHashLitPred ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint16 negative 3 binary } + @negative @octallit \#"Int16" / { negHashLitPred ExtendedLiteralsBit} { tok_primint16 negative 3 octal } + @negative @hexadecimallit \#"Int16" / { negHashLitPred ExtendedLiteralsBit} { tok_primint16 negative 3 hexadecimal } + + @decimal \#"Int32" / { ifExtension ExtendedLiteralsBit } { tok_primint32 positive 0 decimal } + @binarylit \#"Int32" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint32 positive 2 binary } + @octallit \#"Int32" / { ifExtension ExtendedLiteralsBit } { tok_primint32 positive 2 octal } + @hexadecimallit \#"Int32" / { ifExtension ExtendedLiteralsBit } { tok_primint32 positive 2 hexadecimal } + @negative @decimal \#"Int32" / { negHashLitPred ExtendedLiteralsBit } { tok_primint32 negative 1 decimal } + @negative @binarylit \#"Int32" / { negHashLitPred ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint32 negative 3 binary } + @negative @octallit \#"Int32" / { negHashLitPred ExtendedLiteralsBit} { tok_primint32 negative 3 octal } + @negative @hexadecimallit \#"Int32" / { negHashLitPred ExtendedLiteralsBit} { tok_primint32 negative 3 hexadecimal } + + @decimal \#"Int64" / { ifExtension ExtendedLiteralsBit } { tok_primint64 positive 0 decimal } + @binarylit \#"Int64" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint64 positive 2 binary } + @octallit \#"Int64" / { ifExtension ExtendedLiteralsBit } { tok_primint64 positive 2 octal } + @hexadecimallit \#"Int64" / { ifExtension ExtendedLiteralsBit } { tok_primint64 positive 2 hexadecimal } + @negative @decimal \#"Int64" / { negHashLitPred ExtendedLiteralsBit } { tok_primint64 negative 1 decimal } + @negative @binarylit \#"Int64" / { negHashLitPred ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint64 negative 3 binary } + @negative @octallit \#"Int64" / { negHashLitPred ExtendedLiteralsBit } { tok_primint64 negative 3 octal } + @negative @hexadecimallit \#"Int64" / { negHashLitPred ExtendedLiteralsBit } { tok_primint64 negative 3 hexadecimal } + + @decimal \#"Int" / { ifExtension ExtendedLiteralsBit } { tok_primint positive 0 4 decimal } + @binarylit \#"Int" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint positive 2 6 binary } + @octallit \#"Int" / { ifExtension ExtendedLiteralsBit } { tok_primint positive 2 6 octal } + @hexadecimallit \#"Int" / { ifExtension ExtendedLiteralsBit } { tok_primint positive 2 6 hexadecimal } + @negative @decimal \#"Int" / { negHashLitPred ExtendedLiteralsBit } { tok_primint negative 1 5 decimal } + @negative @binarylit \#"Int" / { negHashLitPred ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primint negative 3 7 binary } + @negative @octallit \#"Int" / { negHashLitPred ExtendedLiteralsBit } { tok_primint negative 3 7 octal } + @negative @hexadecimallit \#"Int" / { negHashLitPred ExtendedLiteralsBit } { tok_primint negative 3 7 hexadecimal } + + @decimal \#"Word8" / { ifExtension ExtendedLiteralsBit } { tok_primword8 0 decimal } + @binarylit \#"Word8" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primword8 2 binary } + @octallit \#"Word8" / { ifExtension ExtendedLiteralsBit } { tok_primword8 2 octal } + @hexadecimallit \#"Word8" / { ifExtension ExtendedLiteralsBit } { tok_primword8 2 hexadecimal } + + @decimal \#"Word16" / { ifExtension ExtendedLiteralsBit } { tok_primword16 0 decimal } + @binarylit \#"Word16" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primword16 2 binary } + @octallit \#"Word16" / { ifExtension ExtendedLiteralsBit } { tok_primword16 2 octal } + @hexadecimallit \#"Word16" / { ifExtension ExtendedLiteralsBit } { tok_primword16 2 hexadecimal } + + @decimal \#"Word32" / { ifExtension ExtendedLiteralsBit } { tok_primword32 0 decimal } + @binarylit \#"Word32" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primword32 2 binary } + @octallit \#"Word32" / { ifExtension ExtendedLiteralsBit } { tok_primword32 2 octal } + @hexadecimallit \#"Word32" / { ifExtension ExtendedLiteralsBit } { tok_primword32 2 hexadecimal } + + @decimal \#"Word64" / { ifExtension ExtendedLiteralsBit } { tok_primword64 0 decimal } + @binarylit \#"Word64" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primword64 2 binary } + @octallit \#"Word64" / { ifExtension ExtendedLiteralsBit } { tok_primword64 2 octal } + @hexadecimallit \#"Word64" / { ifExtension ExtendedLiteralsBit } { tok_primword64 2 hexadecimal } + + @decimal \#"Word" / { ifExtension ExtendedLiteralsBit } { tok_primword 0 5 decimal } + @binarylit \#"Word" / { ifExtension ExtendedLiteralsBit `alexAndPred` + ifExtension BinaryLiteralsBit } { tok_primword 2 7 binary } + @octallit \#"Word" / { ifExtension ExtendedLiteralsBit } { tok_primword 2 7 octal } + @hexadecimallit \#"Word" / { ifExtension ExtendedLiteralsBit } { tok_primword 2 7 hexadecimal } + } -- Strings and chars are lexed by hand-written code. The reason is @@ -866,6 +955,14 @@ data Token | ITprimstring SourceText ByteString -- Note [Literal source text] in "GHC.Types.SourceText" | ITprimint SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" | ITprimword SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimint8 SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimint16 SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimint32 SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimint64 SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimword8 SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimword16 SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimword32 SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" + | ITprimword64 SourceText Integer -- Note [Literal source text] in "GHC.Types.SourceText" | ITprimfloat FractionalLit | ITprimdouble FractionalLit @@ -1281,10 +1378,10 @@ negLitPred = alexNotPred precededByClosingToken -- Check if we should parse an unboxed negative literal (e.g. -123#) as a single token. -negHashLitPred :: AlexAccPred ExtsBitmap -negHashLitPred = prefix_minus `alexAndPred` magic_hash +negHashLitPred :: ExtBits -> AlexAccPred ExtsBitmap +negHashLitPred ext = prefix_minus `alexAndPred` magic_hash where - magic_hash = ifExtension MagicHashBit + magic_hash = ifExtension ext -- Either MagicHashBit or ExtendedLiteralsBit prefix_minus = -- Note [prefix_minus in negLitPred and negHashLitPred] alexNotPred precededByClosingToken @@ -1829,6 +1926,40 @@ binary = (2,octDecDigit) octal = (8,octDecDigit) hexadecimal = (16,hexDigit) +-- | Helper for defining @IntX@ primitive literal parsers (specifically for +-- the ExtendedLiterals extension, such as @123#Int8@). +tok_primintX :: (SourceText -> Integer -> Token) + -> Int + -> (Integer -> Integer) + -> Int + -> (Integer, (Char->Int)) -> Action +tok_primintX itint addlen transint transbuf = + tok_integral itint transint transbuf (transbuf+addlen) + +tok_primint8, tok_primint16, tok_primint32, tok_primint64 + :: (Integer -> Integer) + -> Int -> (Integer, (Char->Int)) -> Action +tok_primint8 = tok_primintX ITprimint8 5 +tok_primint16 = tok_primintX ITprimint16 6 +tok_primint32 = tok_primintX ITprimint32 6 +tok_primint64 = tok_primintX ITprimint64 6 + +-- | Helper for defining @WordX@ primitive literal parsers (specifically for +-- the ExtendedLiterals extension, such as @234#Word8@). +tok_primwordX :: (SourceText -> Integer -> Token) + -> Int + -> Int + -> (Integer, (Char->Int)) -> Action +tok_primwordX itint addlen transbuf = + tok_integral itint positive transbuf (transbuf+addlen) + +tok_primword8, tok_primword16, tok_primword32, tok_primword64 + :: Int -> (Integer, (Char->Int)) -> Action +tok_primword8 = tok_primwordX ITprimword8 6 +tok_primword16 = tok_primwordX ITprimword16 7 +tok_primword32 = tok_primwordX ITprimword32 7 +tok_primword64 = tok_primwordX ITprimword64 7 + -- readSignificandExponentPair can understand negative rationals, exponents, everything. tok_frac :: Int -> (String -> Token) -> Action tok_frac drop f span buf len _buf2 = do @@ -2903,6 +3034,7 @@ data ExtBits | NoLexicalNegationBit -- See Note [Why not LexicalNegationBit] | OverloadedRecordDotBit | OverloadedRecordUpdateBit + | ExtendedLiteralsBit -- Flags that are updated once parsing starts | InRulePragBit @@ -2982,6 +3114,7 @@ mkParserOpts extensionFlags diag_opts supported .|. NoLexicalNegationBit `xoptNotBit` LangExt.LexicalNegation -- See Note [Why not LexicalNegationBit] .|. OverloadedRecordDotBit `xoptBit` LangExt.OverloadedRecordDot .|. OverloadedRecordUpdateBit `xoptBit` LangExt.OverloadedRecordUpdate -- Enable testing via 'getBit OverloadedRecordUpdateBit' in the parser (RecordDotSyntax parsing uses that information). + .|. ExtendedLiteralsBit `xoptBit` LangExt.ExtendedLiterals optBits = HaddockBit `setBitIf` isHaddock .|. RawTokenStreamBit `setBitIf` rawTokStream ===================================== compiler/Language/Haskell/Syntax/Extension.hs ===================================== @@ -568,7 +568,13 @@ type family XHsStringPrim x type family XHsInt x type family XHsIntPrim x type family XHsWordPrim x +type family XHsInt8Prim x +type family XHsInt16Prim x +type family XHsInt32Prim x type family XHsInt64Prim x +type family XHsWord8Prim x +type family XHsWord16Prim x +type family XHsWord32Prim x type family XHsWord64Prim x type family XHsInteger x type family XHsRat x ===================================== compiler/Language/Haskell/Syntax/Lit.hs ===================================== @@ -63,8 +63,20 @@ data HsLit x -- ^ literal @Int#@ | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer -- ^ literal @Word#@ + | HsInt8Prim (XHsInt8Prim x) {- SourceText -} Integer + -- ^ literal @Int8#@ + | HsInt16Prim (XHsInt16Prim x) {- SourceText -} Integer + -- ^ literal @Int16#@ + | HsInt32Prim (XHsInt32Prim x) {- SourceText -} Integer + -- ^ literal @Int32#@ | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer -- ^ literal @Int64#@ + | HsWord8Prim (XHsWord8Prim x) {- SourceText -} Integer + -- ^ literal @Word8#@ + | HsWord16Prim (XHsWord16Prim x) {- SourceText -} Integer + -- ^ literal @Word16#@ + | HsWord32Prim (XHsWord32Prim x) {- SourceText -} Integer + -- ^ literal @Word32#@ | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer -- ^ literal @Word64#@ | HsInteger (XHsInteger x) {- SourceText -} Integer Type @@ -149,4 +161,3 @@ instance Ord OverLitVal where compare (HsIsString _ s1) (HsIsString _ s2) = s1 `lexicalCompareFS` s2 compare (HsIsString _ _) (HsIntegral _) = GT compare (HsIsString _ _) (HsFractional _) = GT - ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -6,6 +6,10 @@ Version 9.8.1 Language ~~~~~~~~ +- There is a new extension :extension:`ExtendedLiterals`, which enables + sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. + See the GHC proposal `#451 `_. + Compiler ~~~~~~~~ ===================================== docs/users_guide/exts/extended_literals.rst ===================================== @@ -0,0 +1,47 @@ +.. _extended-literals: + +Sized primitive literal syntax +------------------------------ + +.. extension:: ExtendedLiterals + :shortdesc: Enable numeric literal postfix syntax for unboxed integers. + + :since: 9.8.1 + + Allows defining unboxed numeric primitive values through ``#Type`` suffixes + on numeric literals e.g. ``0xFF#Word8 :: Word8#``. + +The :extension:`MagicHash` extension enables some new literals, including ``3# +:: Int#``, ``3## :: Word#``. This does not extend to all unboxed values. For +example, there is no literal syntax for ``Word8#``: you must write something +such as ``wordToWord8 (3## :: Word#) :: Word8#``. + +:extension:`ExtendedLiterals` enables further syntax for defining primitive +numeric literals. Suffix any Haskell integer lexeme with a hash sign ``#`` +followed by a primitive numeric type (without its hash suffix) to obtain a value +of that type. For example, ``0xFF#Word8 :: Word8#``. There must be no spaces +between the parts of the literal. + +The primitive numeric types allowed are: + +- ``Int8#`` +- ``Int16#`` +- ``Int32#`` +- ``Int64#`` +- ``Int#`` +- ``Word8#`` +- ``Word16#`` +- ``Word32#`` +- ``Word64#`` +- ``Word#`` + +All types permit any nonnegative Haskell integer lexeme, e.g. ``70``, ``0x2A``, +``0o1276``, ``0b1010`` (with :extension:`BinaryLiterals`). The signed ``Int`` +types also permit negative integer lexemes. Defining a literal with a value that +can't fit in its requested type will emit an overflow warning by default, the +same as boxed numeric literals. + +As with :extension:`MagicHash`, this extension does not bring anything into +scope, nor change any semantics. The syntax only applies to numeric literals. +You may want to import ``GHC.Exts`` (see :ref:`primitives`) to refer to the +types of the literals you define. ===================================== docs/users_guide/exts/literals.rst ===================================== @@ -10,6 +10,7 @@ Literals binary_literals hex_float_literals num_decimals + extended_literals numeric_underscores overloaded_strings overloaded_labels ===================================== docs/users_guide/exts/primitives.rst ===================================== @@ -19,6 +19,9 @@ your program, you must first import ``GHC.Exts`` to bring them into scope. Many of them have names ending in ``#``, and to mention such names you need the :extension:`MagicHash` extension. +To enable defining literals for other primitive data types, see the +:extension:`ExtendedLiterals` extension. + The primops make extensive use of `unboxed types <#glasgow-unboxed>`__ and `unboxed tuples <#unboxed-tuples>`__, which we briefly summarise here. ===================================== docs/users_guide/exts/stolen_syntax.rst ===================================== @@ -80,6 +80,9 @@ The following syntax is stolen: ⟨varid⟩, ``#``\ ⟨char⟩, ``#``, ⟨string⟩, ``#``, ⟨integer⟩, ``#``, ⟨float⟩, ``#``, ⟨float⟩, ``##`` Stolen by: :extension:`MagicHash` +⟨integer⟩, ``#(Int|Word)(8|16|32|64)?`` + Stolen by: :extension:`ExtendedLiterals` + ``(#``, ``#)`` Stolen by: :extension:`UnboxedTuples` ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -152,6 +152,7 @@ data Extension | OverloadedRecordDot | OverloadedRecordUpdate | TypeAbstractions + | ExtendedLiterals deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -37,7 +37,8 @@ check title expected got -- See Note [Adding a language extension] in compiler/GHC/Driver/Session.hs. expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = - [ "TypeAbstractions" + [ "TypeAbstractions", + "ExtendedLiterals" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/extendedliterals/all.T ===================================== @@ -0,0 +1,3 @@ +test('extendedliterals01', normal, compile, ['']) +test('extendedliterals02', normal, compile, ['']) +test('extendedliterals03', [extra_ways(['ghci']), js_skip], compile_and_run, ['']) ===================================== testsuite/tests/extendedliterals/extendedliterals01.hs ===================================== @@ -0,0 +1,41 @@ +{-# LANGUAGE MagicHash, ExtendedLiterals #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE UnboxedSums, UnboxedTuples #-} + +-- needed on 32bit +{-# OPTIONS_GHC -fno-warn-overflowed-literals #-} + +module Ex where + +import GHC.Exts +import GHC.Word +import GHC.Int + +-- Precise 'Int8#'/'Int8' range tests +exI8g1, exI8g2, exI8g3 :: Int8 +exI8g1 = I8# 0x00#Int8 +exI8g2 = I8# 0x7F#Int8 +exI8g3 = I8# -0x80#Int8 + +-- Showcase various syntax for equivalent 'Int' terms +exIg1, exIg2, exIg3 :: Int +exIg1 = 0x7FFFFFFFFFFFFFFF +exIg2 = I# 0x7FFFFFFFFFFFFFFF# +exIg3 = I# 0x7FFFFFFFFFFFFFFF#Int + +-- Motivating example: unboxed 'Word8#' parsing +data CEnum = Cons00 | Cons01 | ConsFF deriving Show +parseCEnum :: Word8# -> (# (##) | CEnum #) +parseCEnum = \case 0x00#Word8 -> (# | Cons00 #) + 0x01#Word8 -> (# | Cons01 #) + 0xFF#Word8 -> (# | ConsFF #) + _ -> (# (##) | #) + +w8ToBool# :: Word8# -> Int# +w8ToBool# = \case 0#Word8 -> 0# + _ -> 1# + +i8IsPole# :: Int8# -> Int# +i8IsPole# = \case 0x7F#Int8 -> 1# + -0x80#Int8 -> 1# + _ -> 0# ===================================== testsuite/tests/extendedliterals/extendedliterals02.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, ExtendedLiterals #-} +{-# OPTIONS_GHC -fno-warn-overflowed-literals #-} + +module Ex where + +--import GHC.Exts +import GHC.Int + +-- Overflowed 'Int8#' literals +exI8b1, exI8b2, exI8b3, exI8b4, exI8b5 :: Int8 +exI8b1 = I8# 0x80#Int8 +exI8b2 = I8# -0x81#Int8 +exI8b3 = I8# 0xFF#Int8 +exI8b4 = I8# -0xFF#Int8 +exI8b5 = I8# 0xFFFFFFFFFFFFFFFF#Int8 ===================================== testsuite/tests/extendedliterals/extendedliterals03.hs ===================================== @@ -0,0 +1,260 @@ +{-# LANGUAGE MagicHash, ExtendedLiterals #-} +import GHC.Word +import GHC.Int +import GHC.Exts + +main = do + print (W8# (fibw8 6#Word8), + W16# (fibw16 6#Word16), + W32# (fibw32 6#Word32), + W64# (fibw64 6#Word64)) + print (I8# (fibi8 6#Int8), + I16# (fibi16 6#Int16), + I32# (fibi32 6#Int32), + I64# (fibi64 6#Int64)) + + print (W64# 0xFFFFFFFFFFFFFFFF#Word64) + print (I64# 0x7FFFFFFFFFFFFFFF#Int64) + print (I64# -0x8000000000000000#Int64) + print (W64# (x () `timesWord64#` y ())) + print (case x () `timesWord64#` y () of + 276447232#Word64 -> False + 276447233#Word64 -> False + 276447234#Word64 -> False + 276047234#Word64 -> False + 5000000004#Word64 -> False + 100000000000000#Word64 -> True + _ -> False) + print (case x () `timesWord64#` y () of + 276447232#Word64 -> True + _ -> False) + + print [ W8# (branchi8 0#Int8) + , W8# (branchi8 1#Int8) + , W8# (branchi8 -1#Int8) + , W8# (branchi8 126#Int8) + , W8# (branchi8 127#Int8) + , W8# (branchi8 -127#Int8) + , W8# (branchi8 -128#Int8) + , W8# (branchi8 2#Int8) + ] + + print [ W16# (branchi16 0#Int16) + , W16# (branchi16 1#Int16) + , W16# (branchi16 (-1#Int16)) + , W16# (branchi16 32767#Int16) + , W16# (branchi16 32766#Int16) + , W16# (branchi16 (-32768#Int16)) + , W16# (branchi16 (-32767#Int16)) + , W16# (branchi16 2#Int16) + ] + + print [ W32# (branchi32 0#Int32) + , W32# (branchi32 1#Int32) + , W32# (branchi32 (-1#Int32)) + , W32# (branchi32 2147483646#Int32) + , W32# (branchi32 2147483647#Int32) + , W32# (branchi32 (-2147483648#Int32)) + , W32# (branchi32 (-2147483647#Int32)) + , W32# (branchi32 2#Int32) + ] + + print [ W64# (branchi64 0#Int64) + , W64# (branchi64 1#Int64) + , W64# (branchi64 (-1#Int64)) + , W64# (branchi64 2147483647#Int64) + , W64# (branchi64 2147483648#Int64) + , W64# (branchi64 4294967297#Int64) + , W64# (branchi64 (-2147483648#Int64)) + , W64# (branchi64 (-2147483649#Int64)) + , W64# (branchi64 (-4294967295#Int64)) + , W64# (branchi64 9223372036854775807#Int64) + , W64# (branchi64 9223372036854775806#Int64) + , W64# (branchi64 (-9223372036854775808#Int64)) + , W64# (branchi64 (-9223372036854775807#Int64)) + , W64# (branchi64 2#Int64) + ] + + print [ I8# (branchw8 0#Word8) + , I8# (branchw8 1#Word8) + , I8# (branchw8 254#Word8) + , I8# (branchw8 255#Word8) + , I8# (branchw8 2#Word8) + ] + + print [ I16# (branchw16 0#Word16) + , I16# (branchw16 1#Word16) + , I16# (branchw16 255#Word16) + , I16# (branchw16 256#Word16) + , I16# (branchw16 65534#Word16) + , I16# (branchw16 65535#Word16) + , I16# (branchw16 2#Word16) + ] + + print [ I32# (branchw32 0#Word32) + , I32# (branchw32 1#Word32) + , I32# (branchw32 65534#Word32) + , I32# (branchw32 65535#Word32) + , I32# (branchw32 65536#Word32) + , I32# (branchw32 4294967295#Word32) + , I32# (branchw32 4294967294#Word32) + , I32# (branchw32 4294967293#Word32) + , I32# (branchw32 2#Word32) + ] + + print [ I64# (branchw64 0#Word64) + , I64# (branchw64 1#Word64) + , I64# (branchw64 65536#Word64) + , I64# (branchw64 4294967295#Word64) + , I64# (branchw64 4294967296#Word64) + , I64# (branchw64 4294967297#Word64) + , I64# (branchw64 18446744073709551615#Word64) + , I64# (branchw64 18446744073709551614#Word64) + , I64# (branchw64 18446744073709551613#Word64) + , I64# (branchw64 2#Word64) + ] + +fibw8 :: Word8# -> Word8# +fibw8 0#Word8 = 0#Word8 +fibw8 1#Word8 = 1#Word8 +fibw8 n = fibw8 (n `subWord8#` 1#Word8) `plusWord8#` fibw8 (n `subWord8#` 2#Word8) + +fibw16 :: Word16# -> Word16# +fibw16 0#Word16 = 0#Word16 +fibw16 1#Word16 = 1#Word16 +fibw16 n = fibw16 (n `subWord16#` 1#Word16) `plusWord16#` fibw16 (n `subWord16#` 2#Word16) + +fibw32 :: Word32# -> Word32# +fibw32 0#Word32 = 0#Word32 +fibw32 1#Word32 = 1#Word32 +fibw32 n = fibw32 (n `subWord32#` 1#Word32) `plusWord32#` fibw32 (n `subWord32#` 2#Word32) + +fibw64 :: Word64# -> Word64# +fibw64 0#Word64 = 0#Word64 +fibw64 1#Word64 = 1#Word64 +fibw64 n = fibw64 (n `subWord64#` 1#Word64) `plusWord64#` fibw64 (n `subWord64#` 2#Word64) + +-- + +fibi8 :: Int8# -> Int8# +fibi8 0#Int8 = 0#Int8 +fibi8 1#Int8 = 1#Int8 +fibi8 n = fibi8 (n `subInt8#` 1#Int8) `plusInt8#` fibi8 (n `subInt8#` 2#Int8) + +fibi16 :: Int16# -> Int16# +fibi16 0#Int16 = 0#Int16 +fibi16 1#Int16 = 1#Int16 +fibi16 n = fibi16 (n `subInt16#` 1#Int16) `plusInt16#` fibi16 (n `subInt16#` 2#Int16) + +fibi32 :: Int32# -> Int32# +fibi32 0#Int32 = 0#Int32 +fibi32 1#Int32 = 1#Int32 +fibi32 n = fibi32 (n `subInt32#` 1#Int32) `plusInt32#` fibi32 (n `subInt32#` 2#Int32) + +fibi64 :: Int64# -> Int64# +fibi64 0#Int64 = 0#Int64 +fibi64 1#Int64 = 1#Int64 +fibi64 n = fibi64 (n `subInt64#` 1#Int64) `plusInt64#` fibi64 (n `subInt64#` 2#Int64) + +-- + +branchi8 :: Int8# -> Word8# +branchi8 0#Int8 = 1#Word8 +branchi8 1#Int8 = 2#Word8 +branchi8 (-1#Int8) = 3#Word8 +branchi8 126#Int8 = 4#Word8 +branchi8 127#Int8 = 5#Word8 +branchi8 (-127#Int8) = 6#Word8 +branchi8 (-128#Int8) = 7#Word8 +branchi8 _ = 0#Word8 +{-# NOINLINE branchi8 #-} + +branchi16 :: Int16# -> Word16# +branchi16 0#Int16 = 1#Word16 +branchi16 1#Int16 = 2#Word16 +branchi16 (-1#Int16) = 3#Word16 +branchi16 32767#Int16 = 255#Word16 +branchi16 32766#Int16 = 256#Word16 +branchi16 (-32768#Int16) = 65534#Word16 +branchi16 (-32767#Int16) = 65535#Word16 +branchi16 _ = 0#Word16 +{-# NOINLINE branchi16 #-} + +branchi32 :: Int32# -> Word32# +branchi32 0#Int32 = 1#Word32 +branchi32 1#Int32 = 2#Word32 +branchi32 (-1#Int32) = 3#Word32 +branchi32 2147483646#Int32 = 65535#Word32 +branchi32 2147483647#Int32 = 65536#Word32 +branchi32 (-2147483648#Int32) = 4294967294#Word32 +branchi32 (-2147483647#Int32) = 4294967295#Word32 +branchi32 _ = 0#Word32 +{-# NOINLINE branchi32 #-} + +branchi64 :: Int64# -> Word64# +branchi64 0#Int64 = 18446744073709551615#Word64 +branchi64 1#Int64 = 2147483648#Word64 +branchi64 (-1#Int64) = 4294967296#Word64 +branchi64 2147483647#Int64 = 4294967297#Word64 +branchi64 2147483648#Int64 = 9#Word64 +branchi64 4294967297#Int64 = 1#Word64 +branchi64 (-2147483648#Int64) = 18446744073709551614#Word64 +branchi64 (-2147483649#Int64) = 3#Word64 +branchi64 (-4294967295#Int64) = 4#Word64 +branchi64 9223372036854775807#Int64 = 5#Word64 +branchi64 9223372036854775806#Int64 = 6#Word64 +branchi64 (-9223372036854775808#Int64) = 7#Word64 +branchi64 (-9223372036854775807#Int64) = 8#Word64 +branchi64 _ = 0#Word64 +{-# NOINLINE branchi64 #-} + +branchw8 :: Word8# -> Int8# +branchw8 0#Word8 = 1#Int8 +branchw8 1#Word8 = (-1#Int8) +branchw8 254#Word8 = 2#Int8 +branchw8 255#Word8 = (-2#Int8) +branchw8 _ = 0#Int8 +{-# NOINLINE branchw8 #-} + +branchw16 :: Word16# -> Int16# +branchw16 0#Word16 = 256#Int16 +branchw16 1#Word16 = (-256#Int16) +branchw16 255#Word16 = 32767#Int16 +branchw16 256#Word16 = (-32768#Int16) +branchw16 65534#Word16 = (-1#Int16) +branchw16 65535#Word16 = 1#Int16 +branchw16 _ = 0#Int16 +{-# NOINLINE branchw16 #-} + +branchw32 :: Word32# -> Int32# +branchw32 0#Word32 = 2147483647#Int32 +branchw32 1#Word32 = (-2147483648#Int32) +branchw32 65534#Word32 = 65535#Int32 +branchw32 65535#Word32 = 65536#Int32 +branchw32 65536#Word32 = (-1#Int32) +branchw32 4294967295#Word32 = (-65536#Int32) +branchw32 4294967294#Word32 = (-65537#Int32) +branchw32 4294967293#Word32 = 1#Int32 +branchw32 _ = 0#Int32 +{-# NOINLINE branchw32 #-} + +branchw64 :: Word64# -> Int64# +branchw64 0#Word64 = 9223372036854775807#Int64 +branchw64 1#Word64 = 2147483648#Int64 +branchw64 65536#Word64 = 4294967296#Int64 +branchw64 4294967295#Word64 = 4294967297#Int64 +branchw64 4294967296#Word64 = (-1#Int64) +branchw64 4294967297#Word64 = 9223372036854775806#Int64 +branchw64 18446744073709551615#Word64 = (-9223372036854775808#Int64) +branchw64 18446744073709551614#Word64 = (-9223372036854775807#Int64) +branchw64 18446744073709551613#Word64 = 1#Int64 +branchw64 _ = 0#Int64 +{-# NOINLINE branchw64 #-} + +x :: () -> Word64# +x () = 2000000000#Word64 +{-# NOINLINE x #-} + +y :: () -> Word64# +y () = 50000#Word64 +{-# NOINLINE y #-} ===================================== testsuite/tests/extendedliterals/extendedliterals03.stdout ===================================== @@ -0,0 +1,16 @@ +(8,8,8,8) +(8,8,8,8) +18446744073709551615 +9223372036854775807 +-9223372036854775808 +100000000000000 +True +False +[1,2,3,4,5,6,7,0] +[1,2,3,255,256,65534,65535,0] +[1,2,3,65535,65536,4294967294,4294967295,0] +[18446744073709551615,2147483648,4294967296,4294967297,9,1,18446744073709551614,3,4,5,6,7,8,0] +[1,-1,2,-2,0] +[256,-256,32767,-32768,-1,1,0] +[2147483647,-2147483648,65535,65536,-1,-65536,-65537,1,0] +[9223372036854775807,2147483648,4294967296,4294967297,-1,9223372036854775806,-9223372036854775808,-9223372036854775807,1,0] ===================================== testsuite/tests/ghci/should_run/SizedLiterals.hs deleted ===================================== @@ -1,117 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -import SizedLiteralsA -import Language.Haskell.TH - -{- - - This file is compiled with the GHC flags: - - -O -fbyte-code-and-object-code -fprefer-byte-code - - This makes sure that the Template Haskell runs in the bytecode - interpreter with optimized bytecode, allowing us to test the - sized unboxed literals. - - Running the test in GHCi directly would disable optimization. - - -} - -main :: IO () -main = do - print $(pure $ ListE [ ie (fibw8 5) - , ie (fibw16 5) - , ie (fibw32 5) - , ie (fibw64 5) - ]) - - print $(pure $ ListE [ ie (fibi8 5) - , ie (fibi16 5) - , ie (fibi32 5) - , ie (fibi64 5) - ]) - - print $(pure $ ListE [ ie (branchi8 0) - , ie (branchi8 1) - , ie (branchi8 (-1)) - , ie (branchi8 126) - , ie (branchi8 127) - , ie (branchi8 (-127)) - , ie (branchi8 (-128)) - , ie (branchi8 2) - ]) - - print $(pure $ ListE [ ie (branchi16 0) - , ie (branchi16 1) - , ie (branchi16 (-1)) - , ie (branchi16 32767) - , ie (branchi16 32766) - , ie (branchi16 (-32768)) - , ie (branchi16 (-32767)) - , ie (branchi16 2) - ]) - - print $(pure $ ListE [ ie (branchi32 0) - , ie (branchi32 1) - , ie (branchi32 (-1)) - , ie (branchi32 2147483646) - , ie (branchi32 2147483647) - , ie (branchi32 (-2147483648)) - , ie (branchi32 (-2147483647)) - , ie (branchi32 2) - ]) - - print $(pure $ ListE [ ie (branchi64 0) - , ie (branchi64 1) - , ie (branchi64 (-1)) - , ie (branchi64 2147483647) - , ie (branchi64 2147483648) - , ie (branchi64 4294967297) - , ie (branchi64 (-2147483648)) - , ie (branchi64 (-2147483649)) - , ie (branchi64 (-4294967295)) - , ie (branchi64 9223372036854775807) - , ie (branchi64 9223372036854775806) - , ie (branchi64 (-9223372036854775808)) - , ie (branchi64 (-9223372036854775807)) - , ie (branchi64 2) - ]) - - print $(pure $ ListE [ ie (branchw8 0) - , ie (branchw8 1) - , ie (branchw8 254) - , ie (branchw8 255) - , ie (branchw8 2) - ]) - - print $(pure $ ListE [ ie (branchw16 0) - , ie (branchw16 1) - , ie (branchw16 255) - , ie (branchw16 256) - , ie (branchw16 65534) - , ie (branchw16 65535) - , ie (branchw16 2) - ]) - - print $(pure $ ListE [ ie (branchw32 0) - , ie (branchw32 1) - , ie (branchw32 65534) - , ie (branchw32 65535) - , ie (branchw32 65536) - , ie (branchw32 4294967295) - , ie (branchw32 4294967294) - , ie (branchw32 4294967293) - , ie (branchw32 2) - ]) - - print $(pure $ ListE [ ie (branchw64 0) - , ie (branchw64 1) - , ie (branchw64 65536) - , ie (branchw64 4294967295) - , ie (branchw64 4294967296) - , ie (branchw64 4294967297) - , ie (branchw64 18446744073709551615) - , ie (branchw64 18446744073709551614) - , ie (branchw64 18446744073709551613) - , ie (branchw64 2) - ]) \ No newline at end of file ===================================== testsuite/tests/ghci/should_run/SizedLiteralsA.hs deleted ===================================== @@ -1,139 +0,0 @@ -module SizedLiteralsA where - -import GHC.Word -import GHC.Int -import Language.Haskell.TH.Syntax - -fibw8 :: Word8 -> Word8 -fibw8 0 = 0 -fibw8 1 = 1 -fibw8 n = fibw8 (n-1) + fibw8 (n-2) - -fibw16 :: Word16 -> Word16 -fibw16 0 = 0 -fibw16 1 = 1 -fibw16 n = fibw16 (n-1) + fibw16 (n-2) - -fibw32 :: Word32 -> Word32 -fibw32 0 = 0 -fibw32 1 = 1 -fibw32 n = fibw32 (n-1) + fibw32 (n-2) - -fibw64 :: Word64 -> Word64 -fibw64 0 = 0 -fibw64 1 = 1 -fibw64 n = fibw64 (n-1) + fibw64 (n-2) - --- - -fibi8 :: Int8 -> Int8 -fibi8 0 = 0 -fibi8 1 = 1 -fibi8 n = fibi8 (n-1) + fibi8 (n-2) - -fibi16 :: Int16 -> Int16 -fibi16 0 = 0 -fibi16 1 = 1 -fibi16 n = fibi16 (n-1) + fibi16 (n-2) - -fibi32 :: Int32 -> Int32 -fibi32 0 = 0 -fibi32 1 = 1 -fibi32 n = fibi32 (n-1) + fibi32 (n-2) - -fibi64 :: Int64 -> Int64 -fibi64 0 = 0 -fibi64 1 = 1 -fibi64 n = fibi64 (n-1) + fibi64 (n-2) - --- - -branchi8 :: Int8 -> Word8 -branchi8 0 = 1 -branchi8 1 = 2 -branchi8 (-1) = 3 -branchi8 126 = 4 -branchi8 127 = 5 -branchi8 (-127) = 6 -branchi8 (-128) = 7 -branchi8 _ = 0 - -branchi16 :: Int16 -> Word16 -branchi16 0 = 1 -branchi16 1 = 2 -branchi16 (-1) = 3 -branchi16 32767 = 255 -branchi16 32766 = 256 -branchi16 (-32768) = 65534 -branchi16 (-32767) = 65535 -branchi16 _ = 0 - -branchi32 :: Int32 -> Word32 -branchi32 0 = 1 -branchi32 1 = 2 -branchi32 (-1) = 3 -branchi32 2147483646 = 65535 -branchi32 2147483647 = 65536 -branchi32 (-2147483648) = 4294967294 -branchi32 (-2147483647) = 4294967295 -branchi32 _ = 0 - -branchi64 :: Int64 -> Word64 -branchi64 0 = 18446744073709551615 -branchi64 1 = 2147483648 -branchi64 (-1) = 4294967296 -branchi64 2147483647 = 4294967297 -branchi64 2147483648 = 9 -branchi64 4294967297 = 1 -branchi64 (-2147483648) = 18446744073709551614 -branchi64 (-2147483649) = 3 -branchi64 (-4294967295) = 4 -branchi64 9223372036854775807 = 5 -branchi64 9223372036854775806 = 6 -branchi64 (-9223372036854775808) = 7 -branchi64 (-9223372036854775807) = 8 -branchi64 _ = 0 - -branchw8 :: Word8 -> Int8 -branchw8 0 = 1 -branchw8 1 = (-1) -branchw8 254 = 2 -branchw8 255 = (-2) -branchw8 _ = 0 - -branchw16 :: Word16 -> Int16 -branchw16 0 = 256 -branchw16 1 = (-256) -branchw16 255 = 32767 -branchw16 256 = (-32768) -branchw16 65534 = (-1) -branchw16 65535 = 1 -branchw16 _ = 0 - -branchw32 :: Word32 -> Int32 -branchw32 0 = 2147483647 -branchw32 1 = (-2147483648) -branchw32 65534 = 65535 -branchw32 65535 = 65536 -branchw32 65536 = (-1) -branchw32 4294967295 = (-65536) -branchw32 4294967294 = (-65537) -branchw32 4294967293 = 1 -branchw32 _ = 0 - -branchw64 :: Word64 -> Int64 -branchw64 0 = 9223372036854775807 -branchw64 1 = 2147483648 -branchw64 65536 = 4294967296 -branchw64 4294967295 = 4294967297 -branchw64 4294967296 = (-1) -branchw64 4294967297 = 9223372036854775806 -branchw64 18446744073709551615 = (-9223372036854775808) -branchw64 18446744073709551614 = (-9223372036854775807) -branchw64 18446744073709551613 = 1 -branchw64 _ = 0 - --- - -ie :: Integral a => a -> Exp -ie x = LitE (IntegerL (toInteger x)) ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -85,7 +85,6 @@ test('T19628', [extra_files(['T19628a.hs']), only_ways(['ghci']) ], compile_and_ test('T21052', just_ghci, ghci_script, ['T21052.script']) test('T21300', just_ghci, ghci_script, ['T21300.script']) test('UnliftedDataType2', just_ghci, compile_and_run, ['']) -test('SizedLiterals', [req_interp, extra_files(["SizedLiteralsA.hs"]),extra_hc_opts("-O -fbyte-code-and-object-code -fprefer-byte-code")], compile_and_run, ['']) test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], compile_and_run, ['']) test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script']) ===================================== testsuite/tests/printer/Ppr038.hs ===================================== @@ -21,6 +21,14 @@ blah = x wordH = 005## floatH = 3.20# doubleH = 04.16## - -- int64H = 00456L# - -- word64H = 00456L## + intNH = 1000#Int + int8H = 1008#Int8 + int16H = 1016#Int8 + int32H = 1032#Int32 + int64H = 1064#Int64 + wordNH = 2000#Word + word8H = 2008#Word8 + word16H = 2016#Word16 + word32H = 2032#Word32 + word64H = 2064#Word64 x = 1 ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -4695,7 +4695,13 @@ hsLit2String lit = HsInt _ (IL src _ v) -> toSourceTextWithSuffix src v "" HsIntPrim src v -> toSourceTextWithSuffix src v "" HsWordPrim src v -> toSourceTextWithSuffix src v "" + HsInt8Prim src v -> toSourceTextWithSuffix src v "" + HsInt16Prim src v -> toSourceTextWithSuffix src v "" + HsInt32Prim src v -> toSourceTextWithSuffix src v "" HsInt64Prim src v -> toSourceTextWithSuffix src v "" + HsWord8Prim src v -> toSourceTextWithSuffix src v "" + HsWord16Prim src v -> toSourceTextWithSuffix src v "" + HsWord32Prim src v -> toSourceTextWithSuffix src v "" HsWord64Prim src v -> toSourceTextWithSuffix src v "" HsInteger src v _ -> toSourceTextWithSuffix src v "" HsRat _ fl@(FL{fl_text = src }) _ -> toSourceTextWithSuffix src fl "" ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 03ba53ca764f56a13d12607c110f923f129e809a +Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/931c8d82f28fb98a7e0ad0a837eff05c08021cbe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/931c8d82f28fb98a7e0ad0a837eff05c08021cbe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 00:17:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 May 2023 20:17:13 -0400 Subject: [Git][ghc/ghc][master] Document instances of Double Message-ID: <6452f9895a5bd_e3e0651f0445672@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 2 changed files: - libraries/base/GHC/Float.hs - libraries/base/GHC/Real.hs Changes: ===================================== libraries/base/GHC/Float.hs ===================================== @@ -276,17 +276,18 @@ class (RealFrac a, Floating a) => RealFloat a where ------------------------------------------------------------------------ -- | @since 2.01 --- Note that due to the presence of @NaN@, not all elements of 'Float' have an --- additive inverse. -- --- >>> 0/0 + (negate 0/0 :: Float) --- NaN +-- This instance implements IEEE 754 standard with all its usual pitfalls +-- about NaN, infinities and negative zero. +-- Neither addition not multiplication are associative or distributive: -- --- Also note that due to the presence of -0, `Float`'s 'Num' instance doesn't --- have an additive identity +-- >>> (0.1 + 0.1 :: Float) + 0.5 == 0.1 + (0.1 + 0.5) +-- False +-- >>> (0.1 + 0.2 :: Float) * 0.9 == 0.1 * 0.9 + 0.2 * 0.9 +-- False +-- >>> (0.1 * 0.1 :: Float) * 0.9 == 0.1 * (0.1 * 0.9) +-- False -- --- >>> 0 + (-0 :: Float) --- 0.0 instance Num Float where (+) x y = plusFloat x y (-) x y = minusFloat x y @@ -317,6 +318,14 @@ naturalToFloat# (NB b) = case integerToBinaryFloat' (IP b) of F# x -> x -- | @since 2.01 +-- +-- Beware that 'toRational' generates garbage for non-finite arguments: +-- +-- >>> toRational (1/0 :: Float) +-- 340282366920938463463374607431768211456 % 1 +-- >>> toRational (0/0 :: Float) +-- 510423550381407695195061911147652317184 % 1 +-- instance Real Float where toRational (F# x#) = case decodeFloat_Int# x# of @@ -330,14 +339,19 @@ instance Real Float where IS m# :% integerShiftL# 1 (int2Word# (negateInt# e#)) -- | @since 2.01 --- Note that due to the presence of @NaN@, not all elements of 'Float' have an --- multiplicative inverse. -- --- >>> 0/0 * (recip 0/0 :: Float) --- NaN +-- This instance implements IEEE 754 standard with all its usual pitfalls +-- about NaN, infinities and negative zero. +-- +-- >>> 0 == (-0 :: Float) +-- True +-- >>> recip 0 == recip (-0 :: Float) +-- False +-- >>> map (/ 0) [-1, 0, 1 :: Float] +-- [-Infinity,NaN,Infinity] +-- >>> map (* 0) $ map (/ 0) [-1, 0, 1 :: Float] +-- [NaN,NaN,NaN] -- --- Additionally, because of @NaN@ this instance does not obey the left-inverse --- law for 'toRational'/'fromRational'. instance Fractional Float where (/) x y = divideFloat x y {-# INLINE fromRational #-} @@ -360,6 +374,15 @@ rationalToFloat n d mantDigs = FLT_MANT_DIG -- | @since 2.01 +-- +-- Beware that results for non-finite arguments are garbage: +-- +-- >>> [ f x | f <- [round, floor, ceiling], x <- [-1/0, 0/0, 1/0 :: Float] ] :: [Int] +-- [0,0,0,0,0,0,0,0,0] +-- >>> map properFraction [-1/0, 0/0, 1/0] :: [(Int, Float)] +-- [(0,0.0),(0,0.0),(0,0.0)] +-- +-- and get even more non-sensical if you ask for 'Integer' instead of 'Int'. instance RealFrac Float where properFraction = properFractionFloat @@ -507,17 +530,18 @@ instance Show Float where ------------------------------------------------------------------------ -- | @since 2.01 --- Note that due to the presence of @NaN@, not all elements of 'Double' have an --- additive inverse. -- --- >>> 0/0 + (negate 0/0 :: Double) --- NaN +-- This instance implements IEEE 754 standard with all its usual pitfalls +-- about NaN, infinities and negative zero. +-- Neither addition not multiplication are associative or distributive: -- --- Also note that due to the presence of -0, `Double`'s 'Num' instance doesn't --- have an additive identity +-- >>> (0.1 + 0.1) + 0.4 == 0.1 + (0.1 + 0.4) +-- False +-- >>> (0.1 + 0.2) * 0.3 == 0.1 * 0.3 + 0.2 * 0.3 +-- False +-- >>> (0.1 * 0.1) * 0.3 == 0.1 * (0.1 * 0.3) +-- False -- --- >>> 0 + (-0 :: Double) --- 0.0 instance Num Double where (+) x y = plusDouble x y (-) x y = minusDouble x y @@ -550,6 +574,14 @@ naturalToDouble# (NB b) = case integerToBinaryFloat' (IP b) of -- | @since 2.01 +-- +-- Beware that 'toRational' generates garbage for non-finite arguments: +-- +-- >>> toRational (1/0) +-- 179769313 (and 300 more digits...) % 1 +-- >>> toRational (0/0) +-- 269653970 (and 300 more digits...) % 1 +-- instance Real Double where toRational (D# x#) = case integerDecodeDouble# x# of @@ -563,14 +595,19 @@ instance Real Double where m :% integerShiftL# 1 (int2Word# (negateInt# e#)) -- | @since 2.01 --- Note that due to the presence of @NaN@, not all elements of 'Double' have an --- multiplicative inverse. -- --- >>> 0/0 * (recip 0/0 :: Double) --- NaN +-- This instance implements IEEE 754 standard with all its usual pitfalls +-- about NaN, infinities and negative zero. +-- +-- >>> 0 == (-0 :: Double) +-- True +-- >>> recip 0 == recip (-0 :: Double) +-- False +-- >>> map (/ 0) [-1, 0, 1] +-- [-Infinity,NaN,Infinity] +-- >>> map (* 0) $ map (/ 0) [-1, 0, 1] +-- [NaN,NaN,NaN] -- --- Additionally, because of @NaN@ this instance does not obey the left-inverse --- law for 'toRational'/'fromRational'. instance Fractional Double where (/) x y = divideDouble x y {-# INLINE fromRational #-} @@ -626,6 +663,15 @@ instance Floating Double where {-# INLINE log1pexp #-} -- | @since 2.01 +-- +-- Beware that results for non-finite arguments are garbage: +-- +-- >>> [ f x | f <- [round, floor, ceiling], x <- [-1/0, 0/0, 1/0] ] :: [Int] +-- [0,0,0,0,0,0,0,0,0] +-- >>> map properFraction [-1/0, 0/0, 1/0] :: [(Int, Double)] +-- [(0,0.0),(0,0.0),(0,0.0)] +-- +-- and get even more non-sensical if you ask for 'Integer' instead of 'Int'. instance RealFrac Double where properFraction = properFractionDouble truncate = truncateDouble @@ -796,6 +842,14 @@ for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.) -} -- | @since 2.01 +-- +-- 'fromEnum' just truncates its argument, beware of all sorts of overflows. +-- +-- List generators have extremely peculiar behavior, mandated by +-- [Haskell Report 2010](https://www.haskell.org/onlinereport/haskell2010/haskellch6.html#x13-1310006.3.4): +-- +-- >>> [0..1.5 :: Float] +-- [0.0,1.0,2.0] instance Enum Float where succ x = x + 1 pred x = x - 1 @@ -807,6 +861,14 @@ instance Enum Float where enumFromThenTo = numericEnumFromThenTo -- | @since 2.01 +-- +-- 'fromEnum' just truncates its argument, beware of all sorts of overflows. +-- +-- List generators have extremely peculiar behavior, mandated by +-- [Haskell Report 2010](https://www.haskell.org/onlinereport/haskell2010/haskellch6.html#x13-1310006.3.4): +-- +-- >>> [0..1.5] +-- [0.0,1.0,2.0] instance Enum Double where succ x = x + 1 pred x = x - 1 ===================================== libraries/base/GHC/Real.hs ===================================== @@ -142,6 +142,10 @@ denominator (_ :% y) = y -- -- [__Coherence with 'fromRational'__]: if the type also implements 'Fractional', -- then 'fromRational' is a left inverse for 'toRational', i.e. @fromRational (toRational i) = i@ +-- +-- The law does not hold for 'Float', 'Double', 'Foreign.C.Types.CFloat', +-- 'Foreign.C.Types.CDouble', etc., because these types contain non-finite values, +-- which cannot be roundtripped through 'Rational'. class (Num a, Ord a) => Real a where -- | the rational equivalent of its real argument with full precision toRational :: a -> Rational View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f3460845cdd37cf5a086cc02336c35310246b725 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f3460845cdd37cf5a086cc02336c35310246b725 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 00:17:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 May 2023 20:17:53 -0400 Subject: [Git][ghc/ghc][master] Bump Cabal submodule (#22356) Message-ID: <6452f9b130763_e3e0651e6448763@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 1 changed file: - libraries/Cabal Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 280a7a71e495da8f25ae33dbc6e743526b9106f9 +Subproject commit 4bfd6a0352ecfd71e1ca756a007ca827b68416d5 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e9caa1a54e149a71af2555336531425f64521af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e9caa1a54e149a71af2555336531425f64521af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 00:18:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 May 2023 20:18:34 -0400 Subject: [Git][ghc/ghc][master] Don't forget to check the parent in an export list Message-ID: <6452f9dac76e4_e3e062c1c4cc5403c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 4 changed files: - compiler/GHC/Tc/Gen/Export.hs - + testsuite/tests/rename/should_compile/T23318.hs - + testsuite/tests/rename/should_compile/T23318.stderr - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -356,55 +356,51 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod lookup_ie occs ie@(IEThingAll ann n') = do - (n, kids) <- lookup_ie_all ie n' - let name = unLoc n + (par, kids) <- lookup_ie_all ie n' + let name = greName par avails = map greName kids - occs' <- check_occs occs ie kids + occs' <- check_occs occs ie (par:kids) return $ Just ( occs' - , IEThingAll ann (replaceLWrappedName n' (unLoc n)) + , IEThingAll ann (replaceLWrappedName n' name) , AvailTC name (name:avails)) lookup_ie occs ie@(IEThingWith ann l wc sub_rdrs) = do - (lname, subs, with_gres) + (par_gre, subs, with_gres) <- addExportErrCtxt ie $ lookup_ie_with l sub_rdrs - (_, wc_gres) <- + wc_gres <- case wc of - NoIEWildcard -> return (lname, []) - IEWildcard _ -> lookup_ie_all ie l + NoIEWildcard -> return [] + IEWildcard _ -> snd <$> lookup_ie_all ie l - let name = unLoc lname - all_names = name : map greName (with_gres ++ wc_gres) - gres = localVanillaGRE NoParent name - -- localVanillaGRE might not be correct here, - -- but these GREs are only passed to check_occs - -- which only needs the correct Name for the GREs... - : with_gres ++ wc_gres + let par = greName par_gre + all_names = par : map greName (with_gres ++ wc_gres) + gres = par_gre : with_gres ++ wc_gres occs' <- check_occs occs ie gres return $ Just $ ( occs' - , IEThingWith ann (replaceLWrappedName l name) wc subs - , AvailTC name all_names) + , IEThingWith ann (replaceLWrappedName l par) wc subs + , AvailTC par all_names) lookup_ie _ _ = panic "lookup_ie" -- Other cases covered earlier lookup_ie_with :: LIEWrappedName GhcPs -> [LIEWrappedName GhcPs] - -> RnM (Located Name, [LIEWrappedName GhcRn], [GlobalRdrElt]) - lookup_ie_with (L l rdr) sub_rdrs = + -> RnM (GlobalRdrElt, [LIEWrappedName GhcRn], [GlobalRdrElt]) + lookup_ie_with (L _ rdr) sub_rdrs = do { gre <- lookupGlobalOccRn $ ieWrappedName rdr ; let name = greName gre ; kids <- lookupChildrenExport name sub_rdrs ; if isUnboundName name - then return (L (locA l) name, [], [gre]) - else return (L (locA l) name, map fst kids, map snd kids) } + then return (gre, [], [gre]) + else return (gre, map fst kids, map snd kids) } lookup_ie_all :: IE GhcPs -> LIEWrappedName GhcPs - -> RnM (Located Name, [GlobalRdrElt]) - lookup_ie_all ie (L l rdr) = + -> RnM (GlobalRdrElt, [GlobalRdrElt]) + lookup_ie_all ie (L _ rdr) = do { gre <- lookupGlobalOccRn $ ieWrappedName rdr ; let name = greName gre gres = findChildren kids_env name @@ -415,7 +411,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod else -- This occurs when you export T(..), but -- only import T abstractly, or T is a synonym. addErr (TcRnExportHiddenComponents ie) - ; return (L (locA l) name, gres) } + ; return (gre, gres) } ------------- lookup_doc_ie :: IE GhcPs -> RnM (Maybe (IE GhcRn)) @@ -663,8 +659,9 @@ checkPatSynParent parent NoParent gre {-===========================================================================-} --- | Check that the each of the given 'GlobalRdrElt's does not appear multiple --- times in the 'ExportOccMap', as per Note [Exporting duplicate declarations]. +-- | Insert the given 'GlobalRdrElt's into the 'ExportOccMap', checking that +-- each of the given 'GlobalRdrElt's does not appear multiple times in +-- the 'ExportOccMap', as per Note [Exporting duplicate declarations]. check_occs :: ExportOccMap -> IE GhcPs -> [GlobalRdrElt] -> RnM ExportOccMap check_occs occs ie gres -- 'gres' are the entities specified by 'ie' ===================================== testsuite/tests/rename/should_compile/T23318.hs ===================================== @@ -0,0 +1,2 @@ +module T23318 (T(), T(..)) where +data T = A | B ===================================== testsuite/tests/rename/should_compile/T23318.stderr ===================================== @@ -0,0 +1,3 @@ + +T23318.hs:1:21: warning: [GHC-47854] [-Wduplicate-exports (in -Wdefault)] + ‘T’ is exported by ‘T(..)’ and ‘T()’ ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -210,3 +210,4 @@ test('GHCINullaryRecordWildcard', combined_output, ghci_script, ['GHCINullaryRec test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, ['GHCIImplicitImportNullaryRecordWildcard.script']) test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0']) test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) +test('T23318', normal, compile, ['-Wduplicate-exports']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4eafb52a26ad07b2be0af71a6896fb01ed919614 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4eafb52a26ad07b2be0af71a6896fb01ed919614 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 00:19:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 03 May 2023 20:19:11 -0400 Subject: [Git][ghc/ghc][master] Fix unlit path in cross bindists Message-ID: <6452f9ff64289_e3e0651ef0575bf@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -106,7 +106,7 @@ lib/settings : config.mk @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ - @echo ',("unlit command", "$$topdir/bin/unlit")' >> $@ + @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ @echo ',("target platform string", "$(TARGETPLATFORM)")' >> $@ @echo ',("target os", "$(HaskellTargetOs)")' >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fde4ac84ec7b1ead238cb158bbef48555d12af9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fde4ac84ec7b1ead238cb158bbef48555d12af9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 02:06:48 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 03 May 2023 22:06:48 -0400 Subject: [Git][ghc/ghc][wip/T23329] Fix type variable substitution in gen_Newtype_fam_insts Message-ID: <64531338dd66e_e3e063c08c8c605a@gitlab.mail> Ryan Scott pushed to branch wip/T23329 at Glasgow Haskell Compiler / GHC Commits: 78a7d47b by Ryan Scott at 2023-05-03T22:05:13-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 5 changed files: - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/TyCl/Class.hs - + testsuite/tests/deriving/should_compile/T23329.hs - + testsuite/tests/deriving/should_compile/T23329_M.hs - testsuite/tests/deriving/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -46,6 +46,7 @@ import GHC.Prelude import GHC.Hs +import GHC.Tc.TyCl.Class ( substATBndrs ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Instantiate( newFamInst ) import GHC.Tc.Utils.Env @@ -2100,8 +2101,8 @@ gen_Newtype_fam_insts loc' cls inst_tvs inst_tys rhs_ty newFamInst SynFamilyInst axiom where fam_tvs = tyConTyVars fam_tc - rep_lhs_tys = substTyVars lhs_subst fam_tvs - rep_rhs_tys = substTyVars rhs_subst fam_tvs + (_, rep_lhs_tys) = substATBndrs lhs_subst fam_tvs + (_, rep_rhs_tys) = substATBndrs rhs_subst fam_tvs rep_rhs_ty = mkTyConApp fam_tc rep_rhs_tys rep_tcvs = tyCoVarsOfTypesList rep_lhs_tys (rep_tvs, rep_cvs) = partition isTyVar rep_tcvs ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -22,6 +22,7 @@ module GHC.Tc.TyCl.Class , instDeclCtxt2 , instDeclCtxt3 , tcATDefault + , substATBndrs ) where @@ -42,7 +43,7 @@ import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad import GHC.Tc.TyCl.Build( TcMethInfo ) -import GHC.Core.Type ( piResultTys ) +import GHC.Core.Type ( extendTvSubstWithClone, piResultTys ) import GHC.Core.Predicate import GHC.Core.Multiplicity import GHC.Core.Class @@ -58,7 +59,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.Var -import GHC.Types.Var.Env +import GHC.Types.Var.Env ( lookupVarEnv ) import GHC.Types.SourceFile (HscSource(..)) import GHC.Types.SrcLoc import GHC.Types.Basic @@ -501,8 +502,7 @@ tcATDefault loc inst_subst defined_ats (ATI fam_tc defs) -- instance C [x] -- Then we want to generate the decl: type F [x] b = () | Just (rhs_ty, _loc) <- defs - = do { let (subst', pat_tys') = mapAccumL subst_tv inst_subst - (tyConTyVars fam_tc) + = do { let (subst', pat_tys') = substATBndrs inst_subst (tyConTyVars fam_tc) rhs' = substTyUnchecked subst' rhs_ty tcv' = tyCoVarsOfTypesList pat_tys' (tv', cv') = partition isTyVar tcv' @@ -525,14 +525,73 @@ tcATDefault loc inst_subst defined_ats (ATI fam_tc defs) | otherwise -- defs = Nothing = do { warnMissingAT (tyConName fam_tc) ; return [] } + +-- | Apply a substitution to the type variable binders of an associated type +-- family. This is used to compute default instances for associated type +-- families (see 'tcATDefault') as well as @newtype at -derived associated type +-- family instances (see @gen_Newtype_fam_insts@ in "GHC.Tc.Deriv.Generate"). +-- +-- As a concrete example, consider the following class and associated type +-- family: +-- +-- @ +-- class C k (a :: k) where +-- type F k a (b :: k) :: Type +-- type F j p q = (Proxy @j p, Proxy @j (q :: j)) +-- @ +-- +-- If a user defines this instance: +-- +-- @ +-- instance C (Type -> Type) Maybe where {} +-- @ +-- +-- Then in order to typecheck the default @F@ instance, we must apply the +-- substitution @[k :-> (Type -> Type), a :-> Maybe]@ to @F@'s binders, which +-- are @[k, a, (b :: k)]@. The result should look like this: +-- +-- @ +-- type F (Type -> Type) Maybe (b :: Type -> Type) = +-- (Proxy @(Type -> Type) Maybe, Proxy @(Type -> Type) (b :: Type -> Type)) +-- @ +-- +-- Making this work requires some care. There are two cases: +-- +-- 1. If we encounter a type variable in the domain of the substitution (e.g., +-- @k@ or @a@), then we apply the substitution directly. +-- +-- 2. Otherwise, we substitute into the type variable's kind (e.g., turn +-- @b :: k@ to @b :: Type -> Type@). We then return an extended substitution +-- where the old @b@ (of kind @k@) maps to the new @b@ (of kind @Type -> Type@). +-- +-- This step is important to do in case there are later occurrences of @b@, +-- which we must ensure have the correct kind. Otherwise, we might end up +-- with @Proxy \@(Type -> Type) (b :: k)@ on the right-hand side of the +-- default instance, which would be completely wrong. +-- +-- Contrast 'substATBndrs' function with similar substitution functions: +-- +-- * 'substTyVars' does not substitute into the kinds of each type variable, +-- nor does it extend the substitution. 'substTyVars' is meant for occurrences +-- of type variables, whereas 'substATBndr's is meant for binders. +-- +-- * 'substTyVarBndrs' does substitute into kinds and extends the substitution, +-- but it does not apply the substitution to the variables themselves. As +-- such, 'substTyVarBndrs' returns a list of 'TyVar's rather than a list of +-- 'Type's. +substATBndrs :: Subst -> [TyVar] -> (Subst, [Type]) +substATBndrs = mapAccumL substATBndr where - subst_tv subst tc_tv + substATBndr :: Subst -> TyVar -> (Subst, Type) + substATBndr subst tc_tv + -- Case (1) in the Haddocks | Just ty <- lookupVarEnv (getTvSubstEnv subst) tc_tv = (subst, ty) + -- Case (2) in the Haddocks | otherwise - = (extendTvSubst subst tc_tv ty', ty') + = (extendTvSubstWithClone subst tc_tv tc_tv', mkTyVarTy tc_tv') where - ty' = mkTyVarTy (updateTyVarKind (substTyUnchecked subst) tc_tv) + tc_tv' = updateTyVarKind (substTy subst) tc_tv warnMissingAT :: Name -> TcM () warnMissingAT name ===================================== testsuite/tests/deriving/should_compile/T23329.hs ===================================== @@ -0,0 +1,9 @@ +module T23329 where + +import Data.Kind (Type) +import Data.Proxy (Proxy(Proxy)) + +import T23329_M + +foo :: () +foo = myMethod @Type @MyMaybe @() () Proxy Proxy ===================================== testsuite/tests/deriving/should_compile/T23329_M.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T23329_M where + +import Data.Kind (Type) +import Data.Proxy (Proxy) + +class MyClass (f :: k -> Type) where + type MyTypeFamily f (i :: k) :: Type + myMethod :: MyTypeFamily f i -> Proxy f -> Proxy i -> () + +instance MyClass Maybe where + type MyTypeFamily Maybe i = () + myMethod = undefined + +newtype MyMaybe a = MyMaybe (Maybe a) + deriving MyClass ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -141,3 +141,4 @@ test('T20994', normal, compile, ['']) test('T22167', normal, compile, ['']) test('T22696a', normal, compile, ['']) test('T22696c', normal, compile, ['']) +test('T23329', normal, multimod_compile, ['T23329', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78a7d47bd0523483d5008a131e190d92fa8cd4d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78a7d47bd0523483d5008a131e190d92fa8cd4d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 08:53:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 04:53:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Add sized primitive literal syntax Message-ID: <6453729f960a8_e3e063c09fc4805fe@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 070511c8 by Josh Meredith at 2023-05-04T04:53:42-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - b06809ec by Sylvain Henry at 2023-05-04T04:53:42-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - bbe91801 by Andrei Borzenkov at 2023-05-04T04:53:47-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - docs/users_guide/9.8.1-notes.rst - + docs/users_guide/exts/extended_literals.rst - docs/users_guide/exts/literals.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/stolen_syntax.rst - hadrian/bindist/Makefile - libraries/Cabal - libraries/base/Data/OldList.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Real.hs - libraries/base/jsbits/base.js - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f64c919de724052ad7943615e7aeabe9eda3b9f0...bbe918016f9e7bcfd7800affebda90eab8663ee2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f64c919de724052ad7943615e7aeabe9eda3b9f0...bbe918016f9e7bcfd7800affebda90eab8663ee2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 08:55:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 04:55:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645372f6c4ce3_e3e063a1dbfc809bb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 654784f7 by Josh Meredith at 2023-05-04T04:54:54-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 6964616e by Sylvain Henry at 2023-05-04T04:54:54-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - c7316c38 by Andrei Borzenkov at 2023-05-04T04:54:58-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bbe918016f9e7bcfd7800affebda90eab8663ee2...c7316c38e780c00d7d917018fed9213ec40fda13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bbe918016f9e7bcfd7800affebda90eab8663ee2...c7316c38e780c00d7d917018fed9213ec40fda13 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 08:56:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 04:56:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6453733e6cc0c_e3e0651f0481269@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0bac6520 by Josh Meredith at 2023-05-04T04:56:04-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - d1bbdd92 by Sylvain Henry at 2023-05-04T04:56:04-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 1bbb4cf9 by Andrei Borzenkov at 2023-05-04T04:56:08-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7316c38e780c00d7d917018fed9213ec40fda13...1bbb4cf9f928c2f6154ae65339ceafe056680ebb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7316c38e780c00d7d917018fed9213ec40fda13...1bbb4cf9f928c2f6154ae65339ceafe056680ebb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 08:57:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 04:57:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645373856b587_e3e063c09fc4815c9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c8a3b1f2 by Josh Meredith at 2023-05-04T04:57:14-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 66c814a2 by Sylvain Henry at 2023-05-04T04:57:14-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - c6cd3ebc by Andrei Borzenkov at 2023-05-04T04:57:18-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bbb4cf9f928c2f6154ae65339ceafe056680ebb...c6cd3ebc47fca66bc683a4c70388d9a03278b91d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bbb4cf9f928c2f6154ae65339ceafe056680ebb...c6cd3ebc47fca66bc683a4c70388d9a03278b91d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 08:58:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 04:58:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645373cb7023b_e3e063a2823c81882@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6c7dd5e8 by Josh Meredith at 2023-05-04T04:58:25-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 65074e3a by Sylvain Henry at 2023-05-04T04:58:25-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 5f8d4b5b by Andrei Borzenkov at 2023-05-04T04:58:29-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6cd3ebc47fca66bc683a4c70388d9a03278b91d...5f8d4b5b22488bf51f42c565798b96ece8545228 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6cd3ebc47fca66bc683a4c70388d9a03278b91d...5f8d4b5b22488bf51f42c565798b96ece8545228 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:00:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:00:01 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6453741178017_e3e063a1dbfc8204a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9ce33bbd by Josh Meredith at 2023-05-04T04:59:35-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 4f67e726 by Sylvain Henry at 2023-05-04T04:59:35-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 3ed28421 by Andrei Borzenkov at 2023-05-04T04:59:39-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5f8d4b5b22488bf51f42c565798b96ece8545228...3ed28421430bd467e738cf318cf0b7ef6fded596 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5f8d4b5b22488bf51f42c565798b96ece8545228...3ed28421430bd467e738cf318cf0b7ef6fded596 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:01:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:01:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <64537456b721d_e3e063c09fc4824cf@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6d682513 by Josh Meredith at 2023-05-04T05:00:44-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - ed247deb by Sylvain Henry at 2023-05-04T05:00:44-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 32c6fc28 by Andrei Borzenkov at 2023-05-04T05:00:49-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ed28421430bd467e738cf318cf0b7ef6fded596...32c6fc28a16b940e096b7aeffd1c762972dde0c0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ed28421430bd467e738cf318cf0b7ef6fded596...32c6fc28a16b940e096b7aeffd1c762972dde0c0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:02:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:02:21 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6453749d215c2_e3e063a2823c8292b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c2afea6c by Josh Meredith at 2023-05-04T05:01:55-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - ac07053a by Sylvain Henry at 2023-05-04T05:01:55-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - c24238eb by Andrei Borzenkov at 2023-05-04T05:01:59-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32c6fc28a16b940e096b7aeffd1c762972dde0c0...c24238eb417e0e87a3bd002b17e15cc34b401168 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32c6fc28a16b940e096b7aeffd1c762972dde0c0...c24238eb417e0e87a3bd002b17e15cc34b401168 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:03:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:03:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645374e0d841_e3e063c09fc48325f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e1994f28 by Josh Meredith at 2023-05-04T05:03:04-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - fb2a6831 by Sylvain Henry at 2023-05-04T05:03:04-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 8761b422 by Andrei Borzenkov at 2023-05-04T05:03:08-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c24238eb417e0e87a3bd002b17e15cc34b401168...8761b4226023be9cc4e0dfde16ac91c0bdaf440f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c24238eb417e0e87a3bd002b17e15cc34b401168...8761b4226023be9cc4e0dfde16ac91c0bdaf440f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:04:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:04:38 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <64537526cf7b5_e3e06383121c83593@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4bb05258 by Josh Meredith at 2023-05-04T05:04:14-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 7d76694a by Sylvain Henry at 2023-05-04T05:04:14-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 2ec5fd54 by Andrei Borzenkov at 2023-05-04T05:04:18-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8761b4226023be9cc4e0dfde16ac91c0bdaf440f...2ec5fd54e5028e7e495278982a81ddd7b91f1af8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8761b4226023be9cc4e0dfde16ac91c0bdaf440f...2ec5fd54e5028e7e495278982a81ddd7b91f1af8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:05:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:05:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6453756faee19_e3e06361b16c838d1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 970e41ff by Josh Meredith at 2023-05-04T05:05:23-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - ee0466ad by Sylvain Henry at 2023-05-04T05:05:23-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - a19d1f5c by Andrei Borzenkov at 2023-05-04T05:05:27-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ec5fd54e5028e7e495278982a81ddd7b91f1af8...a19d1f5ca4702ef4db4000042016fe7910690469 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ec5fd54e5028e7e495278982a81ddd7b91f1af8...a19d1f5ca4702ef4db4000042016fe7910690469 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:07:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:07:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645375b4a5ccb_e3e063c08c8c841bd@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 88ee44ca by Josh Meredith at 2023-05-04T05:06:34-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 341a41a2 by Sylvain Henry at 2023-05-04T05:06:34-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 5422999b by Andrei Borzenkov at 2023-05-04T05:06:37-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a19d1f5ca4702ef4db4000042016fe7910690469...5422999b3f4d1d9e9f490e7fcf3b820903dbe134 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a19d1f5ca4702ef4db4000042016fe7910690469...5422999b3f4d1d9e9f490e7fcf3b820903dbe134 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:08:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:08:08 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645375f8b9648_e3e063a1dbfc844e4@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 29d9b75b by Josh Meredith at 2023-05-04T05:07:43-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 6761f73e by Sylvain Henry at 2023-05-04T05:07:43-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 26c496cb by Andrei Borzenkov at 2023-05-04T05:07:47-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5422999b3f4d1d9e9f490e7fcf3b820903dbe134...26c496cb43c62387319beba2417eaa03c8660f11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5422999b3f4d1d9e9f490e7fcf3b820903dbe134...26c496cb43c62387319beba2417eaa03c8660f11 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:09:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:09:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6453763fc0f13_e3e0651f048471b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b6346908 by Josh Meredith at 2023-05-04T05:08:52-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 9883fec2 by Sylvain Henry at 2023-05-04T05:08:53-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - a9672780 by Andrei Borzenkov at 2023-05-04T05:08:56-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26c496cb43c62387319beba2417eaa03c8660f11...a9672780fb3885ba8f28de9900488267d3c8ec36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26c496cb43c62387319beba2417eaa03c8660f11...a9672780fb3885ba8f28de9900488267d3c8ec36 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:10:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:10:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6453768459c5e_e3e06383121c850f7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1d408f8c by Josh Meredith at 2023-05-04T05:10:02-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 40e6046f by Sylvain Henry at 2023-05-04T05:10:02-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - f37cac5c by Andrei Borzenkov at 2023-05-04T05:10:06-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9672780fb3885ba8f28de9900488267d3c8ec36...f37cac5c6abde992dd12c7a97a4f7d51f2d83ae3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9672780fb3885ba8f28de9900488267d3c8ec36...f37cac5c6abde992dd12c7a97a4f7d51f2d83ae3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:11:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:11:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645376c68b76d_e3e0651f04871df@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2ff40ce5 by Josh Meredith at 2023-05-04T05:11:11-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2b28cfb2 by Sylvain Henry at 2023-05-04T05:11:11-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 8d07eef3 by Andrei Borzenkov at 2023-05-04T05:11:15-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f37cac5c6abde992dd12c7a97a4f7d51f2d83ae3...8d07eef39011ce52755e1016be34c354735a465b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f37cac5c6abde992dd12c7a97a4f7d51f2d83ae3...8d07eef39011ce52755e1016be34c354735a465b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:12:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:12:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6453770eaeaeb_e3e0651f04874ba@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0cbe43e5 by Josh Meredith at 2023-05-04T05:12:20-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 4e3e477a by Sylvain Henry at 2023-05-04T05:12:20-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 26b436cd by Andrei Borzenkov at 2023-05-04T05:12:24-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d07eef39011ce52755e1016be34c354735a465b...26b436cdab3e2ce703f21939599cfd8f2a6d9613 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d07eef39011ce52755e1016be34c354735a465b...26b436cdab3e2ce703f21939599cfd8f2a6d9613 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:13:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:13:56 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645377541a2dd_e3e06383121c8772f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4a352531 by Josh Meredith at 2023-05-04T05:13:30-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - ad51977f by Sylvain Henry at 2023-05-04T05:13:30-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 38dfd648 by Andrei Borzenkov at 2023-05-04T05:13:34-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26b436cdab3e2ce703f21939599cfd8f2a6d9613...38dfd648564b8a9595a4fa4d67bf5d2c44913d76 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26b436cdab3e2ce703f21939599cfd8f2a6d9613...38dfd648564b8a9595a4fa4d67bf5d2c44913d76 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:15:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:15:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6453779b3b7b_e3e063a20fc8880eb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4a8e1b07 by Josh Meredith at 2023-05-04T05:14:40-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - d07e99c2 by Sylvain Henry at 2023-05-04T05:14:40-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 46fdfafa by Andrei Borzenkov at 2023-05-04T05:14:44-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38dfd648564b8a9595a4fa4d67bf5d2c44913d76...46fdfafad9e5094119d7083fe2688e9bc58a04f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38dfd648564b8a9595a4fa4d67bf5d2c44913d76...46fdfafad9e5094119d7083fe2688e9bc58a04f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:16:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:16:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: JS: fix bounds checking (Issue 23123) Message-ID: <645377df68046_e3e0631e7280900e9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0178ca2c by Josh Meredith at 2023-05-04T05:15:50-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - ea1474f3 by Sylvain Henry at 2023-05-04T05:15:50-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - b02133a8 by Andrei Borzenkov at 2023-05-04T05:15:54-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 11 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/OldList.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46fdfafad9e5094119d7083fe2688e9bc58a04f0...b02133a8ea0d3d5e01be6e29b9ffae072e72614d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46fdfafad9e5094119d7083fe2688e9bc58a04f0...b02133a8ea0d3d5e01be6e29b9ffae072e72614d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:18:14 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:18:14 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <64537856ee30b_e3e0631e72809021b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cf9590fa by Matthew Pickering at 2023-05-04T05:18:06-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 33d145e0 by romes at 2023-05-04T05:18:06-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6de327f3 by romes at 2023-05-04T05:18:06-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - fd1a5cfa by romes at 2023-05-04T05:18:06-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 82e674c9 by Matthew Pickering at 2023-05-04T05:18:06-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 55f44f23 by Josh Meredith at 2023-05-04T05:18:07-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 1272cd33 by Sylvain Henry at 2023-05-04T05:18:07-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - acd07157 by Andrei Borzenkov at 2023-05-04T05:18:10-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 12 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b02133a8ea0d3d5e01be6e29b9ffae072e72614d...acd0715737fa2f560dc1eaabc2846615b4a05278 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b02133a8ea0d3d5e01be6e29b9ffae072e72614d...acd0715737fa2f560dc1eaabc2846615b4a05278 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:19:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:19:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453789e1cc1f_e3e0651f04907a6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d043fb12 by Matthew Pickering at 2023-05-04T05:19:17-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 6fac596b by romes at 2023-05-04T05:19:17-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 019aa396 by romes at 2023-05-04T05:19:17-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 59f97041 by romes at 2023-05-04T05:19:17-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 0cab5919 by Matthew Pickering at 2023-05-04T05:19:17-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 5a593437 by Josh Meredith at 2023-05-04T05:19:18-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 224eb59e by Sylvain Henry at 2023-05-04T05:19:18-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 31df68ab by Andrei Borzenkov at 2023-05-04T05:19:22-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 12 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acd0715737fa2f560dc1eaabc2846615b4a05278...31df68abf6cb2279c5c4abbf9ab1c29bc121c9c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acd0715737fa2f560dc1eaabc2846615b4a05278...31df68abf6cb2279c5c4abbf9ab1c29bc121c9c1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:20:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:20:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645378e4357a7_e3e06383121c91092@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 574e94ab by Matthew Pickering at 2023-05-04T05:20:28-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 4aa95141 by romes at 2023-05-04T05:20:28-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - b37ca66c by romes at 2023-05-04T05:20:28-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 36c802ce by romes at 2023-05-04T05:20:28-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 7df750da by Matthew Pickering at 2023-05-04T05:20:28-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - dbe897a7 by Josh Meredith at 2023-05-04T05:20:29-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 197ee1c2 by Sylvain Henry at 2023-05-04T05:20:29-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - c2824dc0 by Andrei Borzenkov at 2023-05-04T05:20:33-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 12 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/31df68abf6cb2279c5c4abbf9ab1c29bc121c9c1...c2824dc019039df474cb9e6100bfc6dbf307f345 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/31df68abf6cb2279c5c4abbf9ab1c29bc121c9c1...c2824dc019039df474cb9e6100bfc6dbf307f345 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:21:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:21:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453792b180f_e3e06383121c913fb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 99d0701d by Matthew Pickering at 2023-05-04T05:21:39-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 4e4abbb4 by romes at 2023-05-04T05:21:39-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 30e6137d by romes at 2023-05-04T05:21:39-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - df979ad6 by romes at 2023-05-04T05:21:39-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 7ceb02ab by Matthew Pickering at 2023-05-04T05:21:39-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 76dd5c8f by Josh Meredith at 2023-05-04T05:21:39-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 74ce12c0 by Sylvain Henry at 2023-05-04T05:21:39-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - b7737568 by Andrei Borzenkov at 2023-05-04T05:21:43-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 12 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2824dc019039df474cb9e6100bfc6dbf307f345...b7737568bf522461cc04e423825203b5ced1f6db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2824dc019039df474cb9e6100bfc6dbf307f345...b7737568bf522461cc04e423825203b5ced1f6db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:22:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:22:59 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <64537973ed09_e3e06383121c954d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 482ecb30 by Matthew Pickering at 2023-05-04T05:22:50-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - eab6eafb by romes at 2023-05-04T05:22:50-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 4ca65c75 by romes at 2023-05-04T05:22:50-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - b8356f39 by romes at 2023-05-04T05:22:50-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 5a242e6c by Matthew Pickering at 2023-05-04T05:22:51-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - dd168099 by Andrei Borzenkov at 2023-05-04T05:22:54-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 12 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7737568bf522461cc04e423825203b5ced1f6db...dd168099cbd34777194259fb2e27eed58e85a37d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7737568bf522461cc04e423825203b5ced1f6db...dd168099cbd34777194259fb2e27eed58e85a37d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:24:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:24:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645379b7dc2e6_e3e063a1dbfc9574f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7ded58c6 by Matthew Pickering at 2023-05-04T05:24:00-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - c18005f0 by romes at 2023-05-04T05:24:00-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 162ada61 by romes at 2023-05-04T05:24:00-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 38a4470d by romes at 2023-05-04T05:24:00-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 1af7b6a8 by Matthew Pickering at 2023-05-04T05:24:01-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 3f232f3b by Andrei Borzenkov at 2023-05-04T05:24:04-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 12 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd168099cbd34777194259fb2e27eed58e85a37d...3f232f3b04546a5040089c97fcebe0fae8326ca6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd168099cbd34777194259fb2e27eed58e85a37d...3f232f3b04546a5040089c97fcebe0fae8326ca6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:25:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:25:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645379ff1fea3_e3e063c09fc498051@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f7658931 by Matthew Pickering at 2023-05-04T05:25:12-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 8fcc15dc by romes at 2023-05-04T05:25:12-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - aa8375b6 by romes at 2023-05-04T05:25:12-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - a2ace6b4 by romes at 2023-05-04T05:25:12-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 8f95a2bf by Matthew Pickering at 2023-05-04T05:25:12-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 9c50a78a by Andrei Borzenkov at 2023-05-04T05:25:16-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 12 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f232f3b04546a5040089c97fcebe0fae8326ca6...9c50a78abe150c530196d4199c00ac934893f506 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f232f3b04546a5040089c97fcebe0fae8326ca6...9c50a78abe150c530196d4199c00ac934893f506 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:56:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:56:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <64538157d3d9c_e3e0651f0410879@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d198dade by Matthew Pickering at 2023-05-04T05:56:35-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - c897646f by romes at 2023-05-04T05:56:35-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - e38f16e6 by romes at 2023-05-04T05:56:35-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 1b372a17 by romes at 2023-05-04T05:56:35-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - ad1036cf by Matthew Pickering at 2023-05-04T05:56:35-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 9d64c261 by Josh Meredith at 2023-05-04T05:56:36-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 0756fbff by Sylvain Henry at 2023-05-04T05:56:36-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 094c04d9 by Krzysztof Gogolewski at 2023-05-04T05:56:36-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c50a78abe150c530196d4199c00ac934893f506...094c04d91ca67f05ce4357bc95a8cf0bcb4ea588 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c50a78abe150c530196d4199c00ac934893f506...094c04d91ca67f05ce4357bc95a8cf0bcb4ea588 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:57:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:57:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453819ed23fd_e3e063c09fd8109071@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4c37a04a by Matthew Pickering at 2023-05-04T05:57:43-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 69527c0f by romes at 2023-05-04T05:57:43-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - c622035f by romes at 2023-05-04T05:57:43-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 3683bb11 by romes at 2023-05-04T05:57:43-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 0861cbff by Matthew Pickering at 2023-05-04T05:57:43-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 2ee60455 by Josh Meredith at 2023-05-04T05:57:44-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - d928e35b by Sylvain Henry at 2023-05-04T05:57:44-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - a03a6ced by Krzysztof Gogolewski at 2023-05-04T05:57:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/094c04d91ca67f05ce4357bc95a8cf0bcb4ea588...a03a6cedb67f9ed3a0a92178d44028d521069dff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/094c04d91ca67f05ce4357bc95a8cf0bcb4ea588...a03a6cedb67f9ed3a0a92178d44028d521069dff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 09:58:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 05:58:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645381dfb6909_e3e06361b16c109399@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ed733f44 by Matthew Pickering at 2023-05-04T05:58:51-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 7990027d by romes at 2023-05-04T05:58:51-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - ea88b382 by romes at 2023-05-04T05:58:51-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 2239f15c by romes at 2023-05-04T05:58:51-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 9b2d4e8b by Matthew Pickering at 2023-05-04T05:58:51-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - b2dc0d7f by Josh Meredith at 2023-05-04T05:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 0babe1c5 by Sylvain Henry at 2023-05-04T05:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 7c8c29df by Krzysztof Gogolewski at 2023-05-04T05:58:52-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a03a6cedb67f9ed3a0a92178d44028d521069dff...7c8c29dfd40f6409d0999701abb19ffa79d5118d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a03a6cedb67f9ed3a0a92178d44028d521069dff...7c8c29dfd40f6409d0999701abb19ffa79d5118d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:00:06 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:00:06 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453822664412_e3e0651f04109642@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9857f42b by Matthew Pickering at 2023-05-04T06:00:00-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 7289a040 by romes at 2023-05-04T06:00:00-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 5acecb1f by romes at 2023-05-04T06:00:00-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 21334759 by romes at 2023-05-04T06:00:00-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 969cc154 by Matthew Pickering at 2023-05-04T06:00:00-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 60745b80 by Josh Meredith at 2023-05-04T06:00:01-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - a42dd08e by Sylvain Henry at 2023-05-04T06:00:01-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - e275eb45 by Krzysztof Gogolewski at 2023-05-04T06:00:01-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c8c29dfd40f6409d0999701abb19ffa79d5118d...e275eb4504595d711df25b829061a6b020dd83d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c8c29dfd40f6409d0999701abb19ffa79d5118d...e275eb4504595d711df25b829061a6b020dd83d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:01:14 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:01:14 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453826a318dc_e3e063a2823c109956@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fa76c2f9 by Matthew Pickering at 2023-05-04T06:01:09-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - f8f21d40 by romes at 2023-05-04T06:01:09-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 7b7630b1 by romes at 2023-05-04T06:01:09-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 456eda04 by romes at 2023-05-04T06:01:09-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - d145b224 by Matthew Pickering at 2023-05-04T06:01:10-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - b51670e0 by Josh Meredith at 2023-05-04T06:01:10-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - fd80edde by Sylvain Henry at 2023-05-04T06:01:10-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 1b202651 by Krzysztof Gogolewski at 2023-05-04T06:01:11-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e275eb4504595d711df25b829061a6b020dd83d3...1b202651bcddade2c29ae9c5cb4a9d488c1f2ba1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e275eb4504595d711df25b829061a6b020dd83d3...1b202651bcddade2c29ae9c5cb4a9d488c1f2ba1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:02:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:02:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645382b4996de_e3e06361b16c110266@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a781fb3f by Matthew Pickering at 2023-05-04T06:02:24-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 6d78d7c9 by romes at 2023-05-04T06:02:24-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 923aeb47 by romes at 2023-05-04T06:02:24-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 2b48c5dc by romes at 2023-05-04T06:02:24-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - f39c613c by Matthew Pickering at 2023-05-04T06:02:24-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 561f98a3 by Josh Meredith at 2023-05-04T06:02:24-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 5e19367e by Sylvain Henry at 2023-05-04T06:02:24-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - e94f1928 by Krzysztof Gogolewski at 2023-05-04T06:02:25-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b202651bcddade2c29ae9c5cb4a9d488c1f2ba1...e94f1928921c8b665e9286f099bbd32094aa1274 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b202651bcddade2c29ae9c5cb4a9d488c1f2ba1...e94f1928921c8b665e9286f099bbd32094aa1274 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:03:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:03:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645382f9f034d_e3e0651f0411057e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bdacd1d5 by Matthew Pickering at 2023-05-04T06:03:32-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - c741da5e by romes at 2023-05-04T06:03:32-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 5d5e8e12 by romes at 2023-05-04T06:03:32-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - c6180d01 by romes at 2023-05-04T06:03:32-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - c96953da by Matthew Pickering at 2023-05-04T06:03:32-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 5f08da8f by Josh Meredith at 2023-05-04T06:03:33-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - a73fce37 by Sylvain Henry at 2023-05-04T06:03:33-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - deec3395 by Krzysztof Gogolewski at 2023-05-04T06:03:33-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e94f1928921c8b665e9286f099bbd32094aa1274...deec3395ee28c7e69b4599bc0b97b184785bdb31 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e94f1928921c8b665e9286f099bbd32094aa1274...deec3395ee28c7e69b4599bc0b97b184785bdb31 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:04:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:04:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645383428a656_e3e063a2823c1108d1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8f127211 by Matthew Pickering at 2023-05-04T06:04:41-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 445c1055 by romes at 2023-05-04T06:04:41-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 1155138c by romes at 2023-05-04T06:04:41-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 29a76b57 by romes at 2023-05-04T06:04:41-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 141fa361 by Matthew Pickering at 2023-05-04T06:04:41-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 861c541d by Josh Meredith at 2023-05-04T06:04:41-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 345bace5 by Sylvain Henry at 2023-05-04T06:04:41-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - cf655847 by Krzysztof Gogolewski at 2023-05-04T06:04:42-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/deec3395ee28c7e69b4599bc0b97b184785bdb31...cf655847427461d2d2c022621fbd29b9eee3916b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/deec3395ee28c7e69b4599bc0b97b184785bdb31...cf655847427461d2d2c022621fbd29b9eee3916b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:05:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:05:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453838378f76_e3e063c09fd8111142@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a60d134e by Matthew Pickering at 2023-05-04T06:05:50-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 86476dd6 by romes at 2023-05-04T06:05:50-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - e0dc2029 by romes at 2023-05-04T06:05:50-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - a00596bf by romes at 2023-05-04T06:05:50-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 75548201 by Matthew Pickering at 2023-05-04T06:05:50-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 21c0df9f by Josh Meredith at 2023-05-04T06:05:50-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 6dda3932 by Sylvain Henry at 2023-05-04T06:05:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - d94d4f80 by Krzysztof Gogolewski at 2023-05-04T06:05:51-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf655847427461d2d2c022621fbd29b9eee3916b...d94d4f8005713f2932ff3e6d27b66e1502b9c8a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf655847427461d2d2c022621fbd29b9eee3916b...d94d4f8005713f2932ff3e6d27b66e1502b9c8a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:07:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:07:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645383c85b765_e3e06361b16c11142c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8746a100 by Matthew Pickering at 2023-05-04T06:06:59-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - b47c891c by romes at 2023-05-04T06:06:59-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 49e982f2 by romes at 2023-05-04T06:06:59-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 0e4fe4e2 by romes at 2023-05-04T06:06:59-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 94fddee5 by Matthew Pickering at 2023-05-04T06:06:59-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 528172d7 by Josh Meredith at 2023-05-04T06:06:59-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 8f49cc65 by Sylvain Henry at 2023-05-04T06:06:59-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 8d01b082 by Krzysztof Gogolewski at 2023-05-04T06:07:00-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d94d4f8005713f2932ff3e6d27b66e1502b9c8a2...8d01b082ff59cf14ff6e9228368b8906c53004b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d94d4f8005713f2932ff3e6d27b66e1502b9c8a2...8d01b082ff59cf14ff6e9228368b8906c53004b8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:08:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:08:12 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453840c1b9ad_e3e06383121c111773@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b5240ed2 by Matthew Pickering at 2023-05-04T06:08:06-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - de9a03bf by romes at 2023-05-04T06:08:06-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 8b33f1a2 by romes at 2023-05-04T06:08:06-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 368cde61 by romes at 2023-05-04T06:08:06-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - a4ffee60 by Matthew Pickering at 2023-05-04T06:08:06-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 5f45e27e by Josh Meredith at 2023-05-04T06:08:06-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - db3bcc95 by Sylvain Henry at 2023-05-04T06:08:06-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - af7eddf8 by Krzysztof Gogolewski at 2023-05-04T06:08:07-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d01b082ff59cf14ff6e9228368b8906c53004b8...af7eddf80d0407f5683b617a0c26c9c036bafe12 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d01b082ff59cf14ff6e9228368b8906c53004b8...af7eddf80d0407f5683b617a0c26c9c036bafe12 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:09:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:09:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453844e93072_e3e06383121c11206f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9368fc23 by Matthew Pickering at 2023-05-04T06:09:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 30bd68c2 by romes at 2023-05-04T06:09:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 2b3ac9cc by romes at 2023-05-04T06:09:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 90b2e208 by romes at 2023-05-04T06:09:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 29621f9d by Matthew Pickering at 2023-05-04T06:09:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - f28366cd by Josh Meredith at 2023-05-04T06:09:14-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 28a54f74 by Sylvain Henry at 2023-05-04T06:09:14-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 728ed886 by Krzysztof Gogolewski at 2023-05-04T06:09:15-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af7eddf80d0407f5683b617a0c26c9c036bafe12...728ed886d0ed0d9941cec52e117a7071df698068 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af7eddf80d0407f5683b617a0c26c9c036bafe12...728ed886d0ed0d9941cec52e117a7071df698068 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:10:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:10:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645384932eaec_e3e0651f0411238f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c66f1d5d by Matthew Pickering at 2023-05-04T06:10:22-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 9366cbc4 by romes at 2023-05-04T06:10:22-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - cabdd121 by romes at 2023-05-04T06:10:22-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - ca89d786 by romes at 2023-05-04T06:10:22-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 6956468c by Matthew Pickering at 2023-05-04T06:10:22-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 8b06eac9 by Josh Meredith at 2023-05-04T06:10:23-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - d5de2dca by Sylvain Henry at 2023-05-04T06:10:23-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - f7ee38ff by Krzysztof Gogolewski at 2023-05-04T06:10:24-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/728ed886d0ed0d9941cec52e117a7071df698068...f7ee38ffa49e9fcfbe6a4ab23d509ca21f14ffb9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/728ed886d0ed0d9941cec52e117a7071df698068...f7ee38ffa49e9fcfbe6a4ab23d509ca21f14ffb9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:11:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:11:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645384d9d8e43_e3e06361b16c1126ee@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 776e592a by Matthew Pickering at 2023-05-04T06:11:33-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - ad0c9835 by romes at 2023-05-04T06:11:33-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 03e642d3 by romes at 2023-05-04T06:11:33-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - e95bba83 by romes at 2023-05-04T06:11:33-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 2b1d1a1c by Matthew Pickering at 2023-05-04T06:11:33-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 3e6938b3 by Josh Meredith at 2023-05-04T06:11:33-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - bb786b40 by Sylvain Henry at 2023-05-04T06:11:33-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 353c1916 by Krzysztof Gogolewski at 2023-05-04T06:11:34-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7ee38ffa49e9fcfbe6a4ab23d509ca21f14ffb9...353c19161e64d6b226722abe9bdb2c9aa1bd213f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7ee38ffa49e9fcfbe6a4ab23d509ca21f14ffb9...353c19161e64d6b226722abe9bdb2c9aa1bd213f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:12:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:12:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453851fe5e10_e3e06361b16c11441f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a7d0f40c by Matthew Pickering at 2023-05-04T06:12:43-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - da17e884 by romes at 2023-05-04T06:12:43-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 3f864366 by romes at 2023-05-04T06:12:43-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 24eedd8f by romes at 2023-05-04T06:12:43-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - b965e39d by Matthew Pickering at 2023-05-04T06:12:43-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - f51ea65d by Josh Meredith at 2023-05-04T06:12:43-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - ddd19052 by Sylvain Henry at 2023-05-04T06:12:43-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - e722df37 by Krzysztof Gogolewski at 2023-05-04T06:12:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/353c19161e64d6b226722abe9bdb2c9aa1bd213f...e722df375b3a78924726cce152a3c06dd9760a4e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/353c19161e64d6b226722abe9bdb2c9aa1bd213f...e722df375b3a78924726cce152a3c06dd9760a4e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:13:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:13:56 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <64538564a5458_e3e063a20fc81147aa@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 441836fa by Matthew Pickering at 2023-05-04T06:13:52-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - cb7f2b8e by romes at 2023-05-04T06:13:52-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 8f7b81ac by romes at 2023-05-04T06:13:52-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 8c7451c4 by romes at 2023-05-04T06:13:52-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 5f7d91cc by Matthew Pickering at 2023-05-04T06:13:52-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 639b2677 by Josh Meredith at 2023-05-04T06:13:52-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 5666c6e5 by Sylvain Henry at 2023-05-04T06:13:52-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 7f30a8c0 by Krzysztof Gogolewski at 2023-05-04T06:13:53-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e722df375b3a78924726cce152a3c06dd9760a4e...7f30a8c00fce98e531e73425e4aee03235555506 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e722df375b3a78924726cce152a3c06dd9760a4e...7f30a8c00fce98e531e73425e4aee03235555506 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:15:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:15:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645385ab3516a_e3e0631e72801166a3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 19f00225 by Matthew Pickering at 2023-05-04T06:15:01-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - b6f0accc by romes at 2023-05-04T06:15:01-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 3f3c18e7 by romes at 2023-05-04T06:15:01-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - b5751a3e by romes at 2023-05-04T06:15:01-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 924392cc by Matthew Pickering at 2023-05-04T06:15:01-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 2e523be5 by Josh Meredith at 2023-05-04T06:15:01-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 03914522 by Sylvain Henry at 2023-05-04T06:15:01-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - e40012ef by Krzysztof Gogolewski at 2023-05-04T06:15:02-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f30a8c00fce98e531e73425e4aee03235555506...e40012ef77e930ce16c8be8e12f71e9b93e24889 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f30a8c00fce98e531e73425e4aee03235555506...e40012ef77e930ce16c8be8e12f71e9b93e24889 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:16:14 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:16:14 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645385ee26115_e3e063c08c8c11697b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e56b4947 by Matthew Pickering at 2023-05-04T06:16:09-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - b6b6025b by romes at 2023-05-04T06:16:09-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - b443b01f by romes at 2023-05-04T06:16:09-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 70aa4125 by romes at 2023-05-04T06:16:09-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 6949b37e by Matthew Pickering at 2023-05-04T06:16:09-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - e41038e5 by Josh Meredith at 2023-05-04T06:16:10-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 83107976 by Sylvain Henry at 2023-05-04T06:16:10-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - ff947102 by Krzysztof Gogolewski at 2023-05-04T06:16:10-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e40012ef77e930ce16c8be8e12f71e9b93e24889...ff9471023d38e25369b3baf7308e37ee3ac5e035 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e40012ef77e930ce16c8be8e12f71e9b93e24889...ff9471023d38e25369b3baf7308e37ee3ac5e035 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:17:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:17:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645386351b318_e3e063c08c8c1172a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0cf522bf by Matthew Pickering at 2023-05-04T06:17:18-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - cf594e09 by romes at 2023-05-04T06:17:18-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 961ec085 by romes at 2023-05-04T06:17:18-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - e49c829e by romes at 2023-05-04T06:17:18-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - e7a06d89 by Matthew Pickering at 2023-05-04T06:17:18-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - d6fc2ee0 by Josh Meredith at 2023-05-04T06:17:19-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 848b8548 by Sylvain Henry at 2023-05-04T06:17:19-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 0be41615 by Krzysztof Gogolewski at 2023-05-04T06:17:19-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9471023d38e25369b3baf7308e37ee3ac5e035...0be416153202a62cd9d4617165510f62ac9a18fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9471023d38e25369b3baf7308e37ee3ac5e035...0be416153202a62cd9d4617165510f62ac9a18fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:23:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:23:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <645387a9bc283_e3e0631e7280119481@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8add60e2 by Matthew Pickering at 2023-05-04T06:23:33-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 9b06ec8e by romes at 2023-05-04T06:23:33-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6b3ff4e7 by romes at 2023-05-04T06:23:33-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - 7ef8e0f3 by romes at 2023-05-04T06:23:33-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - b711c527 by Matthew Pickering at 2023-05-04T06:23:33-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 8e9d555b by Josh Meredith at 2023-05-04T06:23:34-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 3b632fd9 by Sylvain Henry at 2023-05-04T06:23:34-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - cb372361 by Krzysztof Gogolewski at 2023-05-04T06:23:34-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0be416153202a62cd9d4617165510f62ac9a18fc...cb3723616650328f7d2cf405995b586fa12707d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0be416153202a62cd9d4617165510f62ac9a18fc...cb3723616650328f7d2cf405995b586fa12707d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:25:49 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Thu, 04 May 2023 06:25:49 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/marge_bot_batch_merge_job Message-ID: <6453882d3488f_e3e0631e728012306@gitlab.mail> Bryan R deleted branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:27:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 06:27:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/marge_bot_batch_merge_job Message-ID: <6453887f2b3f2_e3e063a2823c123224@gitlab.mail> Marge Bot pushed new branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/marge_bot_batch_merge_job You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:33:09 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 04 May 2023 06:33:09 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <645389e56f314_e3e063a20fc81321c8@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 092d2d82 by Josh Meredith at 2023-05-04T10:32:57+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 9 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,13 +6,15 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS , identsV , identsE -- * Saturation - , jsSaturate + , satJStat + , satJExpr -- * Generic traversal (via compos) , JMacro(..) , JMGadt(..) @@ -21,8 +23,6 @@ module GHC.JS.Transform , composOpM , composOpM_ , composOpFold - , satJExpr - , satJStat ) where @@ -33,11 +33,12 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) +import Data.List (sortBy) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique.Map +import GHC.Types.Unique.FM {-# INLINE identsS #-} @@ -200,66 +201,56 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) - where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v - - --------------------------------------------------------------------------------- --- Translation --- --- This will be moved after GHC.JS.Syntax is removed --------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - - -satJExpr :: JExpr -> Sat.JExpr -satJExpr = go - where - go (ValExpr v) = Sat.ValExpr (satJVal v) - go (SelExpr obj i) = Sat.SelExpr (satJExpr obj) i - go (IdxExpr o i) = Sat.IdxExpr (satJExpr o) (satJExpr i) - go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r) - go (UOpExpr op r) = Sat.UOpExpr (satJUOp op) (satJExpr r) - go (IfExpr c t e) = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e) - go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands) - go UnsatExpr{} = error "satJExpr: discovered an Unsat...impossibly" +satJStat :: Maybe FastString -> JStat -> Sat.JStat +satJStat str x = evalState (jsSaturateS x) (newIdentSupply str) + +satJExpr :: Maybe FastString -> JExpr -> Sat.JExpr +satJExpr str x = evalState (jsSaturateE x) (newIdentSupply str) + +jsSaturateS :: JStat -> State [Ident] Sat.JStat +jsSaturateS = \case + DeclStat i rhs -> Sat.DeclStat i <$> mapM jsSaturateE rhs + ReturnStat e -> Sat.ReturnStat <$> jsSaturateE e + IfStat c t e -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e + WhileStat is_do c e -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e + ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body + SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct + <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps + <*> jsSaturateS def + TryStat t i c f -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f + BlockStat bs -> fmap Sat.BlockStat $! mapM jsSaturateS bs + ApplStat rator rand -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand + UOpStat rator rand -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand + AssignStat lhs rhs -> Sat.AssignStat <$> jsSaturateE lhs <*> jsSaturateE rhs + LabelStat lbl stmt -> Sat.LabelStat lbl <$> jsSaturateS stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + UnsatBlock us -> jsSaturateS =<< runIdentSupply us + +jsSaturateE :: JExpr -> State [Ident] Sat.JExpr +jsSaturateE = \case + ValExpr v -> Sat.ValExpr <$> jsSaturateV v + SelExpr obj i -> Sat.SelExpr <$> jsSaturateE obj <*> pure i + IdxExpr o i -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i + InfixExpr op l r -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r + UOpExpr op r -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r + IfExpr c t e -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e + ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands + UnsatExpr us -> jsSaturateE =<< runIdentSupply us + +jsSaturateV :: JVal -> State [Ident] Sat.JVal +jsSaturateV = \case + JVar i -> return $ Sat.JVar i + JList xs -> Sat.JList <$> mapM jsSaturateE xs + JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) + JInt i -> return $ Sat.JInt i + JStr s -> return $ Sat.JStr s + JRegEx f -> return $ Sat.JRegEx f + JHash (UniqMap m) -> Sat.JHash . UniqMap . listToUFM + <$> ( mapM (\(f, x) -> jsSaturateE x >>= \x' -> return (f, (f, x')) ) + . sortBy (\x y -> fst x `lexicalCompareFS` fst y) $ nonDetEltsUFM m ) + JFunc args body -> Sat.JFunc args <$> jsSaturateS body + UnsatVal us -> jsSaturateV =<< runIdentSupply us satJOp :: JOp -> Sat.Op satJOp = go @@ -305,15 +296,3 @@ satJUOp = go go PreDecOp = Sat.PreDecOp go PostDecOp = Sat.PostDecOp -satJVal :: JVal -> Sat.JVal -satJVal = go - where - go (JVar i) = Sat.JVar i - go (JList xs) = Sat.JList (satJExpr <$> xs) - go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) - go (JInt i) = Sat.JInt i - go (JStr f) = Sat.JStr f - go (JRegEx f) = Sat.JRegEx f - go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) - go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,8 +134,7 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m 1) + satJStat (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] let oi = ObjUnit @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = satJStat (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,8 +245,7 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m n) + satJStat (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps let oi = ObjUnit @@ -336,7 +334,7 @@ genToplevelRhs i rhs = case rhs of eid@(TxtI eidt) <- identForEntryId i (TxtI idt) <- identForId i body <- genBody (initExprCtx i) R2 args body typ - global_occs <- globalOccs (jsSaturate (Just "ghcjs_tmp_sat_") body) + global_occs <- globalOccs (satJStat (Just "ghcjs_tmp_sat_") body) let lidents = map global_ident global_occs let lids = map global_id global_occs let lidents' = map identFS lidents ===================================== compiler/GHC/StgToJS/CoreUtils.hs ===================================== @@ -253,7 +253,7 @@ assocPrimReps (r:rs) vs = case (primRepSize r,vs) of (NoSlot, xs) -> (r,[]) : assocPrimReps rs xs (OneSlot, x:xs) -> (r,[x]) : assocPrimReps rs xs (TwoSlots, x:y:xs) -> (r,[x,y]) : assocPrimReps rs xs - err -> pprPanic "assocPrimReps" (ppr $ fmap (map satJExpr) $ err) + err -> pprPanic "assocPrimReps" (ppr $ map (satJExpr Nothing) <$> err) -- | Associate the given values to the Id's PrimReps, taking into account the -- number of slots per PrimRep ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -60,8 +60,8 @@ genCon ctx con args | xs <- concatMap typex_expr (ctxTarget ctx) = pprPanic "genCon: unhandled DataCon" (ppr (con - , fmap satJExpr args - , fmap satJExpr xs + , satJExpr Nothing <$> args + , satJExpr Nothing <$> xs )) -- | Allocate a data constructor. Allocate in this context means bind the data @@ -90,7 +90,7 @@ allocUnboxedCon con = \case | isBoolDataCon con && dataConTag con == 2 -> true_ [x] | isUnboxableCon con -> x - xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, fmap satJExpr xs)) + xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, satJExpr Nothing <$> xs)) -- | Allocate an entry function. See 'GHC.StgToJS.hs' for the object layout. allocDynamicE :: Bool -- ^ csInlineAlloc from StgToJSConfig ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -900,7 +900,7 @@ caseCond = \case DataAlt da -> return $ Just (toJExpr $ dataConTag da) LitAlt l -> genLit l >>= \case [e] -> pure (Just e) - es -> pprPanic "caseCond: expected single-variable literal" (ppr $ fmap satJExpr es) + es -> pprPanic "caseCond: expected single-variable literal" (ppr $ satJExpr Nothing <$> es) -- fixme use single tmp var for all branches -- | Load parameters from constructor ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,8 +177,8 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a -saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) +saturateFFI :: Int -> JStat -> Sat.JStat +saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack => ExprCtx ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (satJStat Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,8 +299,8 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat -rtsDecls = jsSaturate (Just "h$RTSD") $ +rtsDecls :: Sat.JStat +rtsDecls = satJStat (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -314,15 +315,15 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat -rts = jsSaturate (Just "h$RTS") . rts' +rts :: StgToJSConfig -> Sat.JStat +rts = satJStat (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/092d2d82f053359cc29275b9ba21272395bf16e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/092d2d82f053359cc29275b9ba21272395bf16e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 10:40:00 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 04 May 2023 06:40:00 -0400 Subject: [Git][ghc/ghc][wip/unitidset] Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) Message-ID: <64538b80e3096_e3e0651f041385f3@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: ddbb211e by Josh Meredith at 2023-05-04T10:39:38+00:00 Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) - - - - - 21 changed files: - compiler/GHC.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -395,6 +395,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -418,8 +419,6 @@ import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as S import qualified Data.Sequence as Seq import System.Directory @@ -604,7 +603,7 @@ setSessionDynFlags dflags0 = do logger <- getLogger dflags <- checkNewDynFlags logger dflags0 let all_uids = hsc_all_home_unit_ids hsc_env - case S.toList all_uids of + case uniqDSetToList all_uids of [uid] -> do setUnitDynFlagsNoCheck uid dflags modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags)) @@ -1379,7 +1378,7 @@ data ModuleInfo = ModuleInfo { -- | Request information about a loaded 'Module' getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X getModuleInfo mdl = withSession $ \hsc_env -> do - if moduleUnitId mdl `S.member` hsc_all_home_unit_ids hsc_env + if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env then liftIO $ getHomeModuleInfo hsc_env mdl else liftIO $ getPackageModuleInfo hsc_env mdl @@ -1756,7 +1755,7 @@ isModuleTrusted m = withSession $ \hsc_env -> liftIO $ hscCheckSafe hsc_env m noSrcSpan -- | Return if a module is trusted and the pkgs it depends on to be trusted. -moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId) +moduleTrustReqs :: GhcMonad m => Module -> m (Bool, UnitIdSet) moduleTrustReqs m = withSession $ \hsc_env -> liftIO $ hscGetSafe hsc_env m noSrcSpan ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -56,12 +56,11 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre import GHC.Types.ForeignStubs import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) +import GHC.Types.Unique.DSet import System.Directory import System.FilePath import System.IO -import Data.Set (Set) -import qualified Data.Set as Set {- ************************************************************************ @@ -84,7 +83,7 @@ codeOutput -> (a -> ForeignStubs) -> [(ForeignSrcLang, FilePath)] -- ^ additional files to be compiled with the C compiler - -> Set UnitId -- ^ Dependencies + -> UnitIdSet -- ^ Dependencies -> Stream IO RawCmmGroup a -- Compiled C-- -> IO (FilePath, (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}), @@ -161,11 +160,11 @@ outputC :: Logger -> DynFlags -> FilePath -> Stream IO RawCmmGroup a - -> Set UnitId + -> UnitIdSet -> IO a outputC logger dflags filenm cmm_stream unit_deps = withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do - let pkg_names = map unitIdString (Set.toAscList unit_deps) + let pkg_names = map unitIdString (uniqDSetToAscList unit_deps) doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h "#include \"Stg.h\"\n" ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -127,7 +127,7 @@ hsc_HUE = ue_currentHomeUnitEnv . hsc_unit_env hsc_HUG :: HscEnv -> HomeUnitGraph hsc_HUG = ue_home_unit_graph . hsc_unit_env -hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId +hsc_all_home_unit_ids :: HscEnv -> UnitIdSet hsc_all_home_unit_ids = unitEnv_keys . hsc_HUG hscUpdateHPT_lazy :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -245,6 +245,7 @@ import GHC.Types.Name.Ppr import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.TyThing import GHC.Types.HpcInfo +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint ( Fingerprint ) import GHC.Utils.Panic @@ -274,7 +275,6 @@ import Data.IORef import System.FilePath as FilePath import System.Directory import qualified Data.Set as S -import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) @@ -1457,15 +1457,15 @@ checkSafeImports tcg_env clearDiagnostics -- Check safe imports are correct - safePkgs <- S.fromList <$> mapMaybeM checkSafe safeImps + safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps safeErrs <- getDiagnostics clearDiagnostics -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] (infErrs, infPkgs) <- case (safeInferOn dflags) of - False -> return (emptyMessages, S.empty) - True -> do infPkgs <- S.fromList <$> mapMaybeM checkSafe regImps + False -> return (emptyMessages, emptyUniqDSet) + True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps infErrs <- getDiagnostics clearDiagnostics return (infErrs, infPkgs) @@ -1516,12 +1516,12 @@ checkSafeImports tcg_env checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l -- what pkg's to add to our trust requirements - pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId -> + pkgTrustReqs :: DynFlags -> UnitIdSet -> UnitIdSet -> Bool -> ImportAvails pkgTrustReqs dflags req inf infPassed | safeInferOn dflags && not (safeHaskellModeEnabled dflags) && infPassed = emptyImportAvails { - imp_trust_pkgs = req `S.union` inf + imp_trust_pkgs = req `unionUniqDSets` inf } pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe = emptyImportAvails @@ -1540,12 +1540,12 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do return $ isEmptyMessages errs -- | Return if a module is trusted and the pkgs it depends on to be trusted. -hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId) +hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, UnitIdSet) hscGetSafe hsc_env m l = runHsc hsc_env $ do (self, pkgs) <- hscCheckSafe' m l good <- isEmptyMessages `fmap` getDiagnostics clearDiagnostics -- don't want them printed... - let pkgs' | Just p <- self = S.insert p pkgs + let pkgs' | Just p <- self = addOneToUniqDSet pkgs p | otherwise = pkgs return (good, pkgs') @@ -1554,7 +1554,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do -- own package be trusted and a list of other packages required to be trusted -- (these later ones haven't been checked) but the own package trust has been. hscCheckSafe' :: Module -> SrcSpan - -> Hsc (Maybe UnitId, Set UnitId) + -> Hsc (Maybe UnitId, UnitIdSet) hscCheckSafe' m l = do hsc_env <- getHscEnv let home_unit = hsc_home_unit hsc_env @@ -1566,7 +1566,7 @@ hscCheckSafe' m l = do -- Not necessary if that is reflected in dependencies | otherwise -> return (Just $ toUnitId (moduleUnit m), pkgs) where - isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId) + isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, UnitIdSet) isModSafe home_unit m l = do hsc_env <- getHscEnv dflags <- getDynFlags @@ -1648,10 +1648,10 @@ hscCheckSafe' m l = do -- | Check the list of packages are trusted. -checkPkgTrust :: Set UnitId -> Hsc () +checkPkgTrust :: UnitIdSet -> Hsc () checkPkgTrust pkgs = do hsc_env <- getHscEnv - let errors = S.foldr go emptyBag pkgs + let errors = foldr go emptyBag $ uniqDSetToList pkgs state = hsc_units hsc_env go pkg acc | unitIsTrusted $ unsafeLookupUnitId state pkg @@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do False -> return tcg_env where - wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = S.empty } + wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet } pprMod = ppr $ moduleName $ tcg_mod tcg_env whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" @@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs in NoStubs `appendStubC` ip_init | otherwise = NoStubs (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) - <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty + <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet rawCmms return stub_c_exists where ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -107,6 +107,7 @@ import GHC.Types.SourceFile import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Types.PkgQual import GHC.Unit @@ -490,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much mkBatchMsg :: HscEnv -> Messager mkBatchMsg hsc_env = - if length (hsc_all_home_unit_ids hsc_env) > 1 + if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 -- This also displays what unit each module is from. then batchMultiMsg else batchMsg @@ -1735,25 +1736,25 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- This function checks then important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -checkHomeUnitsClosed :: UnitEnv -> Set.Set UnitId -> [(UnitId, UnitId)] -> [DriverMessages] +checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages] -- Fast path, trivially closed. checkHomeUnitsClosed ue home_id_set home_imp_ids - | Set.size home_id_set == 1 = [] + | sizeUniqDSet home_id_set == 1 = [] | otherwise = - let res = foldMap loop home_imp_ids + let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids -- Now check whether everything which transitively depends on a home_unit is actually a home_unit -- These units are the ones which we need to load as home packages but failed to do for some reason, -- it's a bug in the tool invoking GHC. - bad_unit_ids = Set.difference res home_id_set - in if Set.null bad_unit_ids + bad_unit_ids = res `minusUniqDSet` home_id_set + in if isEmptyUniqDSet bad_unit_ids then [] - else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)] + else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)] where rootLoc = mkGeneralSrcSpan (fsLit "") -- TODO: This could repeat quite a bit of work but I struggled to write this function. -- Which units transitively depend on a home unit - loop :: (UnitId, UnitId) -> Set.Set UnitId -- The units which transitively depend on a home unit + loop :: (UnitId, UnitId) -> UnitIdSet -- The units which transitively depend on a home unit loop (from_uid, uid) = let us = ue_findHomeUnitEnv from_uid ue in let um = unitInfoMap (homeUnitEnv_units us) in @@ -1761,20 +1762,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids Nothing -> pprPanic "uid not found" (ppr uid) Just ui -> let depends = unitDepends ui - home_depends = Set.fromList depends `Set.intersection` home_id_set - other_depends = Set.fromList depends `Set.difference` home_id_set + home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set + other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set in -- Case 1: The unit directly depends on a home_id - if not (null home_depends) + if not (isEmptyUniqDSet home_depends) then - let res = foldMap (loop . (from_uid,)) other_depends - in Set.insert uid res + let res :: UnitIdSet + res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends + in addOneToUniqDSet res uid -- Case 2: Check the rest of the dependencies, and then see if any of them depended on else - let res = foldMap (loop . (from_uid,)) other_depends + let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends in - if not (Set.null res) - then Set.insert uid res + if not (isEmptyUniqDSet res) + then addOneToUniqDSet res uid else res -- | Update the every ModSummary that is depended on ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -108,6 +108,7 @@ import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceError +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -125,7 +126,7 @@ import Control.Monad import qualified Control.Monad.Catch as MC (handle) import Data.Maybe import Data.Either ( partitionEithers ) -import qualified Data.Set as Set +import Data.List ( sort ) import Data.Time ( getCurrentTime ) import GHC.Iface.Recomp @@ -408,8 +409,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt home_mod_infos = eltsHpt hpt -- the packages we depend on - pkg_deps = Set.toList - $ Set.unions + pkg_deps = uniqDSetToList + $ unionManyUniqDSets $ fmap (dep_direct_pkgs . mi_deps . hm_iface) $ home_mod_infos @@ -418,7 +419,7 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt debugTraceMsg logger 3 (text "link: hmi ..." $$ vcat (map (ppr . mi_module . hm_iface) home_mod_infos)) debugTraceMsg logger 3 (text "link: linkables are ..." $$ vcat (map ppr linkables)) - debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr pkg_deps)) + debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr $ sort pkg_deps)) -- check for the -no-link flag if isNoLink (ghcLink dflags) ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -40,7 +41,6 @@ import Data.IORef import Data.List (sortBy) import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.Set as Set import GHC.Linker.Types import GHC.Unit.Finder @@ -196,7 +196,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do mk_mod_usage_info :: UsageConfig -> HomeUnit - -> Set.Set UnitId + -> UnitIdSet -> Module -> ImportedMods -> NameSet @@ -255,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names -- (need to recompile if its export list changes: export_fprint) mkUsage :: Module -> ModIface -> Maybe Usage mkUsage mod iface - | toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids + | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -504,7 +504,7 @@ loadInterface doc_str mod from -- overlapping instances. ; massertPpr ((isOneShot (ghcMode (hsc_dflags hsc_env))) - || moduleUnitId mod `notElem` hsc_all_home_unit_ids hsc_env + || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env) || mod == gHC_PRIM) (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Types.SrcLoc import GHC.Types.Unique.Set import GHC.Types.Fixity.Env import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.State @@ -617,8 +618,8 @@ checkDependencies hsc_env summary iface all_home_units = hsc_all_home_unit_ids hsc_env units = hsc_units hsc_env prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) + prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) @@ -633,7 +634,7 @@ checkDependencies hsc_env summary iface classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) + | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -324,20 +324,20 @@ loadCmdLineLibs interp hsc_env = do loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState loadCmdLineLibs' interp hsc_env pls = snd <$> foldM - (\(done', pls') cur_uid -> load done' cur_uid pls') - (Set.empty, pls) - (hsc_all_home_unit_ids hsc_env) + (\(done', pls') cur_uid -> load done' cur_uid pls') + (emptyUniqDSet, pls) + (uniqDSetToList $ hsc_all_home_unit_ids hsc_env) where - load :: Set.Set UnitId -> UnitId -> LoaderState -> IO (Set.Set UnitId, LoaderState) - load done uid pls | uid `Set.member` done = return (done, pls) + load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState) + load done uid pls | uid `elementOfUniqDSet` done = return (done, pls) load done uid pls = do let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) - (homeUnitDepends (hsc_units hsc')) + (homeUnitDepends (hsc_units hsc')) pls'' <- loadCmdLineLibs'' interp hsc' pls' - return $ (Set.insert uid done', pls'') + return $ (addOneToUniqDSet done' uid, pls'') loadCmdLineLibs'' :: Interp @@ -685,7 +685,7 @@ getLinkDeps :: HscEnv -> Maybe FilePath -- replace object suffixes? -> SrcSpan -- for error messages -> [Module] -- If you need these - -> IO ([Linkable], [Linkable], [UnitId], UniqDSet UnitId) -- ... then link these first + -> IO ([Linkable], [Linkable], [UnitId], UnitIdSet) -- ... then link these first -- The module and package dependencies for the needed modules are returned. -- See Note [Object File Dependencies] -- Fails with an IO exception if it can't find enough files @@ -737,7 +737,7 @@ getLinkDeps hsc_env pls replace_osuf span mods -- It is also a matter of correctness to use the module graph so that dependencies between home units -- is resolved correctly. - make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) + make_deps_loop :: (UnitIdSet, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UnitIdSet, Set.Set NodeKey) make_deps_loop found [] = found make_deps_loop found@(found_units, found_mods) (nk:nexts) | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts @@ -766,7 +766,7 @@ getLinkDeps hsc_env pls replace_osuf span mods HsBootFile -> link_boot_mod_error (mi_module iface) _ -> return $ Just (mi_module iface) - in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod + in (dep_direct_pkgs (mi_deps iface),) <$> mmod Nothing -> let err = text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid in throwGhcExceptionIO (ProgramError (showSDoc dflags err)) @@ -780,9 +780,9 @@ getLinkDeps hsc_env pls replace_osuf span mods -- dependencies of that. Hence we need to traverse the dependency -- tree recursively. See bug #936, testcase ghci/prog007. follow_deps :: [Module] -- modules to follow - -> UniqDSet Module -- accum. module dependencies - -> UniqDSet UnitId -- accum. package dependencies - -> IO ([Module], UniqDSet UnitId) -- result + -> UniqDSet Module -- accum. module dependencies + -> UnitIdSet -- accum. package dependencies + -> IO ([Module], UnitIdSet) -- result follow_deps [] acc_mods acc_pkgs = return (uniqDSetToList acc_mods, acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs @@ -814,7 +814,7 @@ getLinkDeps hsc_env pls replace_osuf span mods acc_mods' = case hsc_home_unit_maybe hsc_env of Nothing -> acc_mods Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) + acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps) case hsc_home_unit_maybe hsc_env of Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Linker.Types where import GHC.Prelude -import GHC.Unit ( UnitId, Module ) +import GHC.Unit ( UnitId, Module, UnitIdSet ) import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) import GHC.Fingerprint.Type ( Fingerprint ) import GHCi.RemoteTypes ( ForeignHValue ) @@ -53,7 +53,6 @@ import Control.Concurrent.MVar import Data.Time ( UTCTime ) import Data.Maybe import GHC.Unit.Module.Env -import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Unit.Module.WholeCoreBindings @@ -146,7 +145,7 @@ data LoadedPkgInfo { loaded_pkg_uid :: !UnitId , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] - , loaded_pkg_trans_deps :: UniqDSet UnitId + , loaded_pkg_trans_deps :: UnitIdSet } instance Outputable LoadedPkgInfo where ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Types.Id import GHC.Types.HpcInfo import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Module.Warnings @@ -212,8 +213,8 @@ rnImports imports = do let merged_import_avail = clobberSourceImports imp_avails dflags <- getDynFlags let final_import_avail = - merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags) - `S.union` imp_dep_direct_pkgs merged_import_avail} + merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags) + `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail} return (decls, rdr_env, final_import_avail, hpc_usage) where @@ -480,7 +481,7 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of -- | Calculate the 'ImportAvails' induced by an import of a particular -- interface, but without 'imp_mods'. calculateAvails :: HomeUnit - -> S.Set UnitId + -> UnitIdSet -> ModIface -> IsSafeImport -> IsBootInterface @@ -535,7 +536,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by -- Trusted packages are a lot like orphans. trusted_pkgs | mod_safe' = dep_trusted_pkgs deps - | otherwise = S.empty + | otherwise = emptyUniqDSet pkg = moduleUnit (mi_module iface) @@ -548,11 +549,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by | isHomeUnit home_unit pkg = ptrust | otherwise = False - dependent_pkgs = if toUnitId pkg `S.member` other_home_units - then S.empty - else S.singleton ipkg + dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units + then emptyUniqDSet + else unitUniqDSet ipkg - direct_mods = mkModDeps $ if toUnitId pkg `S.member` other_home_units + direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) else S.empty ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -148,6 +148,7 @@ import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -185,7 +186,6 @@ import Data.List ( sortBy, sort ) import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE import Data.Ord -import qualified Data.Set as S import Data.Traversable ( for ) @@ -3134,7 +3134,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports) , text "Dependent packages:" <+> - ppr (S.toList $ imp_dep_direct_pkgs imports)] + ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)] -- The use of sort is just to reduce unnecessary -- wobbling in testsuite output ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -142,6 +142,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Basic import GHC.Types.CostCentre.State import GHC.Types.HpcInfo @@ -1367,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_direct_dep_mods = emptyInstalledModuleEnv, - imp_dep_direct_pkgs = S.empty, + imp_dep_direct_pkgs = emptyUniqDSet, imp_sig_mods = [], - imp_trust_pkgs = S.empty, + imp_trust_pkgs = emptyUniqDSet, imp_trust_own_pkg = False, imp_boot_mods = emptyInstalledModuleEnv, imp_orphs = [], @@ -1398,8 +1399,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, - imp_dep_direct_pkgs = ddpkgs1 `S.union` ddpkgs2, - imp_trust_pkgs = tpkgs1 `S.union` tpkgs2, + imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2, + imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, ===================================== compiler/GHC/Types/Unique/DSet.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Types.Unique.DSet ( isEmptyUniqDSet, lookupUniqDSet, uniqDSetToList, + uniqDSetToAscList, partitionUniqDSet, mapUniqDSet ) where @@ -43,8 +44,11 @@ import GHC.Types.Unique.DFM import GHC.Types.Unique.Set import GHC.Types.Unique +import GHC.Utils.Binary + import Data.Coerce import Data.Data +import Data.List (sort) -- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here. -- Beyond preserving invariants, we may also want to 'override' typeclass @@ -120,6 +124,9 @@ lookupUniqDSet = lookupUDFM . getUniqDSet uniqDSetToList :: UniqDSet a -> [a] uniqDSetToList = eltsUDFM . getUniqDSet +uniqDSetToAscList :: Ord a => UniqDSet a -> [a] +uniqDSetToAscList = sort . uniqDSetToList + partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a) partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet @@ -140,3 +147,7 @@ instance Outputable a => Outputable (UniqDSet a) where pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList + +instance (Uniquable a, Binary a, Ord a) => Binary (UniqDSet a) where + put_ bh = put_ bh . uniqDSetToAscList + get bh = mkUniqDSet <$> get bh ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -81,6 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.Session import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) +import GHC.Types.Unique.DSet import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -339,8 +340,8 @@ unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env) unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env -unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey -unitEnv_keys env = Map.keysSet (unitEnv_graph env) +unitEnv_keys :: UnitEnvGraph v -> UnitIdSet +unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) @@ -443,7 +444,7 @@ ue_unitHomeUnit_maybe uid ue_env = ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env -ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId +ue_all_home_unit_ids :: UnitEnv -> UnitIdSet ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph -- ------------------------------------------------------- -- Query and modify the currently active unit ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -28,6 +28,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -53,13 +54,13 @@ data Dependencies = Deps -- ^ All home-package modules which are directly imported by this one. -- This may include modules from other units when using multiple home units - , dep_direct_pkgs :: Set UnitId + , dep_direct_pkgs :: UnitIdSet -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. -- Does not include other home units when using multiple home units. -- Modules from these units will go in `dep_direct_mods` - , dep_plugin_pkgs :: Set UnitId + , dep_plugin_pkgs :: UnitIdSet -- ^ All units needed for plugins ------------------------------------ @@ -69,7 +70,7 @@ data Dependencies = Deps -- ^ Transitive closure of hsig files in the home package - , dep_trusted_pkgs :: Set UnitId + , dep_trusted_pkgs :: UnitIdSet -- Packages which we are required to trust -- when the module is imported as a safe import -- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names @@ -110,7 +111,7 @@ data Dependencies = Deps mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods - plugin_units = Set.fromList (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -197,12 +198,12 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps - { dep_direct_mods = Set.empty - , dep_direct_pkgs = Set.empty - , dep_plugin_pkgs = Set.empty + { dep_direct_mods = mempty + , dep_direct_pkgs = emptyUniqDSet + , dep_plugin_pkgs = emptyUniqDSet , dep_sig_mods = [] - , dep_boot_mods = Set.empty - , dep_trusted_pkgs = Set.empty + , dep_boot_mods = mempty + , dep_trusted_pkgs = emptyUniqDSet , dep_orphs = [] , dep_finsts = [] } @@ -220,11 +221,11 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods = pprWithUnitState unit_state $ vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods, text "boot module dependencies:" <+> ppr_set ppr bmods, - text "direct package dependencies:" <+> ppr_set ppr pkgs, - text "plugin package dependencies:" <+> ppr_set ppr plgns, - if null tps + text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, + text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, + if isEmptyUniqDSet tps then empty - else text "trusted package dependencies:" <+> ppr_set ppr tps, + else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), text "family instance modules:" <+> fsep (map ppr finsts) ] @@ -235,6 +236,9 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc ppr_set w = fsep . fmap w . Set.toAscList + ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc + ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance -- @@ -491,7 +495,7 @@ data ImportAvails imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot, -- ^ Home-package modules directly imported by the module being compiled. - imp_dep_direct_pkgs :: Set UnitId, + imp_dep_direct_pkgs :: UnitIdSet, -- ^ Packages directly needed by the module being compiled imp_trust_own_pkg :: Bool, @@ -502,7 +506,7 @@ data ImportAvails -- Transitive information below here - imp_trust_pkgs :: Set UnitId, + imp_trust_pkgs :: UnitIdSet, -- ^ This records the -- packages the current module needs to trust for Safe Haskell -- compilation to succeed. A package is required to be trusted if ===================================== compiler/GHC/Unit/Module/ModGuts.hs ===================================== @@ -37,8 +37,6 @@ import GHC.Types.SourceFile ( HscSource(..), hscSourceToIsBoot ) import GHC.Types.SrcLoc import GHC.Types.CostCentre -import Data.Set (Set) - -- | A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module @@ -137,7 +135,7 @@ data CgGuts cg_ccs :: [CostCentre], -- List of cost centres used in bindings and rules cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs cg_foreign_files :: ![(ForeignSrcLang, FilePath)], - cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to + cg_dep_pkgs :: !UnitIdSet, -- ^ Dependent packages, used to -- generate #includes for C code gen cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -346,10 +346,10 @@ data UnitConfig = UnitConfig , unitConfigFlagsIgnored :: [IgnorePackageFlag] -- ^ Ignored units , unitConfigFlagsTrusted :: [TrustFlag] -- ^ Trusted units , unitConfigFlagsPlugins :: [PackageFlag] -- ^ Plugins exposed units - , unitConfigHomeUnits :: Set.Set UnitId + , unitConfigHomeUnits :: UnitIdSet } -initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig +initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> UnitConfig initUnitConfig dflags cached_dbs home_units = let !hu_id = homeUnitId_ dflags !hu_instanceof = homeUnitInstanceOf_ dflags @@ -626,7 +626,7 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) +initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) initUnits logger dflags cached_dbs home_units = do let forceUnitInfoMap (state, _) = unitInfoMap state `seq` () @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (Set.toList override_set) $ \pkg -> + forM_ (uniqDSetToList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1374,9 +1374,9 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- The set of UnitIds which appear in both db and pkgs. These are the -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 - override_set :: Set UnitId - override_set = Set.intersection (nonDetUniqMapToKeySet db_map) - (nonDetUniqMapToKeySet pkg_map) + override_set :: UnitIdSet + override_set = intersectUniqDSets (mkUniqDSet $ nonDetKeysUniqMap db_map) + (mkUniqDSet $ nonDetKeysUniqMap pkg_map) -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1688,7 +1688,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = Set.toList home_unit_deps + , homeUnitDepends = uniqDSetToList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,15 +1701,15 @@ mkUnitState logger cfg = do } return (state, raw_dbs) -selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True +selectHptFlag :: UnitIdSet -> PackageFlag -> Bool +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True selectHptFlag _ _ = False -selectHomeUnits :: Set.Set UnitId -> [PackageFlag] -> Set.Set UnitId -selectHomeUnits home_units flags = foldl' go Set.empty flags +selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet +selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags where - go :: Set.Set UnitId -> PackageFlag -> Set.Set UnitId - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = Set.insert (toUnitId uid) cur + go :: UnitIdSet -> PackageFlag -> UnitIdSet + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Unit.Types , GenInstantiatedUnit (..) , InstantiatedUnit , DefUnitId + , UnitIdSet , Instantiations , GenInstantiations , mkInstantiatedUnit @@ -538,6 +539,8 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId +type UnitIdSet = UniqDSet UnitId + unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS ===================================== ghc/GHCi/UI.hs ===================================== @@ -105,6 +105,7 @@ import GHC.Utils.Misc import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Bag (unitBag) import qualified GHC.Data.Strict as Strict +import GHC.Types.Unique.DSet -- Haskell Libraries import System.Console.Haskeline as Haskeline @@ -125,7 +126,6 @@ import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) import Data.List ( elemIndices, find, intercalate, intersperse, minimumBy, isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) ) import qualified Data.List.NonEmpty as NE -import qualified Data.Set as S import Data.Maybe import qualified Data.Map as M import Data.IntMap.Strict (IntMap) @@ -561,7 +561,7 @@ interactiveUI config srcs maybe_exprs = do -- Set to True because Prelude is implicitly imported. impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession - let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 + let in_multi = sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 empty_cache <- liftIO newIfaceCache startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, @@ -2568,15 +2568,15 @@ isSafeModule m = do -- print info to user... liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")" liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off") - when (not $ S.null good) + when (not $ isEmptyUniqDSet good) (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++ - (intercalate ", " $ map (showPpr dflags) (S.toList good))) - case msafe && S.null bad of + (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good))) + case msafe && isEmptyUniqDSet bad of True -> liftIO $ putStrLn $ mname ++ " is trusted!" False -> do - when (not $ null bad) + when (not $ isEmptyUniqDSet bad) (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): " - ++ (intercalate ", " $ map (showPpr dflags) (S.toList bad))) + ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad))) liftIO $ putStrLn $ mname ++ " is NOT trusted!" where @@ -2586,8 +2586,8 @@ isSafeModule m = do | isHomeModule (hsc_home_unit hsc_env) md = True | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) - tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty) - | otherwise = S.partition part deps + tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet) + | otherwise = partitionUniqDSet part deps where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddbb211eb3625cfbc8fe5a7f55fef1ee2cea34d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddbb211eb3625cfbc8fe5a7f55fef1ee2cea34d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 11:21:54 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 04 May 2023 07:21:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23221 Message-ID: <645395524e07a_e3e063a20fc814733@gitlab.mail> Matthew Pickering pushed new branch wip/t23221 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23221 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 14:28:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 10:28:13 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6453c0fd4978d_e3e063a20fc8196449@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fbd74575 by Matthew Pickering at 2023-05-04T10:27:53-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 5b0cd6ef by romes at 2023-05-04T10:27:53-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 8838f72d by romes at 2023-05-04T10:27:53-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db41b5c7 by romes at 2023-05-04T10:27:53-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - b7e6f986 by Matthew Pickering at 2023-05-04T10:27:53-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 8aad6409 by Josh Meredith at 2023-05-04T10:27:54-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - a3784070 by Sylvain Henry at 2023-05-04T10:27:54-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - da3458d5 by Luite Stegeman at 2023-05-04T10:27:58-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - 17593bd2 by Josh Meredith at 2023-05-04T10:27:59-04:00 base/encoding: add an allocations performance test (#22946) - - - - - 578a0500 by Krzysztof Gogolewski at 2023-05-04T10:27:59-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 236c2947 by Andrei Borzenkov at 2023-05-04T10:28:04-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 69c7254e by Ryan Scott at 2023-05-04T10:28:04-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 18 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75b31dbc2db28816883e6ec1bc5a573c14b3d0e7...69c7254e382f9ac2b5eaa01cd83a31543fa3cb8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75b31dbc2db28816883e6ec1bc5a573c14b3d0e7...69c7254e382f9ac2b5eaa01cd83a31543fa3cb8a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 14:53:47 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 04 May 2023 10:53:47 -0400 Subject: [Git][ghc/ghc][wip/23305] 3 commits: Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma Message-ID: <6453c6fbb0797_e3e0651f042236d1@gitlab.mail> Matthew Pickering pushed to branch wip/23305 at Glasgow Haskell Compiler / GHC Commits: 306ad553 by Matthew Pickering at 2023-05-04T15:53:37+01:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - 2d6d27de by Matthew Pickering at 2023-05-04T15:53:37+01:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 384c9a2f by Matthew Pickering at 2023-05-04T15:53:37+01:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 9 changed files: - compiler/GHC/Driver/Make.hs - compiler/GHC/Utils/TmpFs.hs - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T23339.hs - + testsuite/tests/driver/T23339.stdout - + testsuite/tests/driver/T23339B.hs - + testsuite/tests/driver/T23339B.stdout - testsuite/tests/driver/all.T - testsuite/tests/ghci/prog018/prog018.stdout Changes: ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -772,16 +772,14 @@ load' mhmi_cache how_much mHscMessage mod_graph = do worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env - (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do + (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do hsc_env <- getSession liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan - setSession hsc_env1 + modifySession (addDepsToHscEnv new_deps) case upsweep_ok of Failed -> loadFinish upsweep_ok Succeeded -> do liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.") - -- Clean up after ourselves - liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags loadFinish upsweep_ok @@ -1250,14 +1248,13 @@ upsweep -> Maybe Messager -> M.Map ModNodeKeyWithUid HomeModInfo -> [BuildPlan] - -> IO (SuccessFlag, HscEnv) + -> IO (SuccessFlag, [HomeModInfo]) upsweep n_jobs hsc_env hmi_cache mHscMessage old_hpt build_plan = do (cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan runPipelines n_jobs hsc_env mHscMessage pipelines res <- collect_result let completed = [m | Just (Just m) <- res] - let hsc_env' = addDepsToHscEnv completed hsc_env -- Handle any cycle in the original compilation graph and return the result -- of the upsweep. @@ -1265,10 +1262,10 @@ upsweep n_jobs hsc_env hmi_cache mHscMessage old_hpt build_plan = do Just mss -> do let logger = hsc_logger hsc_env liftIO $ fatalErrorMsg logger (cyclicModuleErr mss) - return (Failed, hsc_env) + return (Failed, []) Nothing -> do let success_flag = successIf (all isJust res) - return (success_flag, hsc_env') + return (success_flag, completed) toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo toCache hmis = M.fromList ([(miKey $ hm_iface hmi, hmi) | hmi <- hmis]) @@ -2331,18 +2328,21 @@ withDeferredDiagnostics f = do let action = logMsg logger msgClass srcSpan msg case msgClass of MCDiagnostic SevWarning _reason _code - -> atomicModifyIORef' warnings $ \i -> (action: i, ()) + -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ()) MCDiagnostic SevError _reason _code - -> atomicModifyIORef' errors $ \i -> (action: i, ()) + -> atomicModifyIORef' errors $ \(!i) -> (action: i, ()) MCFatal - -> atomicModifyIORef' fatals $ \i -> (action: i, ()) + -> atomicModifyIORef' fatals $ \(!i) -> (action: i, ()) _ -> action printDeferredDiagnostics = liftIO $ forM_ [warnings, errors, fatals] $ \ref -> do -- This IORef can leak when the dflags leaks, so let us always - -- reset the content. - actions <- atomicModifyIORef' ref $ \i -> ([], i) + -- reset the content. The lazy variant is used here as we want to force + -- this error if the IORef is ever accessed again, rather than now. + -- See #20981 for an issue which discusses this general issue. + let landmine = if debugIsOn then panic "withDeferredDiagnostics: use after free" else [] + actions <- atomicModifyIORef ref $ \i -> (landmine, i) sequence_ $ reverse actions MC.bracket @@ -2418,8 +2418,9 @@ cyclicModuleErr mss cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m () cleanCurrentModuleTempFilesMaybe logger tmpfs dflags = - unless (gopt Opt_KeepTmpFiles dflags) $ - liftIO $ cleanCurrentModuleTempFiles logger tmpfs + if gopt Opt_KeepTmpFiles dflags + then liftIO $ keepCurrentModuleTempFiles logger tmpfs + else liftIO $ cleanCurrentModuleTempFiles logger tmpfs addDepsToHscEnv :: [HomeModInfo] -> HscEnv -> HscEnv ===================================== compiler/GHC/Utils/TmpFs.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Utils.TmpFs , cleanTempDirs , cleanTempFiles , cleanCurrentModuleTempFiles + , keepCurrentModuleTempFiles , addFilesToClean , changeTempFilesLifetime , newTempName @@ -172,6 +173,32 @@ cleanTempFiles logger tmpfs , Set.toList cm_paths ++ Set.toList gs_paths) remove to_delete +-- | Keep all the paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ +-- that have lifetime TFL_CurrentModule. This function is used when `-keep-tmp-files` is +-- used in an OPTIONS_GHC pragma. +-- This function removes the temporary file from the TmpFs so we no longer remove +-- it at the env when cleanTempFiles is called. +keepCurrentModuleTempFiles :: HasCallStack => Logger -> TmpFs -> IO () +keepCurrentModuleTempFiles logger tmpfs + = mask_ + $ do to_keep_files <- keep (tmp_files_to_clean tmpfs) + to_keep_subdirs <- keep (tmp_subdirs_to_clean tmpfs) + -- Remove any folders which contain any files we want to keep from the + -- directories we are tracking. A new temporary directory will be created + -- the next time a temporary file is needed (by perhaps another module). + keepDirs (to_keep_files ++ to_keep_subdirs) (tmp_dirs_to_clean tmpfs) + where + keepDirs keeps ref = do + let keep_dirs = Set.fromList (map takeDirectory keeps) + atomicModifyIORef' ref $ \m -> (Map.filter (\fp -> fp `Set.notMember` keep_dirs) m, ()) + + keep ref = do + to_keep <- atomicModifyIORef' ref $ + \ptc at PathsToClean{ptcCurrentModule = cm_paths} -> + (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths) + debugTraceMsg logger 2 (text "Keeping:" <+> hsep (map text to_keep)) + return to_keep + -- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ -- That have lifetime TFL_CurrentModule. -- If a file must be cleaned eventually, but must survive a ===================================== testsuite/tests/driver/Makefile ===================================== @@ -792,4 +792,21 @@ T22669: ! test -f T22669.o-boot +T23339: + $(RM) T23339.hi + $(RM) T23339$(OBJSUFFIX) + $(RM) -rf "$(PWD)/tmp" + mkdir -p tmp + TMPDIR="$(PWD)/tmp" "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T23339.hs + find . -name "*.c" -exec cat {} \; | grep "init__ip_init" + +T23339B: + $(RM) T23339.hi + $(RM) T23339$(OBJSUFFIX) + $(RM) -rf "$(PWD)/tmp" + mkdir -p tmp + TMPDIR="$(PWD)/tmp" "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T23339B.hs -finfo-table-map + # Check that the file is kept and is the right one + find . -name "*.c" -exec cat {} \; | grep "init__ip_init" + ===================================== testsuite/tests/driver/T23339.hs ===================================== @@ -0,0 +1,4 @@ +{-# OPTIONS_GHC -keep-tmp-files -finfo-table-map #-} +module T23339 where + +defn = id "T23339" ===================================== testsuite/tests/driver/T23339.stdout ===================================== @@ -0,0 +1 @@ +void T23339_init__ip_init (void) ===================================== testsuite/tests/driver/T23339B.hs ===================================== @@ -0,0 +1,5 @@ +module T23339B where + +import T23339 + +qux = id "abc" ===================================== testsuite/tests/driver/T23339B.stdout ===================================== @@ -0,0 +1 @@ +void T23339_init__ip_init (void) ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,3 +320,5 @@ test('T22044', normal, makefile_test, []) test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) test('T21722', normal, compile_fail, ['-fno-show-error-context']) test('T22669', js_skip, makefile_test, []) +test('T23339', js_skip, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) ===================================== testsuite/tests/ghci/prog018/prog018.stdout ===================================== @@ -19,4 +19,7 @@ C.hs:6:7: error: [GHC-88464] Variable not in scope: variableNotInScope :: () Failed, two modules loaded. [3 of 3] Compiling C ( C.hs, interpreted ) + +C.hs:6:7: error: [GHC-88464] + Variable not in scope: variableNotInScope :: () Failed, two modules loaded. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90045770e4b744ac5793dce0aafd651677378265...384c9a2f0ce460d2f167f2dfc9fe6d823db580e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90045770e4b744ac5793dce0aafd651677378265...384c9a2f0ce460d2f167f2dfc9fe6d823db580e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 17:25:44 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Thu, 04 May 2023 13:25:44 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Add missing bang patterns to StackFrames Message-ID: <6453ea9852bec_e3e063c09fc4247045@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 8420e1d7 by Sven Tennie at 2023-05-04T16:19:55+00:00 Add missing bang patterns to StackFrames - - - - - 03425236 by Sven Tennie at 2023-05-04T17:25:00+00:00 Try more general data structure - - - - - 2 changed files: - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Stack/Decode.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -20,8 +20,12 @@ module GHC.Exts.Heap.Closures ( , closureSize -- * Stack - , StgStackClosure(..) - , StackFrame(..) + , StgStackClosure + , GenStgStackClosure(..) + , StackFrame + , GenStackFrame(..) + , StackField + , GenStackField(..) -- * Boxes , Box(..) @@ -374,54 +378,63 @@ data GenClosure b -- primitives and one for closures. This turned out to be a nightmare with lots -- of pattern matches and leaking data structures to enable access to primitives -- on the stack... -data StgStackClosure = StgStackClosure +type StgStackClosure = GenStgStackClosure Box + +data GenStgStackClosure b = GenStgStackClosure { ssc_info :: !StgInfoTable , ssc_stack_size :: !Word32 -- ^ stack size in *words* , ssc_stack_dirty :: !Word8 -- ^ non-zero => dirty , ssc_stack_marking :: !Word8 - , ssc_stack :: ![StackFrame] + , ssc_stack :: ![GenStackFrame b] } - deriving Show + deriving (Show, Generic) + +type StackField = GenStackField Box + +data GenStackField b + -- | A non-pointer field + = StackWord !Word + -- | A pointer field + | StackBox !b + deriving (Show, Generic) + +type StackFrame = GenStackFrame Box -- | A single stack frame --- --- It doesn't use `Box`es because that would require a `Box` constructor for --- primitive values (bitmap encoded payloads), which introduces lots of pattern --- matches and complicates the whole implementation (and breaks existing code.) -data StackFrame = +data GenStackFrame b = UpdateFrame { info_tbl :: !StgInfoTable - , updatee :: !Closure + , updatee :: !b } | CatchFrame { info_tbl :: !StgInfoTable - , exceptions_blocked :: Word - , handler :: !Closure + , exceptions_blocked :: !Word + , handler :: !b } | CatchStmFrame { info_tbl :: !StgInfoTable - , catchFrameCode :: !Closure - , handler :: !Closure + , catchFrameCode :: !b + , handler :: !b } | CatchRetryFrame { info_tbl :: !StgInfoTable , running_alt_code :: !Word - , first_code :: !Closure - , alt_code :: !Closure + , first_code :: !b + , alt_code :: !b } | AtomicallyFrame { info_tbl :: !StgInfoTable - , atomicallyFrameCode :: !Closure - , result :: !Closure + , atomicallyFrameCode :: !b + , result :: !b } | UnderflowFrame { info_tbl :: !StgInfoTable - , nextChunk :: !StgStackClosure + , nextChunk :: !(GenStgStackClosure b) } | StopFrame @@ -429,26 +442,26 @@ data StackFrame = | RetSmall { info_tbl :: !StgInfoTable - , stack_payload :: ![Closure] + , stack_payload :: ![GenStackField b] } | RetBig { info_tbl :: !StgInfoTable - , stack_payload :: ![Closure] + , stack_payload :: ![GenStackField b] } | RetFun { info_tbl :: !StgInfoTable - , retFunType :: RetFunType - , retFunSize :: Word - , retFunFun :: !Closure - , retFunPayload :: ![Closure] + , retFunType :: !RetFunType + , retFunSize :: !Word + , retFunFun :: !b + , retFunPayload :: ![GenStackField b] } | RetBCO { info_tbl :: !StgInfoTable - , bco :: !Closure -- must be a BCOClosure - , bcoArgs :: ![Closure] + , bco :: !b -- is always a BCOClosure + , bcoArgs :: ![GenStackField b] } deriving (Show, Generic) ===================================== libraries/ghc-heap/GHC/Exts/Stack/Decode.hs ===================================== @@ -23,14 +23,16 @@ import Data.Bits import Data.Maybe import Foreign import GHC.Exts -import GHC.Exts.Heap (Box (..), getBoxedClosureData) +import GHC.Exts.Heap (Box (..)) import GHC.Exts.Heap.ClosureTypes import GHC.Exts.Heap.Closures - ( Closure, - GenClosure (UnknownTypeWordSizedPrimitive), - RetFunType (..), - StackFrame (..), - StgStackClosure (..), + ( RetFunType (..), + StackFrame, + GenStackFrame (..), + StgStackClosure, + GenStgStackClosure (..), + StackField, + GenStackField(..) ) import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS) import GHC.Exts.Heap.InfoTable @@ -211,20 +213,18 @@ advanceStackFrameLocation ((StackSnapshot stackSnapshot#), index) = primWordToWordOffset :: Word# -> WordOffset primWordToWordOffset w# = fromIntegral (W# w#) -getClosure :: StackSnapshot# -> WordOffset -> IO Closure -getClosure stackSnapshot# index = +getClosureBox :: StackSnapshot# -> WordOffset -> IO Box +getClosureBox stackSnapshot# index = -- Beware! We have to put ptr into a Box immediately. Otherwise, the garbage -- collector might move the referenced closure, without updating our reference -- (pointer) to it. - ( IO $ \s -> + IO $ \s -> case getStackClosure# stackSnapshot# (wordOffsetToWord# index) s of (# s1, ptr #) -> (# s1, Box ptr #) - ) - >>= getBoxedClosureData -- | Representation of @StgLargeBitmap@ (RTS) data LargeBitmap = LargeBitmap @@ -236,7 +236,7 @@ data LargeBitmap = LargeBitmap data Pointerness = Pointer | NonPointer deriving (Show) -decodeLargeBitmap :: LargeBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [Closure] +decodeLargeBitmap :: LargeBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField] decodeLargeBitmap getterFun# stackSnapshot# index relativePayloadOffset = do let largeBitmap = case getterFun# stackSnapshot# (wordOffsetToWord# index) of (# wordsAddr#, size# #) -> LargeBitmap (W# size#) (Ptr wordsAddr#) @@ -276,17 +276,17 @@ bitmapWordPointerness bSize bitmapWord = (bSize - 1) (bitmapWord `shiftR` 1) -decodeBitmaps :: StackSnapshot# -> WordOffset -> [Pointerness] -> IO [Closure] +decodeBitmaps :: StackSnapshot# -> WordOffset -> [Pointerness] -> IO [StackField] decodeBitmaps stack# index ps = zipWithM toPayload ps [index ..] where - toPayload :: Pointerness -> WordOffset -> IO Closure + toPayload :: Pointerness -> WordOffset -> IO StackField toPayload p i = case p of NonPointer -> - pure $ UnknownTypeWordSizedPrimitive (getWord stack# i) - Pointer -> getClosure stack# i + pure $ StackWord (getWord stack# i) + Pointer -> StackBox <$> getClosureBox stack# i -decodeSmallBitmap :: SmallBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [Closure] +decodeSmallBitmap :: SmallBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField] decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset = let (bitmap, size) = case getterFun# stackSnapshot# (wordOffsetToWord# index) of (# b#, s# #) -> (W# b#, W# s#) @@ -304,7 +304,7 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do unpackStackFrame' info = case tipe info of RET_BCO -> do - bco' <- getClosure stackSnapshot# (index + offsetStgClosurePayload) + bco' <- getClosureBox stackSnapshot# (index + offsetStgClosurePayload) -- The arguments begin directly after the payload's one element bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# stackSnapshot# index (offsetStgClosurePayload + 1) pure @@ -330,7 +330,7 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do RET_FUN -> do let retFunType' = getRetFunType stackSnapshot# index retFunSize' = getWord stackSnapshot# (index + offsetStgRetFunFrameSize) - retFunFun' <- getClosure stackSnapshot# (index + offsetStgRetFunFrameFun) + retFunFun' <- getClosureBox stackSnapshot# (index + offsetStgRetFunFrameFun) retFunPayload' <- if retFunType' == ARG_GEN_BIG then decodeLargeBitmap getRetFunLargeBitmap# stackSnapshot# index offsetStgRetFunFramePayload @@ -344,7 +344,7 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do retFunPayload = retFunPayload' } UPDATE_FRAME -> do - updatee' <- getClosure stackSnapshot# (index + offsetStgUpdateFrameUpdatee) + updatee' <- getClosureBox stackSnapshot# (index + offsetStgUpdateFrameUpdatee) pure $ UpdateFrame { info_tbl = info, @@ -352,7 +352,7 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do } CATCH_FRAME -> do let exceptions_blocked' = getWord stackSnapshot# (index + offsetStgCatchFrameExceptionsBlocked) - handler' <- getClosure stackSnapshot# (index + offsetStgCatchFrameHandler) + handler' <- getClosureBox stackSnapshot# (index + offsetStgCatchFrameHandler) pure $ CatchFrame { info_tbl = info, @@ -369,8 +369,8 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do } STOP_FRAME -> pure $ StopFrame {info_tbl = info} ATOMICALLY_FRAME -> do - atomicallyFrameCode' <- getClosure stackSnapshot# (index + offsetStgAtomicallyFrameCode) - result' <- getClosure stackSnapshot# (index + offsetStgAtomicallyFrameResult) + atomicallyFrameCode' <- getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameCode) + result' <- getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameResult) pure $ AtomicallyFrame { info_tbl = info, @@ -379,8 +379,8 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do } CATCH_RETRY_FRAME -> do let running_alt_code' = getWord stackSnapshot# (index + offsetStgCatchRetryFrameRunningAltCode) - first_code' <- getClosure stackSnapshot# (index + offsetStgCatchRetryFrameRunningFirstCode) - alt_code' <- getClosure stackSnapshot# (index + offsetStgCatchRetryFrameAltCode) + first_code' <- getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameRunningFirstCode) + alt_code' <- getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameAltCode) pure $ CatchRetryFrame { info_tbl = info, @@ -389,8 +389,8 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do alt_code = alt_code' } CATCH_STM_FRAME -> do - catchFrameCode' <- getClosure stackSnapshot# (index + offsetStgCatchSTMFrameCode) - handler' <- getClosure stackSnapshot# (index + offsetStgCatchSTMFrameHandler) + catchFrameCode' <- getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameCode) + handler' <- getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameHandler) pure $ CatchStmFrame { info_tbl = info, @@ -430,7 +430,7 @@ decodeStack (StackSnapshot stack#) = do sfls = stackFrameLocations stack# stack' <- mapM unpackStackFrame sfls pure $ - StgStackClosure + GenStgStackClosure { ssc_info = info, ssc_stack_size = stack_size', ssc_stack_dirty = stack_dirty', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc135403e75c95c697d48afc7b085ae757560ca5...03425236b30f2e9bb3ceef58a0e31cc048137da5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc135403e75c95c697d48afc7b085ae757560ca5...03425236b30f2e9bb3ceef58a0e31cc048137da5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 18:58:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 14:58:32 -0400 Subject: [Git][ghc/ghc][master] 5 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <64540058b33fc_e3e0651f042622b5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 12 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8fde4ac84ec7b1ead238cb158bbef48555d12af9...944a9b94ceea429f05f336a035088b1ebd26ddc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8fde4ac84ec7b1ead238cb158bbef48555d12af9...944a9b94ceea429f05f336a035088b1ebd26ddc4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 18:59:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 14:59:26 -0400 Subject: [Git][ghc/ghc][master] 2 commits: JS: fix bounds checking (Issue 23123) Message-ID: <6454008eb8bda_e3e063c09fc42660c1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 10 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/jsbits/base.js - rts/js/environment.js - rts/js/mem.js - rts/js/profiling.js - rts/js/staticpointer.js - rts/js/string.js - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -138,6 +138,10 @@ genCommonCppDefs profiling = mconcat then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing) + , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n" + , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n" + -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n" ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Encoding (zEncodeString) import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr) -import Data.Maybe genPrim :: Bool -- ^ Profiling (cost-centres) enabled @@ -527,218 +526,206 @@ genPrim prof bound ty op = case op of ------------------------------ Arrays ------------------------------------------- - NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e) - ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v) + NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e] + ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v) SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a CopyArrayOp -> \[] [a,o1,ma,o2,n] -> - PrimInline $ loopBlockS (Int 0) (.<. n) \i -> - [ ma .! (Add i o2) |= a .! (Add i o1) - , preIncrS i - ] - CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] - CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n] - FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n] - CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ - jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] + PrimInline + $ bnd_arr_range bound a o1 n + $ bnd_arr_range bound ma o2 n + $ loopBlockS (Int 0) (.<. n) \i -> + [ ma .! (Add i o2) |= a .! (Add i o1) + , preIncrS i + ] + CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> + PrimInline + $ bnd_arr_range bound a1 o1 n + $ bnd_arr_range bound a2 o2 n + $ appS "h$copyMutableArray" [a1,o1,a2,o2,n] + + CloneArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CloneMutableArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + FreezeArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + ThawArrayOp -> \[r] [a,start,n] -> + PrimInline + $ bnd_arr_range bound a start n + $ r |= app "h$sliceArray" [a,start,n] + + CasArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] + ] ------------------------------ Small Arrays ------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e] - ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) - WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e) + ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) + WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e) SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" - IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i) + IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i) UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a - CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ - loopBlockS (Sub n one_) (.>=. zero_) \i -> - [ d .! (Add di i) |= s .! (Add si i) - , postDecrS i + CopySmallArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ loopBlockS (Sub n one_) (.>=. zero_) \i -> + [ d .! (Add di i) |= s .! (Add si i) + , postDecrS i + ] + CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> + PrimInline + $ bnd_arr_range bound s si n + $ bnd_arr_range bound d di n + $ appS "h$copyMutableArray" [s,si,d,di,n] + + CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n + + CasSmallArrayOp -> \[s,o] [a,i,old,new] -> + PrimInline + $ bnd_arr bound a i + $ jVar \x -> mconcat + [ x |= a .! i + , ifBlockS (x .===. old) + [ o |= new + , a .! i |= new + , s |= zero_ + ] + [ s |= one_ + , o |= x + ] ] - CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n] - CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n - CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat - [ x |= a .! i - , ifBlockS (x .===. old) - [ o |= new - , a .! i |= new - , s |= zero_ - ] - [ s |= one_ - , o |= x - ] - ] ------------------------------- Byte Arrays ------------------------------------- - NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) - NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) - MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ - ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] - ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] - ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] - UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b - SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" - IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a i $ jVar \t -> mconcat - [ t |= a .^ "arr" - , ifBlockS (t .&&. t .! (i .<<. two_)) - [ r1 |= t .! (i .<<. two_) .! zero_ - , r2 |= t .! (i .<<. two_) .! one_ - ] - [ r1 |= null_ - , r2 |= zero_ - ] - ] + NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l) + NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l) + MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_ + ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_] + ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] + ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] + UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" + + IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o + ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i + ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i + ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o + ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i + ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i + ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l + ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i + ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i + ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i + ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l + + WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o + WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e + WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e + WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o + WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e + WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e + WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e + WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l + WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e + WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e + WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e + WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l - IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Addr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i - ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i - ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] -> - PrimInline . boundsChecked bound a (Add i 3) $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_i32 a i - ] - ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i - ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i - ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_i32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i - ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i - ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i - ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_u32 a (Add (i .<<. one_) one_) - , l |= read_u32 a (i .<<. one_) - ] - WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e - WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e - WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2 - - WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e - WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e - WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e - WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_i32 a (Add (i .<<. one_) one_) e1 - , write_u32 a (i .<<. one_) e2 - ] - WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e - WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e - WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e - WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ write_u32 a (Add (i .<<. one_) one_) h - , write_u32 a (i .<<. one_) l - ] CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) + PrimInline . bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n] - CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> - PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1)) - . boundsChecked bound a2 (Add o2 (Sub n 1)) - $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] - CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayNonOverlappingOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs - CopyAddrToAddrNonOverlappingOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs + -- We assume the arrays aren't overlapping since they're of different types + -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#) + CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyMutableByteArrayNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyAddrToAddrNonOverlappingOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n + + CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n + CopyAddrToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n SetByteArrayOp -> \[] [a,o,n,v] -> - PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i -> + PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i -> [ write_u8 a (Add o i) v , postIncrS i ] SetAddrRangeOp -> \[] xs@[_a,_o,_n,_v] -> genPrim prof bound ty SetByteArrayOp [] xs - AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i - AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v - FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v - FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v - FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v - FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v - FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v - FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v + AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i + AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v + FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v + FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v + FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v + FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v + FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v + FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v ------------------------------- Addr# ------------------------------------------ @@ -756,107 +743,58 @@ genPrim prof bound ty op = case op of ------------------------------- Addr Indexing: Unboxed Arrays ------------------- - IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] -> - PrimInline . boundsChecked bound (a .^ "arr") (off32 o i) - $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_)) - [ ca |= a .^ "arr" .! (off32 o i) .! zero_ - , co |= a .^ "arr" .! (off32 o i) .! one_ - ] - [ ca |= null_ - , co |= zero_ - ] - IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_i32 a (off32 o i) - ] - IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i) - IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i) - IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i) - IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , l |= read_boff_u32 a (off64 o i) - ] - ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i) - ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i) - ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i) - ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") (Add o x) $ - ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x)) - [ c1 |= a .^ "arr" .! (Add o x) .! zero_ - , c2 |= a .^ "arr" .! (Add o x) .! one_ - ] - [ c1 |= null_ - , c2 |= zero_ - ] - ] - ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i) - ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i) - ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat - [ c1 |= var "h$stablePtrBuf" - , c2 |= read_boff_u32 a (off32 o i) - ] - ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i) - ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i) - ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i) - ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> - PrimInline $ mconcat - [ h |= read_i32 a (Add (off64 o i) (Int 4)) - , l |= read_u32 a (off64 o i) - ] - ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i) - ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i) - ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i) - ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] -> - PrimInline $ mconcat - [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4)) - , c2 |= read_boff_u32 a (off64 o i) - ] - WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (off32 o i) $ - AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo]) - ] - WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v - WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v - WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2 - WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v - WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v - WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v - WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] - WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v - WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v - WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v - WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat - [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1 - , write_boff_u32 a (off64 o i) v2 - ] --- Mutable variables + IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro + ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i) + ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i) + ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro + ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i) + ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i) + ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i) + ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l + ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i) + ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i) + ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i) + ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l + + WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo + WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v + WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v + WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo + WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v + WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v + WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v + WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l + WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v + WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v + WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v + WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l + +------------------------------- Mutable varialbes -------------------------------------- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x]) ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val" WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x @@ -917,17 +855,17 @@ genPrim prof bound ty op = case op of ------------------------------- Concurrency Primitives ------------------------- - ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) - ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument - KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) - YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) - MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" - IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ - NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing - ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] - GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] - LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l + ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) + ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument + KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex]) + YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" []) + MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread" + IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ + NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing + ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] + GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] + LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ------------------------------- Weak Pointers ----------------------------------- @@ -1031,184 +969,82 @@ genPrim prof bound ty op = case op of TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len] TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo] - IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i - ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] -> - PrimInline $ jVar \x -> mconcat - [ x |= i .<<. two_ - , boundsChecked bound (a .^ "arr") x $ - ifS (a .^ "arr" .&&. a .^ "arr" .! x) - (mconcat [ r1 |= a .^ "arr" .! x .! zero_ - , r2 |= a .^ "arr" .! x .! one_ - ]) - (mconcat [r1 |= null_, r2 |= one_]) - ] - ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i - ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i - ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] -> - PrimInline $ mconcat - [ r1 |= var "h$stablePtrBuf" - , r2 |= read_boff_i32 a i - ] - ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i - ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> - PrimInline $ mconcat - [ h |= read_boff_i32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i - ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i - ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> - PrimInline . boundsChecked bound a (Add i 7) $ mconcat - [ h |= read_boff_u32 a (Add i (Int 4)) - , l |= read_boff_u32 a i - ] - ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i - - WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e - WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] -> - PrimInline $ mconcat - [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty - , boundsChecked bound (a .^ "arr") (i .<<. two_) $ - a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2]) - ] - - WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e - WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e - WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2 - WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e - WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> - -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i - -- then write the higher 4 bytes to i+4 - PrimInline . boundsChecked bound a i - $ mconcat [ write_boff_i32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e - WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e - WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> - PrimInline . boundsChecked bound a (Add i 7) - $ mconcat [ write_boff_u32 a (Add i (Int 4)) h - , write_boff_u32 a i l - ] - WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e - - CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new - CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new - CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new - - CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $ - jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_) - , t_l |= read_u32 a (i .<<. one_) - , r_h |= t_h - , r_l |= t_l - , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast - (ifBlockS (t_h .===. old_h) - -- Pre-Condition is good, do the write - [ write_i32 a (Add (i .<<. one_) one_) new_h - , write_u32 a (i .<<. one_) new_l - ] - -- no good, don't write - mempty) - mempty - ] - - CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $ - mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2]) - (appS "h$memcpy" [a3,o3,a1,o1,8]) - mempty - , r_a |= a1 - , r_o |= o1 - ] +------------------------------ ByteArray ------------------- + + IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i + ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o + ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i + ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i + ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o + ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i + ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l + ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i + ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i + ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l + ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i + + WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e + WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o + WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e + WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e + WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o + WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e + WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l + WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e + WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e + WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l + WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e + + CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n + CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n + CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n + + CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl) + + CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no) CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new - CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $ - mconcat [ r_h |= read_u32 a (Add o (Int 4)) - , r_l |= read_u32 a o - , ifS (r_l .===. old_l) - (ifBlockS (r_h .===. old_h) - [ write_u32 a (Add o (Int 4)) new_h - , write_u32 a o new_l - ] - mempty) - mempty - ] - - FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v + CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) + + FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v - InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $ - -- this primop can't be implemented - -- correctly because we don't store - -- the array reference part of an Addr#, - -- only the offset part. - -- - -- So let's assume that all the array - -- references are the same... - -- - -- Note: we could generate an assert - -- that checks that a1 === a2. However - -- we can't check that the Addr# read - -- at Addr# a2[o2] also comes from this - -- a1/a2 array. - mconcat [ r_a |= a1 -- might be wrong (see above) - , r_o |= read_boff_u32 a1 o1 - -- TODO (see above) - -- assert that a1 === a2 - , write_boff_u32 a1 o1 o2 - ] - InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ - mconcat [ r |= read_boff_u32 a o - , write_boff_u32 a o w - ] + InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat + [ read_boff_addr a1 o1 ra ro + , write_boff_addr a1 o1 a2 o2 + ] + InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat + [ r |= read_boff_u32 a o + , write_boff_u32 a o w + ] ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n] GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length" @@ -1367,6 +1203,79 @@ read_f32 a i = idx_f32 a i read_f64 :: JExpr -> JExpr -> JExpr read_f64 a i = idx_f64 a i +read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_u64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_u32 a (Add 1 (i .<<. 1)) + ] + +read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_i64 a i rh rl = mconcat + [ rl |= read_u32 a (i .<<. 1) + , rh |= read_i32 a (Add 1 (i .<<. 1)) + ] + +-------------------------------------- +-- Addr# +-------------------------------------- + +write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_addr a i r o = mconcat + [ write_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! (i .<<. 2) |= r + ] + +read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_addr a i r o = mconcat + [ o |= read_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2))) + (a .^ "arr" .! (i .<<. 2)) + null_ + ] + +read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_addr a i r o = mconcat + [ o |= read_boff_i32 a i + , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i)) + (a .^ "arr" .! i) + null_ + ] + +write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_addr a i r o = mconcat + [ write_boff_i32 a i o + -- create the hidden array for arrays if it doesn't exist + , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty + , a .^ "arr" .! i |= r + ] + + +-------------------------------------- +-- StablePtr +-------------------------------------- + +read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_i32 a i + ] + +read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_stableptr a i r o = mconcat + [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array + , o |= read_boff_i32 a i + ] + +write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_stableptr a i _r o = write_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + +write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_stableptr a i _r o = write_boff_i32 a i o + -- don't store "r" as it must be h$stablePtrBuf + write_u8 :: JExpr -> JExpr -> JExpr -> JStat write_u8 a i v = idx_u8 a i |= v @@ -1391,6 +1300,18 @@ write_f32 a i v = idx_f32 a i |= v write_f64 :: JExpr -> JExpr -> JExpr -> JStat write_f64 a i v = idx_f64 a i |= v +write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_u64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_u32 a (Add 1 (i .<<. 1)) h + ] + +write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_i64 a i h l = mconcat + [ write_u32 a (i .<<. 1) l + , write_i32 a (Add 1 (i .<<. 1)) h + ] + -- Data View helper functions: byte indexed! -- -- The argument list consists of the array @a@, the index @i@, and the new value @@ -1406,6 +1327,16 @@ write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_] write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_] write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_] +write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +write_boff_i64 a i h l = mconcat + [ write_boff_i32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] +write_boff_u64 a i h l = mconcat + [ write_boff_u32 a (Add i (Int 4)) h + , write_boff_u32 a i l + ] + read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr read_boff_i8 a i = read_i8 a i read_boff_u8 a i = read_u8 a i @@ -1416,6 +1347,18 @@ read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_] read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_] read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_] +read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_i64 a i rh rl = mconcat + [ rh |= read_boff_i32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + +read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat +read_boff_u64 a i rh rl = mconcat + [ rh |= read_boff_u32 a (Add i (Int 4)) + , rl |= read_boff_u32 a i + ] + fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat fetchOpByteArray op tgt src i v = mconcat [ tgt |= read_i32 src i @@ -1431,8 +1374,8 @@ fetchOpAddr op tgt src i v = mconcat casOp :: (JExpr -> JExpr -> JExpr) -- read -> (JExpr -> JExpr -> JExpr -> JStat) -- write - -> JExpr -- target register to store result - -> JExpr -- source arrays + -> JExpr -- target register to store result + -> JExpr -- source array -> JExpr -- index -> JExpr -- old value to compare -> JExpr -- new value to write @@ -1444,39 +1387,174 @@ casOp read write tgt src i old new = mconcat mempty ] +casOp2 + :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read + -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write + -> (JExpr,JExpr) -- target registers to store result + -> JExpr -- source array + -> JExpr -- index + -> (JExpr,JExpr) -- old value to compare + -> (JExpr,JExpr) -- new value to write + -> JStat +casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat + [ read src i tgt1 tgt2 + , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1)) + (write src i new1 new2) + mempty + ] + -------------------------------------------------------------------------------- -- Lifted Arrays -------------------------------------------------------------------------------- -- | lifted arrays -cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat -cloneArray tgt src mb_offset len = mconcat - [ tgt |= ApplExpr (src .^ "slice") [start, end] - , tgt .^ closureMeta_ |= zero_ - , tgt .^ "__ghcjsArray" |= true_ - ] - where - start = fromMaybe zero_ mb_offset - end = maybe len (Add len) mb_offset - -newArray :: JExpr -> JExpr -> JExpr -> JStat -newArray tgt len elem = - tgt |= app "h$newArray" [len, elem] +cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +cloneArray bound_check tgt src start len = + bnd_arr_range bound_check src start len + $ mconcat + [ tgt |= ApplExpr (src .^ "slice") [start, Add len start] + , tgt .^ closureMeta_ |= zero_ + , tgt .^ "__ghcjsArray" |= true_ + ] newByteArray :: JExpr -> JExpr -> JStat newByteArray tgt len = tgt |= app "h$newByteArray" [len] -boundsChecked :: Bool -- ^ Should we do bounds checking? - -> JExpr -- ^ Array - -> JExpr -- ^ Index - -> JStat -- ^ Result - -> JStat -boundsChecked False _ _ r = r -boundsChecked True xs i r = - ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_)) +-- | Check that index is positive and below a max value. Halt the process with +-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds +check_bound + :: JExpr -- ^ Max index expression + -> Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +check_bound _ False _ r = r +check_bound max_index True i r = mconcat + [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $ + returnS (app "h$exitProcess" [Int 134]) + , r + ] + +-- | Bounds checking using ".length" property (Arrays) +bnd_arr + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_arr do_check arr = check_bound (arr .^ "length") do_check + +-- | Range bounds checking using ".length" property (Arrays) +-- +-- Empty ranges trivially pass the check +bnd_arr_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_arr_range False _arr _i _n r = r +bnd_arr_range True arr i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r) + +-- | Bounds checking using ".len" property (ByteArrays) +bnd_ba + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JStat -- ^ Result + -> JStat +bnd_ba do_check arr = check_bound (arr .^ "len") do_check + +-- | ByteArray bounds checking (byte offset, 8-bit value) +bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba8 = bnd_ba + +-- | ByteArray bounds checking (byte offset, 16-bit value) +bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba16 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 1) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 1) r + +-- | ByteArray bounds checking (byte offset, 32-bit value) +bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba32 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 3) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 3) r + +-- | ByteArray bounds checking (byte offset, 64-bit value) +bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ba64 do_check arr idx r = + -- check that idx non incremented is in range: + -- (idx + 7) may be in range while idx isn't + bnd_ba do_check arr idx + $ bnd_ba do_check arr (Add idx 7) r + +-- | ByteArray bounds checking (8-bit offset, 8-bit value) +bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix8 = bnd_ba8 + +-- | ByteArray bounds checking (16-bit offset, 16-bit value) +bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r + +-- | ByteArray bounds checking (32-bit offset, 32-bit value) +bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r + +-- | ByteArray bounds checking (64-bit offset, 64-bit value) +bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat +bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r + +-- | Bounds checking on a range and using ".len" property (ByteArrays) +-- +-- Empty ranges trivially pass the check +bnd_ba_range + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ Array + -> JExpr -- ^ Index + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +bnd_ba_range False _ _ _ r = r +bnd_ba_range True xs i n r = + ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $ + -- Empty ranges trivially pass the check + ifS (n .===. zero_) + r + (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r)) + +checkOverlapByteArray + :: Bool -- ^ Should we do bounds checking? + -> JExpr -- ^ First array + -> JExpr -- ^ First offset + -> JExpr -- ^ Second array + -> JExpr -- ^ Second offset + -> JExpr -- ^ Range size + -> JStat -- ^ Result + -> JStat +checkOverlapByteArray False _ _ _ _ _ r = r +checkOverlapByteArray True a1 o1 a2 o2 n r = + ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n]) r (returnS $ app "h$exitProcess" [Int 134]) +copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes +copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n] + where + check = bnd_ba_range bound a1 o1 n + . bnd_ba_range bound a2 o2 n + . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) + -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript. -- So (x|0) * (y|0) can still return values outside of the Int32 range. You have ===================================== libraries/base/jsbits/base.js ===================================== @@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) { } const e = d.readSync(); - if (!dst_a.arr) dst_a.arr = []; - dst_a.arr[dst_o*2] = [e,0]; + PUT_ADDR(dst_a,dst_o*2,e,0); return 0; } ===================================== rts/js/environment.js ===================================== @@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { } else { argc_v.dv.setInt32(argc_off, c, true); var argv = h$newByteArray(4*c); - argv.arr = []; for(var i=0;i=0;i--) { + a2.arr[o2+i] = a1.arr[o1+i] || null; + } + } else { + for (var i=0;i= n; + if (o1 > o2) return o1 - o2 >= n; + return true; +} ===================================== rts/js/profiling.js ===================================== @@ -302,10 +302,9 @@ function h$buildCCPtr(o) { #ifdef GHCJS_TRACE_PROF cc.myTag = "cc pointer"; #endif - cc.arr = []; - cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; - cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; - cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + PUT_ADDR(cc, h$ccLabel_offset, h$encodeUtf8(o.label), 0); + PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0); + PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0); return cc; } ===================================== rts/js/staticpointer.js ===================================== @@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) { ba.i3[1] = key1; ba.i3[2] = key4; ba.i3[3] = key3; - h$static_pointer_table_keys.push([ba,0]); + h$static_pointer_table_keys.push(ba); h$retain({ root: ref, _key: -1 }); } var s = h$static_pointer_table; @@ -33,8 +33,9 @@ function h$hs_spt_key_count() { function h$hs_spt_keys(tgt_d, tgt_o, n) { var ks = h$static_pointer_table_keys; - if(!tgt_d.arr) tgt_d.arr = []; - for(var i=0;(i ptr (array) -function h$derefPtrA(ptr, ptr_off) { - return ptr.arr[ptr_off][0]; -} -// ptr* -> ptr (offset) -function h$derefPtrO(ptr, ptr_off) { - return ptr.arr[ptr_off][1]; -} - -// word** -> word ptr[x][y] -function h$readPtrPtrU32(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getInt32(arr[1] + 4 * y, true); -} - -// char** -> char ptr[x][y] -function h$readPtrPtrU8(ptr, ptr_off, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - return arr[0].dv.getUint8(arr[1] + y); -} - -// word** ptr[x][y] = v -function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off + 4 * x]; - arr[0].dv.putInt32(arr[1] + y, v); -} - -// unsigned char** ptr[x][y] = v -function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { - x = x || 0; - y = y || 0; - var arr = ptr.arr[ptr_off+ 4 * x]; - arr[0].dv.putUint8(arr[1] + y, v); -} - // convert JavaScript String to a Haskell String #ifdef GHCJS_PROF function h$toHsString(str, cc) { ===================================== testsuite/tests/codeGen/should_fail/all.T ===================================== @@ -24,4 +24,3 @@ check_bounds_test('CheckBoundsCompareByteArray2') # Check first byte, 1st array check_bounds_test('CheckBoundsCompareByteArray3') # Check negative length check_bounds_test('CheckOverlapCopyByteArray') check_bounds_test('CheckOverlapCopyAddrToByteArray') - ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,4 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) -test('CheckBoundsOK', js_broken(23123), compile_and_run, ['-fcheck-prim-bounds']) +test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/944a9b94ceea429f05f336a035088b1ebd26ddc4...2d5c1ddecf195da9a8ee4f7b38fbb79d3b680aeb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/944a9b94ceea429f05f336a035088b1ebd26ddc4...2d5c1ddecf195da9a8ee4f7b38fbb79d3b680aeb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 18:59:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 14:59:48 -0400 Subject: [Git][ghc/ghc][master] JavaScript: Correct arguments to h$appendToHsStringA Message-ID: <645400a4e1ed3_e3e0616e4651827114a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - 1 changed file: - compiler/GHC/StgToJS/Apply.hs Changes: ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -110,7 +110,7 @@ genApp ctx i args prof <- csProf <$> getSettings let profArg = if prof then [jCafCCS] else [] a <- genArg x - return ( top |= app "h$appendToHsStringA" ([toJExpr d, toJExpr a] ++ profArg) + return ( top |= app "h$appendToHsStringA" (toJExpr d : a ++ profArg) , ExprInline Nothing ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98c5ee4526d1830beff4203062eb1c8e903db9bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98c5ee4526d1830beff4203062eb1c8e903db9bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 19:00:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 15:00:25 -0400 Subject: [Git][ghc/ghc][master] base/encoding: add an allocations performance test (#22946) Message-ID: <645400c911c0b_e3e0613e02d98274544@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - 2 changed files: - libraries/base/tests/perf/all.T - + libraries/base/tests/perf/encodingAllocations.hs Changes: ===================================== libraries/base/tests/perf/all.T ===================================== @@ -1,5 +1,14 @@ +# .stats files aren't yet supported in the JS backend +setTestOpts(js_skip) + #-------------------------------------- # Check specialization of elem via rules #-------------------------------------- test('T17752', [only_ways(['normal'])] , makefile_test, ['T17752']) + +#-------------------------------------- + +# We don't expect the code in test to vary at all, but the variance is set to +# 1% in case the constant allocations increase by other means. +test('encodingAllocations', [only_ways(['normal']), collect_stats('bytes allocated', 1)], compile_and_run, ['-O2']) ===================================== libraries/base/tests/perf/encodingAllocations.hs ===================================== @@ -0,0 +1,30 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -dno-typeable-binds -O2 #-} + +module Main (main) where + +import System.IO +import Data.Bits +import GHC.Int +import GHC.Exts +import System.Environment +import Distribution.Simple.Utils + + +main :: IO () +main = withTempFile "." "encodingAllocations.tmp" (const $ loop 1000000) + +loop :: Int -> Handle -> IO () +loop 0 !_ = pure () +loop !n !h = do + hPutChar h $! dummy_char n + loop (n-1) h + +-- unsafe efficient version of `chr` +my_chr :: Int -> Char +my_chr (I# i) = C# (chr# i) + +-- return either a or b +dummy_char :: Int -> Char +dummy_char !i = my_chr ((i .&. 1) + 97) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca611447986fab9da82f4272f90fae3f0afda5a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca611447986fab9da82f4272f90fae3f0afda5a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 19:01:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 15:01:02 -0400 Subject: [Git][ghc/ghc][master] linear types: Don't add external names to the usage env Message-ID: <645400eeaa1d8_e3e063c09fc42780b8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - 3 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3210,7 +3210,7 @@ varCallSiteUsage :: Id -> LintM UsageEnv varCallSiteUsage id = do m <- getUEAliases return $ case lookupNameEnv m (getName id) of - Nothing -> unitUE id OneTy + Nothing -> singleUsageUE id Just id_ue -> id_ue ensureEqTys :: LintedType -> LintedType -> SDoc -> LintM () ===================================== compiler/GHC/Core/UsageEnv.hs ===================================== @@ -10,13 +10,14 @@ module GHC.Core.UsageEnv , scaleUsage , supUE , supUEs - , unitUE + , singleUsageUE , zeroUE ) where import Data.Foldable import GHC.Prelude import GHC.Core.Multiplicity +import GHC.Types.Var import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Outputable @@ -54,8 +55,13 @@ scaleUsage x (MUsage y) = MUsage $ mkMultMul x y -- For now, we use extra multiplicity Bottom for empty case. data UsageEnv = UsageEnv !(NameEnv Mult) Bool -unitUE :: NamedThing n => n -> Mult -> UsageEnv -unitUE x w = UsageEnv (unitNameEnv (getName x) w) False +-- | Record a single usage of an Id, i.e. {n: 1} +-- Exception: We do not record external names (both GlobalIds and top-level LocalIds) +-- because they're not relevant to linearity checking. +singleUsageUE :: Id -> UsageEnv +singleUsageUE x | isExternalName n = zeroUE + | otherwise = UsageEnv (unitNameEnv n OneTy) False + where n = getName x zeroUE, bottomUE :: UsageEnv zeroUE = UsageEnv emptyNameEnv False ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -48,7 +48,7 @@ import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic ) import GHC.Tc.Utils.Instantiate import GHC.Tc.Instance.Family ( tcLookupDataFamInst ) import GHC.Core.FamInstEnv ( FamInstEnvs ) -import GHC.Core.UsageEnv ( unitUE ) +import GHC.Core.UsageEnv ( singleUsageUE ) import GHC.Tc.Errors.Types import GHC.Tc.Solver ( InferMode(..), simplifyInfer ) import GHC.Tc.Utils.Env @@ -1091,7 +1091,7 @@ tc_infer_id id_name check_local_id :: Id -> TcM () check_local_id id = do { checkThLocalId id - ; tcEmitBindingUsage $ unitUE (idName id) OneTy } + ; tcEmitBindingUsage $ singleUsageUE id } check_naughty :: OccName -> TcId -> TcM () check_naughty lbl id View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3ddf58d26cb490e5bf523d45b37c4d95379f19c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3ddf58d26cb490e5bf523d45b37c4d95379f19c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 19:01:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 15:01:44 -0400 Subject: [Git][ghc/ghc][master] Improved documentation for the Data.OldList.nub function Message-ID: <645401184b8ac_e3e063a20fc82816e4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - 1 changed file: - libraries/base/Data/OldList.hs Changes: ===================================== libraries/base/Data/OldList.hs ===================================== @@ -448,10 +448,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) -- >>> nub [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] -- --- If the order of outputs does not matter and there exists @instance Ord a@, --- it's faster to use +-- If there exists @instance Ord a@, it's faster to use `nubOrd` from the `containers` package +-- ([link to the latest online documentation](https://hackage.haskell.org/package/containers/docs/Data-Containers-ListUtils.html#v:nubOrd)), +-- which takes only \(\mathcal{O}(n \log d)\) time where `d` is the number of +-- distinct elements in the list. +-- +-- Another approach to speed up 'nub' is to use -- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' . @Data.List.NonEmpty.@'Data.List.NonEmpty.group' . 'sort', --- which takes only \(\mathcal{O}(n \log n)\) time. +-- which takes \(\mathcal{O}(n \log n)\) time, requires @instance Ord a@ and doesn't +-- preserve the order. + -- nub :: (Eq a) => [a] -> [a] nub = nubBy (==) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3226616beaa8cd4d3289b8a9d4bb0a9b8936f8e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3226616beaa8cd4d3289b8a9d4bb0a9b8936f8e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 4 19:02:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 04 May 2023 15:02:25 -0400 Subject: [Git][ghc/ghc][master] Fix type variable substitution in gen_Newtype_fam_insts Message-ID: <64540141934cc_e3e06192c28882868d8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 5 changed files: - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/TyCl/Class.hs - + testsuite/tests/deriving/should_compile/T23329.hs - + testsuite/tests/deriving/should_compile/T23329_M.hs - testsuite/tests/deriving/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -46,6 +46,7 @@ import GHC.Prelude import GHC.Hs +import GHC.Tc.TyCl.Class ( substATBndrs ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Instantiate( newFamInst ) import GHC.Tc.Utils.Env @@ -2100,8 +2101,8 @@ gen_Newtype_fam_insts loc' cls inst_tvs inst_tys rhs_ty newFamInst SynFamilyInst axiom where fam_tvs = tyConTyVars fam_tc - rep_lhs_tys = substTyVars lhs_subst fam_tvs - rep_rhs_tys = substTyVars rhs_subst fam_tvs + (_, rep_lhs_tys) = substATBndrs lhs_subst fam_tvs + (_, rep_rhs_tys) = substATBndrs rhs_subst fam_tvs rep_rhs_ty = mkTyConApp fam_tc rep_rhs_tys rep_tcvs = tyCoVarsOfTypesList rep_lhs_tys (rep_tvs, rep_cvs) = partition isTyVar rep_tcvs ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -22,6 +22,7 @@ module GHC.Tc.TyCl.Class , instDeclCtxt2 , instDeclCtxt3 , tcATDefault + , substATBndrs ) where @@ -42,7 +43,7 @@ import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad import GHC.Tc.TyCl.Build( TcMethInfo ) -import GHC.Core.Type ( piResultTys ) +import GHC.Core.Type ( extendTvSubstWithClone, piResultTys ) import GHC.Core.Predicate import GHC.Core.Multiplicity import GHC.Core.Class @@ -58,7 +59,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.Var -import GHC.Types.Var.Env +import GHC.Types.Var.Env ( lookupVarEnv ) import GHC.Types.SourceFile (HscSource(..)) import GHC.Types.SrcLoc import GHC.Types.Basic @@ -501,8 +502,7 @@ tcATDefault loc inst_subst defined_ats (ATI fam_tc defs) -- instance C [x] -- Then we want to generate the decl: type F [x] b = () | Just (rhs_ty, _loc) <- defs - = do { let (subst', pat_tys') = mapAccumL subst_tv inst_subst - (tyConTyVars fam_tc) + = do { let (subst', pat_tys') = substATBndrs inst_subst (tyConTyVars fam_tc) rhs' = substTyUnchecked subst' rhs_ty tcv' = tyCoVarsOfTypesList pat_tys' (tv', cv') = partition isTyVar tcv' @@ -525,14 +525,73 @@ tcATDefault loc inst_subst defined_ats (ATI fam_tc defs) | otherwise -- defs = Nothing = do { warnMissingAT (tyConName fam_tc) ; return [] } + +-- | Apply a substitution to the type variable binders of an associated type +-- family. This is used to compute default instances for associated type +-- families (see 'tcATDefault') as well as @newtype at -derived associated type +-- family instances (see @gen_Newtype_fam_insts@ in "GHC.Tc.Deriv.Generate"). +-- +-- As a concrete example, consider the following class and associated type +-- family: +-- +-- @ +-- class C k (a :: k) where +-- type F k a (b :: k) :: Type +-- type F j p q = (Proxy @j p, Proxy @j (q :: j)) +-- @ +-- +-- If a user defines this instance: +-- +-- @ +-- instance C (Type -> Type) Maybe where {} +-- @ +-- +-- Then in order to typecheck the default @F@ instance, we must apply the +-- substitution @[k :-> (Type -> Type), a :-> Maybe]@ to @F@'s binders, which +-- are @[k, a, (b :: k)]@. The result should look like this: +-- +-- @ +-- type F (Type -> Type) Maybe (b :: Type -> Type) = +-- (Proxy @(Type -> Type) Maybe, Proxy @(Type -> Type) (b :: Type -> Type)) +-- @ +-- +-- Making this work requires some care. There are two cases: +-- +-- 1. If we encounter a type variable in the domain of the substitution (e.g., +-- @k@ or @a@), then we apply the substitution directly. +-- +-- 2. Otherwise, we substitute into the type variable's kind (e.g., turn +-- @b :: k@ to @b :: Type -> Type@). We then return an extended substitution +-- where the old @b@ (of kind @k@) maps to the new @b@ (of kind @Type -> Type@). +-- +-- This step is important to do in case there are later occurrences of @b@, +-- which we must ensure have the correct kind. Otherwise, we might end up +-- with @Proxy \@(Type -> Type) (b :: k)@ on the right-hand side of the +-- default instance, which would be completely wrong. +-- +-- Contrast 'substATBndrs' function with similar substitution functions: +-- +-- * 'substTyVars' does not substitute into the kinds of each type variable, +-- nor does it extend the substitution. 'substTyVars' is meant for occurrences +-- of type variables, whereas 'substATBndr's is meant for binders. +-- +-- * 'substTyVarBndrs' does substitute into kinds and extends the substitution, +-- but it does not apply the substitution to the variables themselves. As +-- such, 'substTyVarBndrs' returns a list of 'TyVar's rather than a list of +-- 'Type's. +substATBndrs :: Subst -> [TyVar] -> (Subst, [Type]) +substATBndrs = mapAccumL substATBndr where - subst_tv subst tc_tv + substATBndr :: Subst -> TyVar -> (Subst, Type) + substATBndr subst tc_tv + -- Case (1) in the Haddocks | Just ty <- lookupVarEnv (getTvSubstEnv subst) tc_tv = (subst, ty) + -- Case (2) in the Haddocks | otherwise - = (extendTvSubst subst tc_tv ty', ty') + = (extendTvSubstWithClone subst tc_tv tc_tv', mkTyVarTy tc_tv') where - ty' = mkTyVarTy (updateTyVarKind (substTyUnchecked subst) tc_tv) + tc_tv' = updateTyVarKind (substTy subst) tc_tv warnMissingAT :: Name -> TcM () warnMissingAT name ===================================== testsuite/tests/deriving/should_compile/T23329.hs ===================================== @@ -0,0 +1,9 @@ +module T23329 where + +import Data.Kind (Type) +import Data.Proxy (Proxy(Proxy)) + +import T23329_M + +foo :: () +foo = myMethod @Type @MyMaybe @() () Proxy Proxy ===================================== testsuite/tests/deriving/should_compile/T23329_M.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T23329_M where + +import Data.Kind (Type) +import Data.Proxy (Proxy) + +class MyClass (f :: k -> Type) where + type MyTypeFamily f (i :: k) :: Type + myMethod :: MyTypeFamily f i -> Proxy f -> Proxy i -> () + +instance MyClass Maybe where + type MyTypeFamily Maybe i = () + myMethod = undefined + +newtype MyMaybe a = MyMaybe (Maybe a) + deriving MyClass ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -141,3 +141,4 @@ test('T20994', normal, compile, ['']) test('T22167', normal, compile, ['']) test('T22696a', normal, compile, ['']) test('T22696c', normal, compile, ['']) +test('T23329', normal, multimod_compile, ['T23329', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8b72ff6e4aee1f889a9168df57bb1b00168fd21 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8b72ff6e4aee1f889a9168df57bb1b00168fd21 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 07:45:00 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 05 May 2023 03:45:00 -0400 Subject: [Git][ghc/ghc][wip/T23083] 3 commits: CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead Message-ID: <6454b3fc10f95_e3e06193e5e0431104a@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 8b637a51 by Sebastian Graf at 2023-05-05T09:44:48+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - 32cc009e by Sebastian Graf at 2023-05-05T09:44:48+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - f9ebee2c by Sebastian Graf at 2023-05-05T09:44:48+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Utils/Trace.hs - docs/users_guide/using-optimisation.rst - libraries/base/Unsafe/Coerce.hs - libraries/ghc-bignum/ghc-bignum.cabal - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - + testsuite/tests/simplCore/should_compile/T23083.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd286b5029a42ddb70bb4ae21d000fd03889fd49...f9ebee2ce4c512730ca4782393936afb6d2e52fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd286b5029a42ddb70bb4ae21d000fd03889fd49...f9ebee2ce4c512730ca4782393936afb6d2e52fd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 08:43:53 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 May 2023 04:43:53 -0400 Subject: [Git][ghc/ghc][wip/plugin-init] 155 commits: Make exprIsConApp_maybe a bit cleverer Message-ID: <6454c1c9a4a87_e3e0616e4b0a4315379@gitlab.mail> Matthew Pickering pushed to branch wip/plugin-init at Glasgow Haskell Compiler / GHC Commits: c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 1599b4cf by Matthew Pickering at 2023-05-05T09:39:15+01:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - f6d990ae by Aaron Allen at 2023-05-05T09:43:21+01:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - af51225b by Matthew Pickering at 2023-05-05T09:43:40+01:00 docs: Add Note [Timing of plugin initialization] - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c42f3a0016dfceb66cd4fc35023734e6edfbf97e...af51225b02bc2e45184df685e87d8be74936db6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c42f3a0016dfceb66cd4fc35023734e6edfbf97e...af51225b02bc2e45184df685e87d8be74936db6e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 09:24:30 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 05 May 2023 05:24:30 -0400 Subject: [Git][ghc/ghc][wip/T23307] 18 commits: Add sized primitive literal syntax Message-ID: <6454cb4ea6303_e3e0627131c04330018@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23307 at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - f2f01568 by Simon Peyton Jones at 2023-05-05T10:26:25+01:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Unit/Types.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Setup.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - + docs/users_guide/exts/extended_literals.rst - docs/users_guide/exts/literals.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/stolen_syntax.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76cb9a77b1088e3e4141174ea7d2cb18200b4ac1...f2f015689111c7a321063ddce403ba8ddf35b76a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76cb9a77b1088e3e4141174ea7d2cb18200b4ac1...f2f015689111c7a321063ddce403ba8ddf35b76a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 09:33:28 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 May 2023 05:33:28 -0400 Subject: [Git][ghc/ghc][wip/23305] 20 commits: Add sized primitive literal syntax Message-ID: <6454cd68aa38f_e3e062274ca1c3324b1@gitlab.mail> Matthew Pickering pushed to branch wip/23305 at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - a0f5c55a by Matthew Pickering at 2023-05-05T10:33:18+01:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - 4d1d819a by Matthew Pickering at 2023-05-05T10:33:18+01:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 1315c369 by Matthew Pickering at 2023-05-05T10:33:18+01:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Unit/Types.hs - compiler/GHC/Utils/TmpFs.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Setup.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - + docs/users_guide/exts/extended_literals.rst - docs/users_guide/exts/literals.rst - docs/users_guide/exts/primitives.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/384c9a2f0ce460d2f167f2dfc9fe6d823db580e4...1315c369203302fcba8f4f5966bf0d834b93b866 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/384c9a2f0ce460d2f167f2dfc9fe6d823db580e4...1315c369203302fcba8f4f5966bf0d834b93b866 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 09:39:33 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 May 2023 05:39:33 -0400 Subject: [Git][ghc/ghc][wip/t22884] 20 commits: Add sized primitive literal syntax Message-ID: <6454ced588a84_e3e0627cadfb03366ce@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 15818aa1 by Matthew Pickering at 2023-05-05T10:38:51+01:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 6abc6b6e by Matthew Pickering at 2023-05-05T10:38:51+01:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 32e4ef8e by Matthew Pickering at 2023-05-05T10:39:15+01:00 error messages: Don't display ghci specific hints for missing packages I am unsure about whether the approach taken here is the best of most maintainable solution. I put it up here for review and comment. Fixes #22884 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Unit/Types.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Setup.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - + docs/users_guide/exts/extended_literals.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ca31f4164adeb6393aa249d633f548bf775399f...32e4ef8e2a813e4c01776c134eea348dc542ad17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ca31f4164adeb6393aa249d633f548bf775399f...32e4ef8e2a813e4c01776c134eea348dc542ad17 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 09:42:17 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 05 May 2023 05:42:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/modern-STV-extension-shuffling Message-ID: <6454cf791c7cc_e3e06250e057c3371fc@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/modern-STV-extension-shuffling You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 11:18:27 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 May 2023 07:18:27 -0400 Subject: [Git][ghc/ghc][wip/t22884] Changes to make :load work with ghci messages Message-ID: <6454e60346f48_e3e0622b3d298353472@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: c8d121c4 by Matthew Pickering at 2023-05-05T12:18:13+01:00 Changes to make :load work with ghci messages - - - - - 8 changed files: - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Tc/Errors/Ppr.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - + testsuite/tests/package/T4806_interactive.script - + testsuite/tests/package/T4806_interactive.stderr - testsuite/tests/package/all.T Changes: ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -329,7 +329,7 @@ buildUnit session cid insts lunit = do mod_graph <- hsunitModuleGraph False (unLoc lunit) msg <- mkBackpackMsg - ok <- load' noIfaceCache LoadAllTargets (Just msg) mod_graph + ok <- load' noIfaceCache LoadAllTargets AnyDiagnostic (Just msg) mod_graph when (failed ok) (liftIO $ exitWith (ExitFailure 1)) let hi_dir = expectJust (panic "hiDir Backpack") $ hiDir dflags @@ -418,7 +418,7 @@ compileExe lunit = do withBkpExeSession deps_w_rns $ do mod_graph <- hsunitModuleGraph True (unLoc lunit) msg <- mkBackpackMsg - ok <- load' noIfaceCache LoadAllTargets (Just msg) mod_graph + ok <- load' noIfaceCache LoadAllTargets AnyDiagnostic (Just msg) mod_graph when (failed ok) (liftIO $ exitWith (ExitFailure 1)) -- | Register a new virtual unit database containing a single unit ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -16,6 +16,9 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeApplications #-} -- ----------------------------------------------------------------------------- -- @@ -27,7 +30,7 @@ -- ----------------------------------------------------------------------------- module GHC.Driver.Make ( depanal, depanalE, depanalPartial, checkHomeUnitsClosed, - load, loadWithCache, load', LoadHowMuch(..), ModIfaceCache(..), noIfaceCache, newIfaceCache, + load, loadWithCache, load', AnyDiagnostic(..), LoadHowMuch(..), ModIfaceCache(..), noIfaceCache, newIfaceCache, instantiationNodes, downsweep, @@ -486,7 +489,7 @@ newIfaceCache = do -- All other errors are reported using the 'defaultWarnErrLogger'. load :: GhcMonad f => LoadHowMuch -> f SuccessFlag -load how_much = loadWithCache noIfaceCache how_much +load how_much = loadWithCache noIfaceCache AnyDiagnostic how_much mkBatchMsg :: HscEnv -> Messager mkBatchMsg hsc_env = @@ -496,11 +499,11 @@ mkBatchMsg hsc_env = else batchMsg -loadWithCache :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> m SuccessFlag -loadWithCache cache how_much = do +loadWithCache :: GhcMonad m => Maybe ModIfaceCache -> (GhcMessage -> AnyDiagnostic) -> LoadHowMuch -> m SuccessFlag +loadWithCache cache diag_wrapper how_much = do (errs, mod_graph) <- depanalE [] False -- #17459 msg <- mkBatchMsg <$> getSession - success <- load' cache how_much (Just msg) mod_graph + success <- load' cache how_much diag_wrapper (Just msg) mod_graph if isEmptyMessages errs then pure success else throwErrors (fmap GhcDriverMessage errs) @@ -692,8 +695,8 @@ data WorkerLimit -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally -- produced by calling 'depanal'. -load' :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag -load' mhmi_cache how_much mHscMessage mod_graph = do +load' :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> (GhcMessage -> AnyDiagnostic) -> Maybe Messager -> ModuleGraph -> m SuccessFlag +load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do modifySession $ \hsc_env -> hsc_env { hsc_mod_graph = mod_graph } guessOutputFile hsc_env <- getSession @@ -774,7 +777,7 @@ load' mhmi_cache how_much mHscMessage mod_graph = do setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do hsc_env <- getSession - liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan + liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan setSession hsc_env1 case upsweep_ok of Failed -> loadFinish upsweep_ok @@ -1070,6 +1073,7 @@ data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be au -- into the log queue. , withLogger :: forall a . Int -> ((Logger -> Logger) -> IO a) -> IO a , env_messager :: !(Maybe Messager) + , diag_wrapper :: GhcMessage -> AnyDiagnostic } type RunMakeM a = ReaderT MakeEnv (MaybeT IO) a @@ -1247,13 +1251,14 @@ upsweep :: WorkerLimit -- ^ The number of workers we wish to run in parallel -> HscEnv -- ^ The base HscEnv, which is augmented for each module -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to + -> (GhcMessage -> AnyDiagnostic) -> Maybe Messager -> M.Map ModNodeKeyWithUid HomeModInfo -> [BuildPlan] -> IO (SuccessFlag, HscEnv) -upsweep n_jobs hsc_env hmi_cache mHscMessage old_hpt build_plan = do +upsweep n_jobs hsc_env hmi_cache diag_rank mHscMessage old_hpt build_plan = do (cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan - runPipelines n_jobs hsc_env mHscMessage pipelines + runPipelines n_jobs hsc_env diag_wrapper mHscMessage pipelines res <- collect_result let completed = [m | Just (Just m) <- res] @@ -2434,13 +2439,27 @@ setHUG :: HomeUnitGraph -> HscEnv -> HscEnv setHUG deps hsc_env = hscUpdateHUG (const $ deps) hsc_env +data AnyDiagnostic where + AnyDiagnostic :: forall b . (DiagnosticOpts b ~ DiagnosticOpts GhcMessage, Diagnostic b) => b -> AnyDiagnostic + +instance Diagnostic AnyDiagnostic where + type DiagnosticOpts AnyDiagnostic = DiagnosticOpts GhcMessage + defaultDiagnosticOpts = defaultDiagnosticOpts @GhcMessage + diagnosticMessage opts (AnyDiagnostic b) = diagnosticMessage opts b + diagnosticReason (AnyDiagnostic b) = diagnosticReason b + diagnosticHints (AnyDiagnostic b) = diagnosticHints b + diagnosticCode (AnyDiagnostic b) = diagnosticCode b + + + + -- | Wrap an action to catch and handle exceptions. -wrapAction :: HscEnv -> IO a -> IO (Maybe a) -wrapAction hsc_env k = do +wrapAction :: (GhcMessage -> AnyDiagnostic) -> HscEnv -> IO a -> IO (Maybe a) +wrapAction msg_wrapper hsc_env k = do let lcl_logger = hsc_logger hsc_env lcl_dynflags = hsc_dflags hsc_env print_config = initPrintConfig lcl_dynflags - let logg err = printMessages lcl_logger print_config (initDiagOpts lcl_dynflags) (srcErrorMessages err) + let logg err = printMessages lcl_logger print_config (initDiagOpts lcl_dynflags) (msg_wrapper <$> srcErrorMessages err) -- MP: It is a bit strange how prettyPrintGhcErrors handles some errors but then we handle -- SourceError and ThreadKilled differently directly below. TODO: Refactor to use `catches` -- directly. MP should probably use safeTry here to not catch async exceptions but that will regress performance due to @@ -2490,9 +2509,10 @@ executeInstantiationNode k n deps uid iu = do -- Output of the logger is mediated by a central worker to -- avoid output interleaving msg <- asks env_messager + wrapper <- asks diag_wrapper lift $ MaybeT $ withLoggerHsc k env $ \hsc_env -> let lcl_hsc_env = setHUG deps hsc_env - in wrapAction lcl_hsc_env $ do + in wrapAction wrapper lcl_hsc_env $ do res <- upsweep_inst lcl_hsc_env msg k n uid iu cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) return res @@ -2518,7 +2538,7 @@ executeCompileNode k n !old_hmi hug mrehydrate_mods mod = do hydrated_hsc_env -- Compile the module, locking with a semaphore to avoid too many modules -- being compiled at the same time leading to high memory usage. - wrapAction lcl_hsc_env $ do + wrapAction diag_wrapper lcl_hsc_env $ do res <- upsweep_mod lcl_hsc_env env_messager old_hmi mod k n cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env) (hsc_tmpfs hsc_env) lcl_dynflags return res) @@ -2849,23 +2869,24 @@ label_self thread_name = do CC.labelThread self_tid thread_name -runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () +runPipelines :: WorkerLimit -> HscEnv -> (GhcMessage -> AnyDiagnostic) -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines -runPipelines _ _ _ [] = return () -runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do +runPipelines _ _ _ _ [] = return () +runPipelines n_job orig_hsc_env diag_wrapper mHscMessager all_pipelines = do liftIO $ label_self "main --make thread" plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines - _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env diag_wrapper mHscMessager all_pipelines + _n -> runParPipelines n_job plugins_hsc_env diag_wrapper mHscMessager all_pipelines -runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () -runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = +runSeqPipelines :: HscEnv -> (GhcMessage -> AnyDiagnostic) -> Maybe Messager -> [MakeAction] -> IO () +runSeqPipelines plugin_hsc_env diag_wrapper mHscMessager all_pipelines = let env = MakeEnv { hsc_env = plugin_hsc_env , withLogger = \_ k -> k id , compile_sem = AbstractSem (return ()) (return ()) , env_messager = mHscMessager + , diag_wrapper = diag_wrapper } in runAllPipelines (NumProcessorsLimit 1) env all_pipelines @@ -2895,10 +2916,11 @@ runWorkerLimit worker_limit action = case worker_limit of -- | Build and run a pipeline runParPipelines :: WorkerLimit -- ^ How to limit work parallelism -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module + -> (GhcMessage -> AnyDiagnostic) -> Maybe Messager -- ^ Optional custom messager to use to report progress -> [MakeAction] -- ^ The build plan for all the module nodes -> IO () -runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do +runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipelines = do -- A variable which we write to when an error has happened and we have to tell the @@ -2920,6 +2942,7 @@ runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do , withLogger = withParLog log_queue_queue_var , compile_sem = abstract_sem , env_messager = mHscMessager + , diag_wrapper = diag_wrapper } -- Reset the number of capabilities once the upsweep ends. runAllPipelines worker_limit env all_pipelines ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,6 +21,10 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) , pprTyThingUsedWrong + + -- | Useful when overriding message printing. + , messageWithInfoDiagnosticMessage + , messageWithHsDocContext ) where @@ -127,12 +131,8 @@ instance Diagnostic TcRnMessage where (tcOptsShowContext opts) (diagnosticMessage opts msg) TcRnWithHsDocContext ctxt msg - -> if tcOptsShowContext opts - then main_msg `unionDecoratedSDoc` ctxt_msg - else main_msg - where - main_msg = diagnosticMessage opts msg - ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + -> messageWithHsDocContext opts ctxt (diagnosticMessage opts msg) + TcRnSolverReport msg _ _ -> mkSimpleDecorated $ pprSolverReportWithCtxt msg TcRnRedundantConstraints redundants (info, show_info) @@ -3130,6 +3130,14 @@ messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important = in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc` mkDecorated err_info' +messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc +messageWithHsDocContext opts ctxt main_msg = do + if tcOptsShowContext opts + then main_msg `unionDecoratedSDoc` ctxt_msg + else main_msg + where + ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc dodgy_msg kind tc ie = vcat [ text "The" <+> kind <+> text "item" <+> quotes (ppr ie) <+> text "suggests that" ===================================== ghc/GHCi/UI.hs ===================================== @@ -52,7 +52,7 @@ import GHC.Driver.Session as DynFlags import GHC.Driver.Ppr hiding (printForUser) import GHC.Utils.Error hiding (traceCmd) import GHC.Driver.Monad ( modifySession ) -import GHC.Driver.Make ( newIfaceCache, ModIfaceCache(..) ) +import GHC.Driver.Make ( newIfaceCache, ModIfaceCache(..), AnyDiagnostic(..) ) import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Config.Diagnostic import qualified GHC @@ -2176,7 +2176,7 @@ doLoad retain_context howmuch = do liftIO $ do hSetBuffering stdout NoBuffering hSetBuffering stderr NoBuffering) $ \_ -> do hmis <- ifaceCache <$> getGHCiState - ok <- trySuccess $ GHC.loadWithCache (Just hmis) howmuch + ok <- trySuccess $ GHC.loadWithCache (Just hmis) (AnyDiagnostic . GHCiMessage) howmuch afterLoad ok retain_context return ok ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -module GHCi.UI.Exception(printGhciException) where +module GHCi.UI.Exception(printGhciException, GHCiMessage(..)) where import GHC.Prelude import GHC.Utils.Logger @@ -49,16 +49,31 @@ instance Diagnostic GHCiMessage where ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc ghciDiagnosticMessage ghc_opts msg = case msg of - GhcTcRnMessage (TcRnInterfaceError err) -> - case ghciInterfaceError err of - Just sdoc -> mkSimpleDecorated sdoc - Nothing -> diagnosticMessage ghc_opts msg + GhcTcRnMessage msg -> tcRnMessage (tcMessageOpts ghc_opts) msg GhcDriverMessage (DriverInterfaceError err) -> case ghciInterfaceError err of Just sdoc -> mkSimpleDecorated sdoc Nothing -> diagnosticMessage ghc_opts msg - _ -> diagnosticMessage ghc_opts msg + GhcPsMessage {} -> diagnosticMessage ghc_opts msg + GhcDsMessage {} -> diagnosticMessage ghc_opts msg + GhcUnknownMessage {} -> diagnosticMessage ghc_opts msg where + tcRnMessage tc_opts tc_msg = + case tc_msg of + TcRnInterfaceError err -> + case ghciInterfaceError err of + Just sdoc -> mkSimpleDecorated sdoc + Nothing -> diagnosticMessage ghc_opts msg + TcRnMessageWithInfo unit_state msg_with_info -> + case msg_with_info of + TcRnMessageDetailed err_info wrapped_msg + -> messageWithInfoDiagnosticMessage unit_state err_info + (tcOptsShowContext tc_opts) + (tcRnMessage tc_opts wrapped_msg) + TcRnWithHsDocContext ctxt wrapped_msg -> + messageWithHsDocContext tc_opts ctxt (tcRnMessage tc_opts wrapped_msg) + _ -> diagnosticMessage ghc_opts msg + opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts) ghciInterfaceError (Can'tFindInterface err looking_for) = ===================================== testsuite/tests/package/T4806_interactive.script ===================================== @@ -0,0 +1,3 @@ +:set -ignore-package containers + +:l T4806.hs ===================================== testsuite/tests/package/T4806_interactive.stderr ===================================== @@ -0,0 +1,6 @@ + +T4806.hs:1:1: error: [GHC-87110] + Could not load module ‘Data.Map’. + It is a member of the package ‘containers-0.6.7’ + which is ignored due to an -ignore-package flag + Use :set -v to see a list of the files searched for. ===================================== testsuite/tests/package/all.T ===================================== @@ -22,3 +22,4 @@ test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package c test('T4806a', normalise_version('deepseq', 'containers', 'template-haskell'), compile_fail, ['-ignore-package deepseq']) test('T22884', normalise_version('text'), compile_fail, ['-hide-package text']) test('T22884_interactive', normalise_version('text'), ghci_script, ['T22884_interactive.script']) +test('T4806_interactive', [extra_files(['T4806.hs']), normalise_version('containers')], ghci_script, ['T4806_interactive.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8d121c46fe63cdff2324d09b882978e0b815012 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8d121c46fe63cdff2324d09b882978e0b815012 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 11:44:37 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 May 2023 07:44:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/dynamic-alpine Message-ID: <6454ec25dbe35_e3e06193e5e04358483@gitlab.mail> Matthew Pickering pushed new branch wip/dynamic-alpine at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/dynamic-alpine You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 12:10:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 08:10:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: hadrian: Flavour: Change args -> extraArgs Message-ID: <6454f239a2013_e3e06250e057c3604b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 53c2d50d by Oleg Grenrus at 2023-05-05T08:10:28-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - 28 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69c7254e382f9ac2b5eaa01cd83a31543fa3cb8a...53c2d50d425d31e6aa1bc927df57e5f82e7d9d51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69c7254e382f9ac2b5eaa01cd83a31543fa3cb8a...53c2d50d425d31e6aa1bc927df57e5f82e7d9d51 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 12:17:29 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 05 May 2023 08:17:29 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23333 Message-ID: <6454f3d92104_e3e0622b3d29836576d@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23333 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23333 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 13:02:31 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 May 2023 09:02:31 -0400 Subject: [Git][ghc/ghc][wip/T23146] 3 commits: Make LFInfos for DataCons on construction Message-ID: <6454fe6717458_e3e062274ca1c374754@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: e26dd90b by Rodrigo Mesquita at 2023-05-05T13:57:30+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 7f021916 by Rodrigo Mesquita at 2023-05-05T13:58:14+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - 38c30187 by Rodrigo Mesquita at 2023-05-05T13:58:49+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - 9 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,37 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In CorePrep, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist, after CorePrep + only. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -586,12 +586,19 @@ Function call 'dataConKindEqSpec' returns [k'~k] Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~ -A `DataCon`'s source arity and core representation arity may differ: -`dcSourceArity` does not take constraints into account, but `dcRepArity` does. - -The additional arguments taken into account by `dcRepArity` include quantified -dictionaries and coercion arguments, lifted and unlifted (despite the unlifted -coercion arguments having a zero-width runtime representation). +A `DataCon`'s source and core representation may differ, meaning the source +arity (`dcSourceArity`) and the core representation arity (`dcRepArity`) may +differ too. + +Note that the source arity is the number of arguments the data constructor has +at its source level, which is also the number of arguments the data con +/wrapper/ has. On the other hand, the Core representation arity is the number +of arguments of the data constructor in its Core representation, which is also +the number of arguments of the data con /worker/. + +The arity might differ since `dcRepArity` takes into account arguments such as +quantified dictionaries and coercion arguments, lifted and unlifted (despite +the unlifted coercion arguments having a zero-width runtime representation). For example: MkT :: Ord a => a -> T a dcSourceArity = 1 @@ -601,6 +608,15 @@ For example: dcSourceArity = 0 dcRepArity = 1 +The arity might also differ due to unpacking, for example, consider the +following datatype and its wrapper and worker's type: + data V = MkV !() !Int + $WV :: () -> Int -> V + V :: Int# -> V +As you see, because of unpacking we have both dropped the unit argument and +unboxed the Int. In this case, the source arity (which is the arity of the +wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. + Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (mkLFImported) +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -271,11 +271,11 @@ isTagged v = do TagProper -> True TagTagged -> True TagTuple _ -> True -- Consider unboxed tuples tagged. - False -- Imported - -> return $! + -- Imported + False -> return $! -- Determine whether it is tagged from the LFInfo of the imported id. -- See Note [The LFInfo of Imported Ids] - case mkLFImported v of + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -96,6 +96,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import GHC.Data.Maybe (isNothing) import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 @@ -255,130 +256,67 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +-- | The 'LambdaFormInfo' of an imported Id. +-- See Note [The LFInfo of Imported Ids] +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of Just lf_info -> - -- Use the LambdaFormInfo from the interface + -- Use the existing LambdaFormInfo lf_info Nothing - -- Interface doesn't have a LambdaFormInfo, so make a conservative one from the type. - -- See Note [The LFInfo of Imported Ids]; The order of the guards musn't be changed! + -- Doesn't have a LambdaFormInfo, but we know it must be 'LFReEntrant' from its arity | arity > 0 -> LFReEntrant TopLevel arity True ArgUnknown - | Just con <- isDataConId_maybe id - -- See Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] in GHC.StgToCmm.Types - -- and Note [The LFInfo of Imported Ids] below - -> assert (hasNoNonZeroWidthArgs con) $ - LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - + -- We can't be sure of the LambdaFormInfo of this imported Id, + -- so make a conservative one from the type. | otherwise - -> mkLFArgument id -- Not sure of exact arity + -> assert (isNothing (isDataConId_maybe id)) $ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make + mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id - hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys {- Note [The LFInfo of Imported Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As explained in Note [Conveying CAF-info and LFInfo between modules] and -Note [Imported unlifted nullary datacon wrappers must have correct LFInfo], the -LambdaFormInfo records the details of a closure representation and is often, -when optimisations are enabled, serialized to the interface of a module. - -In particular, the `lfInfo` field of the `IdInfo` field of an `Id` -* For Ids defined in this module: is `Nothing` -* For imported Ids: +As explained in Note [Conveying CAF-info and LFInfo between modules] +the LambdaFormInfo records the details of a closure representation and is +often, when optimisations are enabled, serialized to the interface of a module. + +In particular, the `lfInfo` field of the `IdInfo` field of an `Id`: +* For DataCon workers and wrappers is populated as described in +Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make +* For other Ids defined in the module being compiled: is `Nothing` +* For other imported Ids: * is (Just lf_info) if the LFInfo was serialised into the interface file (typically, when the exporting module was compiled with -O) * is Nothing if it wasn't serialised -However, when an interface doesn't have a LambdaFormInfo for some imported Id -(so that its `lfInfo` field is `Nothing`), we can conservatively create one -using `mkLFImported`. - The LambdaFormInfo we give an Id is used in determining how to tag its pointer -(see `litIdInfo`). Therefore, it's crucial we re-construct a LambdaFormInfo as -faithfully as possible or otherwise risk having pointers incorrectly tagged, -which can lead to performance issues and even segmentation faults (see #23231 -and #23146). In particular, saturated data constructor applications *must* be -unambiguously given `LFCon`, and the invariant - - If the LFInfo (serialised or built with mkLFImported) says LFCon, then it - really is a static data constructor, and similar for LFReEntrant - -must be upheld. - -In `mkLFImported`, we make a conservative approximation to the real -LambdaFormInfo as follows: - -(1) Ids with an `idFunRepArity > 0` are `LFReEntrant` and pointers to them are -tagged (by `litIdInfo`) with the corresponding arity. - - This is also true of data con wrappers and workers with arity > 0, - regardless of the runtime relevance of the arguments - - For example, `Just :: a -> Maybe a` is given `LFReEntrant` - and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too - -(2) Data constructors with `idFunRepArity == 0` should be given `LFCon` because -they are fully saturated data constructor applications and pointers to them -should be tagged with the constructor index. - -(2.1) A datacon *wrapper* with zero arity must be a fully saturated application -of the worker to zero-width arguments only (which are dropped after unarisation) - -(2.2) A datacon *worker* with zero arity is trivially fully saturated, it takes -no arguments whatsoever (not even zero-width args) - -To ensure we properly give `LFReEntrant` to data constructors with some arity, -and `LFCon` only to data constructors with zero arity, we must first check for -`arity > 0` and only afterwards `isDataConId` -- the order of the guards in -`mkLFImported` is quite important. - -As an example, consider the following data constructors: - - data T1 a where - TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a - - data T2 a where - TCon2 :: {-# UNPACK #-} !() -> T2 a - - data T3 a where - TCon3 :: T3 '[] - -`TCon1`'s wrapper has a lifted equality argument, which is non-zero-width, while -the worker has an unlifted equality argument, which is zero-width. - -`TCon2`'s wrapper has a lifted equality argument, which is non-zero-width, -while the worker has no arguments. - -`TCon3`'s wrapper has no arguments, and the worker has 1 zero-width argument; -their Core representation: - - $WTCon3 :: T3 '[] - $WTCon3 = TCon3 @[] - - TCon3 :: forall (a :: * -> *). (a ~# []) => T a - TCon3 = /\a. \(co :: a~#[]). TCon3 co - -For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they -both have arity == 1. - -For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 -while the worker is `LFCon` since its arity == 0 - -For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the -worker `LFReEntrant` since its arity == 1 - -One might think we could give *workers* with only zero-width-args the `LFCon` -LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. -However, these workers, albeit rarely used, are unambiguously functions --- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. -See also the discussion in #23158. +(see `litIdInfo` and `lfDynTag`). Therefore, it's crucial we attribute a correct +LambdaFormInfo to imported Ids, or otherwise risk having pointers incorrectly +tagged which can lead to performance issues and even segmentation faults (see +#23231 and Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]). + +In particular, saturated data constructor applications *must* be unambiguously +given `LFCon`, and if the LFInfo says LFCon, then it really is a static data +constructor, and similar for LFReEntrant. + +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: + +(1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is +correct by construction (the invariant being that if it exists, it is correct): + (1.1) Either it was serialised to the interface we're importing the Id from, + (1.2) Or it's a DataCon worker or wrapper and its LFInfo was constructed + according to Note [LFInfo of DataCon workers and wrappers] +(2) When the `lfInfo` field is `Nothing` + (2.1) If the `idFunRepArity` of the Id is known and is greater than 0, then + the Id is unambiguously a function and is given `LFReEntrant`, and pointers + to this Id will be tagged (by `litIdInfo`) with the corresponding arity. + (2.2) Otherwise, we can make a conservative estimate from the type. -} ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -149,7 +149,7 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: @@ -109,11 +109,9 @@ pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage of the unlifted nature of its arguments by omitting handling of the zero tag when scrutinising them. -The fix is straightforward: extend the logic in `mkLFImported` to cover -(nullary) datacon wrappers as well as workers. This is safe because we -know that the wrapper of a nullary datacon will be in WHNF, even if it -includes equalities evidence (since such equalities are not runtime -relevant). This fixed #23146. +The fix is straightforward: ensure we always construct a /correct/ LFInfo for +datacon workers and wrappers, and populate the `lfInfo` with it. See +Note [LFInfo of DataCon workers and wrappers]. This fixed #23146. See also Note [The LFInfo of Imported Ids] -} ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -120,7 +120,8 @@ infixl 1 `setRuleInfo`, `setCafInfo`, `setDmdSigInfo`, `setCprSigInfo`, - `setDemandInfo` + `setDemandInfo`, + `setLFInfo` {- ************************************************************************ * * @@ -374,7 +375,12 @@ data IdInfo -- -- See documentation of the getters for what these packed fields mean. lfInfo :: !(Maybe LambdaFormInfo), - -- ^ See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- ^ If lfInfo = Just info, then the `info` is guaranteed /correct/. + -- If lfInfo = Nothing, then we do not have a `LambdaFormInfo` for this Id, + -- so (for imported Ids) we make a conservative version. + -- See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- For locally-defined Ids other than DataCons, the `lfInfo` field is always Nothing. + -- See also Note [LFInfo of DataCon workers and wrappers] -- See documentation of the getters for what these packed fields mean. tagSig :: !(Maybe TagSig) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Types.SourceText +import GHC.Types.RepType ( countFunRepArgs ) import GHC.Types.Name.Set import GHC.Types.Name import GHC.Types.ForeignCall @@ -87,6 +88,10 @@ import GHC.Data.FastString import GHC.Data.List.SetOps import Data.List ( zipWith4 ) +-- A bit of a shame we must import these here +import GHC.StgToCmm.Types (LambdaFormInfo(..)) +import GHC.Runtime.Heap.Layout (ArgDescr(ArgUnknown)) + {- ************************************************************************ * * @@ -595,11 +600,18 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setLFInfo` wkr_lf_info -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + -- See Note [LFInfo of DataCon workers and wrappers] + wkr_lf_info + | wkr_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wkr_arity wkr_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con ex_tcvs = dataConExTyCoVars data_con @@ -608,6 +620,7 @@ mkDataConWorkId wkr_name data_con `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma `setUnfoldingInfo` newtype_unf + `setLFInfo` (LFReEntrant TopLevel 1 True ArgUnknown) id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) @@ -618,6 +631,82 @@ mkDataConWorkId wkr_name data_con wrapNewTypeBody tycon res_ty_args (Var id_arg1) {- +Note [LFInfo of DataCon workers and wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As noted in Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure, it's +crucial that saturated data con applications are given an LFInfo of `LFCon`. + +Since for data constructors we never serialise the worker and the wrapper (only +the data type declaration), we never serialise their lambda form info either. + +Therefore, when making data constructors workers and wrappers, we construct a +correct `LFInfo` for them right away, and put it it in the `lfInfo` field of the +worker/wrapper Id, ensuring that: + + The `lfInfo` field of a DataCon worker or wrapper is always populated with the correct LFInfo. + +How do we construct a /correct/ LFInfo for workers and wrappers? +(Remember: `LFCon` means "a saturated constructor application") + +(1) Data constructor workers and wrappers with arity > 0 are unambiguously +functions and should be given `LFReEntrant`, regardless of the runtime +relevance of the arguments. + - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, + and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + +(2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes +no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + +(3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. +A datacon /wrapper/ with zero arity must be a fully saturated application of +the worker to zero-width arguments only (which are dropped after unarisation), +and therefore is also given `LFCon`. + +For example, consider the following data constructors: + + data T1 a where + TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a + + data T2 a where + TCon2 :: {-# UNPACK #-} !() -> T2 a + + data T3 a where + TCon3 :: T3 '[] + +`TCon1`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has an unlifted equality argument, which is zero-width. + +`TCon2`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has no arguments. + +Wrinkle (W1). Perhaps surprisingly, it is possible for the /wrapper/ to be an +`LFCon` even though the /worker/ is not. Consider `T3` above. Here is the +Core representation of the worker and wrapper: + + $WTCon3 :: T3 '[] -- Wrapper + $WTCon3 = TCon3 @[] -- A saturated constructor application: LFCon + + TCon3 :: forall (a :: * -> *). (a ~# []) => T a -- Worker + TCon3 = /\a. \(co :: a~#[]). TCon3 co -- A function: LFReEntrant + +For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they +both have arity == 1. + +For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 +while the worker is `LFCon` since its arity == 0 + +For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the +worker `LFReEntrant` since its arity == 1 + +One might think we could give *workers* with only zero-width-args the `LFCon` +LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. +However, these workers are unambiguously functions +-- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. +See also the discussion in #23158. + +See also the Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +in GHC.StgToCmm.Types. + ------------------------------------------------- -- Data constructor representation -- @@ -709,11 +798,18 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + `setLFInfo` wrap_lf_info -- The signature is purely for passes like the Simplifier, not for -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv + -- See Note [LFInfo of DataCon workers and wrappers] + wrap_lf_info + | wrap_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wrap_arity wrap_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + wrap_arg_dmds = replicate (length theta) topDmd ++ map mk_dmd arg_ibangs -- Don't forget the dictionary arguments when building ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -124,6 +124,10 @@ unwrapType ty | otherwise = NS_Done +-- | Count the arity of a function post-unarisation, including zero-width arguments. +-- +-- The post-unarisation arity may be larger than the arity of the original +-- function type. See Note [Unarisation]. countFunRepArgs :: Arity -> Type -> RepArity countFunRepArgs 0 _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7784859d190e75b8fe52df002c0b615c88f0365...38c301872915ac5f33d80927f84eea69292cb156 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7784859d190e75b8fe52df002c0b615c88f0365...38c301872915ac5f33d80927f84eea69292cb156 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 13:20:07 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 May 2023 09:20:07 -0400 Subject: [Git][ghc/ghc][wip/T23146] Enforce invariant on typePrimRepArgs in the types Message-ID: <6455028795c4f_e3e0627cadfb038133c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 749160f9 by Rodrigo Mesquita at 2023-05-05T14:17:34+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - 3 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -867,7 +869,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1660,9 +1662,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2117,7 +2118,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2125,13 +2126,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2189,8 +2190,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/749160f948016e4342bc770e969d5bfc20596bd2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/749160f948016e4342bc770e969d5bfc20596bd2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 14:04:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 May 2023 10:04:41 -0400 Subject: [Git][ghc/ghc][wip/T23146] Merge outdated Note [Data con representation] into Note [Data constructor representation] Message-ID: <64550cf9bfb4b_e3e062c59e10c388084@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 94db0835 by Rodrigo Mesquita at 2023-05-05T15:02:35+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 2 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Stg/Syntax.hs Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConId`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -528,7 +540,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -985,51 +997,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,50 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In STG, constructor applications `StgConApp` and `StgRhsCon` are always /fully saturated/. +However, the number of arguments saturating the application may differ +post-unarisation because we drop void arguments from `StgConApp` and `StgRhsCon` +constructor applications during unarisation. + +Therefore, in `StgConApp` and `StgRhsCon`: +* Before unarisation, we have the saturated list of the arguments [StgArg] +* Post unarisation, we have the saturated list of non-void arguments, the type +of which should really be [NonVoid StgArg] + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +289,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -421,7 +465,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that -- returns 'empty'. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94db08351659f012361c44ff1e9d5224f1407f06 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94db08351659f012361c44ff1e9d5224f1407f06 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 14:33:55 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 May 2023 10:33:55 -0400 Subject: [Git][ghc/ghc][wip/T23146] 5 commits: Make LFInfos for DataCons on construction Message-ID: <645513d397a3a_e3e0627cadfb03948af@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: b3137a58 by Rodrigo Mesquita at 2023-05-05T15:32:58+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - cdb20d1b by Rodrigo Mesquita at 2023-05-05T15:33:02+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - 3831cdf5 by Rodrigo Mesquita at 2023-05-05T15:33:02+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - 0c4f6796 by Rodrigo Mesquita at 2023-05-05T15:33:02+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - f801b269 by Rodrigo Mesquita at 2023-05-05T15:33:02+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,37 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In CorePrep, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist, after CorePrep + only. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConId`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -528,7 +540,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -586,12 +598,19 @@ Function call 'dataConKindEqSpec' returns [k'~k] Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~ -A `DataCon`'s source arity and core representation arity may differ: -`dcSourceArity` does not take constraints into account, but `dcRepArity` does. - -The additional arguments taken into account by `dcRepArity` include quantified -dictionaries and coercion arguments, lifted and unlifted (despite the unlifted -coercion arguments having a zero-width runtime representation). +A `DataCon`'s source and core representation may differ, meaning the source +arity (`dcSourceArity`) and the core representation arity (`dcRepArity`) may +differ too. + +Note that the source arity is the number of arguments the data constructor has +at its source level, which is also the number of arguments the data con +/wrapper/ has. On the other hand, the Core representation arity is the number +of arguments of the data constructor in its Core representation, which is also +the number of arguments of the data con /worker/. + +The arity might differ since `dcRepArity` takes into account arguments such as +quantified dictionaries and coercion arguments, lifted and unlifted (despite +the unlifted coercion arguments having a zero-width runtime representation). For example: MkT :: Ord a => a -> T a dcSourceArity = 1 @@ -601,6 +620,15 @@ For example: dcSourceArity = 0 dcRepArity = 1 +The arity might also differ due to unpacking, for example, consider the +following datatype and its wrapper and worker's type: + data V = MkV !() !Int + $WV :: () -> Int -> V + V :: Int# -> V +As you see, because of unpacking we have both dropped the unit argument and +unboxed the Int. In this case, the source arity (which is the arity of the +wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. + Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -969,51 +997,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (mkLFImported) +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -271,11 +271,11 @@ isTagged v = do TagProper -> True TagTagged -> True TagTuple _ -> True -- Consider unboxed tuples tagged. - False -- Imported - -> return $! + -- Imported + False -> return $! -- Determine whether it is tagged from the LFInfo of the imported id. -- See Note [The LFInfo of Imported Ids] - case mkLFImported v of + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,50 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In STG, constructor applications `StgConApp` and `StgRhsCon` are always /fully saturated/. +However, the number of arguments saturating the application may differ +post-unarisation because we drop void arguments from `StgConApp` and `StgRhsCon` +constructor applications during unarisation. + +Therefore, in `StgConApp` and `StgRhsCon`: +* Before unarisation, we have the saturated list of the arguments [StgArg] +* Post unarisation, we have the saturated list of non-void arguments, the type +of which should really be [NonVoid StgArg] + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +289,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -421,7 +465,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that -- returns 'empty'. ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -867,7 +869,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1660,9 +1662,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2117,7 +2118,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2125,13 +2126,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2189,8 +2190,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -96,6 +96,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import GHC.Data.Maybe (isNothing) import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 @@ -255,130 +256,67 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +-- | The 'LambdaFormInfo' of an imported Id. +-- See Note [The LFInfo of Imported Ids] +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of Just lf_info -> - -- Use the LambdaFormInfo from the interface + -- Use the existing LambdaFormInfo lf_info Nothing - -- Interface doesn't have a LambdaFormInfo, so make a conservative one from the type. - -- See Note [The LFInfo of Imported Ids]; The order of the guards musn't be changed! + -- Doesn't have a LambdaFormInfo, but we know it must be 'LFReEntrant' from its arity | arity > 0 -> LFReEntrant TopLevel arity True ArgUnknown - | Just con <- isDataConId_maybe id - -- See Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] in GHC.StgToCmm.Types - -- and Note [The LFInfo of Imported Ids] below - -> assert (hasNoNonZeroWidthArgs con) $ - LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - + -- We can't be sure of the LambdaFormInfo of this imported Id, + -- so make a conservative one from the type. | otherwise - -> mkLFArgument id -- Not sure of exact arity + -> assert (isNothing (isDataConId_maybe id)) $ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make + mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id - hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys {- Note [The LFInfo of Imported Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As explained in Note [Conveying CAF-info and LFInfo between modules] and -Note [Imported unlifted nullary datacon wrappers must have correct LFInfo], the -LambdaFormInfo records the details of a closure representation and is often, -when optimisations are enabled, serialized to the interface of a module. - -In particular, the `lfInfo` field of the `IdInfo` field of an `Id` -* For Ids defined in this module: is `Nothing` -* For imported Ids: +As explained in Note [Conveying CAF-info and LFInfo between modules] +the LambdaFormInfo records the details of a closure representation and is +often, when optimisations are enabled, serialized to the interface of a module. + +In particular, the `lfInfo` field of the `IdInfo` field of an `Id`: +* For DataCon workers and wrappers is populated as described in +Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make +* For other Ids defined in the module being compiled: is `Nothing` +* For other imported Ids: * is (Just lf_info) if the LFInfo was serialised into the interface file (typically, when the exporting module was compiled with -O) * is Nothing if it wasn't serialised -However, when an interface doesn't have a LambdaFormInfo for some imported Id -(so that its `lfInfo` field is `Nothing`), we can conservatively create one -using `mkLFImported`. - The LambdaFormInfo we give an Id is used in determining how to tag its pointer -(see `litIdInfo`). Therefore, it's crucial we re-construct a LambdaFormInfo as -faithfully as possible or otherwise risk having pointers incorrectly tagged, -which can lead to performance issues and even segmentation faults (see #23231 -and #23146). In particular, saturated data constructor applications *must* be -unambiguously given `LFCon`, and the invariant - - If the LFInfo (serialised or built with mkLFImported) says LFCon, then it - really is a static data constructor, and similar for LFReEntrant - -must be upheld. - -In `mkLFImported`, we make a conservative approximation to the real -LambdaFormInfo as follows: - -(1) Ids with an `idFunRepArity > 0` are `LFReEntrant` and pointers to them are -tagged (by `litIdInfo`) with the corresponding arity. - - This is also true of data con wrappers and workers with arity > 0, - regardless of the runtime relevance of the arguments - - For example, `Just :: a -> Maybe a` is given `LFReEntrant` - and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too - -(2) Data constructors with `idFunRepArity == 0` should be given `LFCon` because -they are fully saturated data constructor applications and pointers to them -should be tagged with the constructor index. - -(2.1) A datacon *wrapper* with zero arity must be a fully saturated application -of the worker to zero-width arguments only (which are dropped after unarisation) - -(2.2) A datacon *worker* with zero arity is trivially fully saturated, it takes -no arguments whatsoever (not even zero-width args) - -To ensure we properly give `LFReEntrant` to data constructors with some arity, -and `LFCon` only to data constructors with zero arity, we must first check for -`arity > 0` and only afterwards `isDataConId` -- the order of the guards in -`mkLFImported` is quite important. - -As an example, consider the following data constructors: - - data T1 a where - TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a - - data T2 a where - TCon2 :: {-# UNPACK #-} !() -> T2 a - - data T3 a where - TCon3 :: T3 '[] - -`TCon1`'s wrapper has a lifted equality argument, which is non-zero-width, while -the worker has an unlifted equality argument, which is zero-width. - -`TCon2`'s wrapper has a lifted equality argument, which is non-zero-width, -while the worker has no arguments. - -`TCon3`'s wrapper has no arguments, and the worker has 1 zero-width argument; -their Core representation: - - $WTCon3 :: T3 '[] - $WTCon3 = TCon3 @[] - - TCon3 :: forall (a :: * -> *). (a ~# []) => T a - TCon3 = /\a. \(co :: a~#[]). TCon3 co - -For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they -both have arity == 1. - -For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 -while the worker is `LFCon` since its arity == 0 - -For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the -worker `LFReEntrant` since its arity == 1 - -One might think we could give *workers* with only zero-width-args the `LFCon` -LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. -However, these workers, albeit rarely used, are unambiguously functions --- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. -See also the discussion in #23158. +(see `litIdInfo` and `lfDynTag`). Therefore, it's crucial we attribute a correct +LambdaFormInfo to imported Ids, or otherwise risk having pointers incorrectly +tagged which can lead to performance issues and even segmentation faults (see +#23231 and Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]). + +In particular, saturated data constructor applications *must* be unambiguously +given `LFCon`, and if the LFInfo says LFCon, then it really is a static data +constructor, and similar for LFReEntrant. + +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: + +(1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is +correct by construction (the invariant being that if it exists, it is correct): + (1.1) Either it was serialised to the interface we're importing the Id from, + (1.2) Or it's a DataCon worker or wrapper and its LFInfo was constructed + according to Note [LFInfo of DataCon workers and wrappers] +(2) When the `lfInfo` field is `Nothing` + (2.1) If the `idFunRepArity` of the Id is known and is greater than 0, then + the Id is unambiguously a function and is given `LFReEntrant`, and pointers + to this Id will be tagged (by `litIdInfo`) with the corresponding arity. + (2.2) Otherwise, we can make a conservative estimate from the type. -} ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -149,7 +149,7 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: @@ -75,9 +75,25 @@ Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As described in `Note [Conveying CAF-info and LFInfo between modules]`, imported unlifted nullary datacons must have their LambdaFormInfo set to -reflect the fact that they are evaluated . This is necessary as otherwise +reflect the fact that they are evaluated. This is necessary as otherwise references to them may be passed untagged to code that expects tagged -references. +references because of the unlifted nature of the argument. + +For example, in + + type T :: UnliftedType + data T = T1 + | T2 + + f :: T -> Int + f x = case x of T1 -> 1; T2 -> 2 + +`f` expects `x` to be evaluated and properly tagged due to its unliftedness. +We can guarantee all occurrences of `T1` and `T2` are considered evaluated and +are properly tagged by giving them the `LFCon` LambdaFormInfo which indicates +they are fully saturated constructor applications. +(The LambdaFormInfo is used to tag the pointer with the tag of the +constructor, in `litIdInfo`) What may be less obvious is that this must be done for not only datacon workers but also *wrappers*. The reason is found in this program @@ -109,11 +125,9 @@ pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage of the unlifted nature of its arguments by omitting handling of the zero tag when scrutinising them. -The fix is straightforward: extend the logic in `mkLFImported` to cover -(nullary) datacon wrappers as well as workers. This is safe because we -know that the wrapper of a nullary datacon will be in WHNF, even if it -includes equalities evidence (since such equalities are not runtime -relevant). This fixed #23146. +The fix is straightforward: ensure we always construct a /correct/ LFInfo for +datacon workers and wrappers, and populate the `lfInfo` with it. See +Note [LFInfo of DataCon workers and wrappers]. This fixed #23146. See also Note [The LFInfo of Imported Ids] -} ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -120,7 +120,8 @@ infixl 1 `setRuleInfo`, `setCafInfo`, `setDmdSigInfo`, `setCprSigInfo`, - `setDemandInfo` + `setDemandInfo`, + `setLFInfo` {- ************************************************************************ * * @@ -374,7 +375,12 @@ data IdInfo -- -- See documentation of the getters for what these packed fields mean. lfInfo :: !(Maybe LambdaFormInfo), - -- ^ See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- ^ If lfInfo = Just info, then the `info` is guaranteed /correct/. + -- If lfInfo = Nothing, then we do not have a `LambdaFormInfo` for this Id, + -- so (for imported Ids) we make a conservative version. + -- See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- For locally-defined Ids other than DataCons, the `lfInfo` field is always Nothing. + -- See also Note [LFInfo of DataCon workers and wrappers] -- See documentation of the getters for what these packed fields mean. tagSig :: !(Maybe TagSig) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Types.SourceText +import GHC.Types.RepType ( countFunRepArgs ) import GHC.Types.Name.Set import GHC.Types.Name import GHC.Types.ForeignCall @@ -87,6 +88,10 @@ import GHC.Data.FastString import GHC.Data.List.SetOps import Data.List ( zipWith4 ) +-- A bit of a shame we must import these here +import GHC.StgToCmm.Types (LambdaFormInfo(..)) +import GHC.Runtime.Heap.Layout (ArgDescr(ArgUnknown)) + {- ************************************************************************ * * @@ -595,11 +600,18 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setLFInfo` wkr_lf_info -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + -- See Note [LFInfo of DataCon workers and wrappers] + wkr_lf_info + | wkr_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wkr_arity wkr_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con ex_tcvs = dataConExTyCoVars data_con @@ -608,6 +620,7 @@ mkDataConWorkId wkr_name data_con `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma `setUnfoldingInfo` newtype_unf + `setLFInfo` (LFReEntrant TopLevel 1 True ArgUnknown) id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) @@ -618,6 +631,82 @@ mkDataConWorkId wkr_name data_con wrapNewTypeBody tycon res_ty_args (Var id_arg1) {- +Note [LFInfo of DataCon workers and wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As noted in Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure, it's +crucial that saturated data con applications are given an LFInfo of `LFCon`. + +Since for data constructors we never serialise the worker and the wrapper (only +the data type declaration), we never serialise their lambda form info either. + +Therefore, when making data constructors workers and wrappers, we construct a +correct `LFInfo` for them right away, and put it it in the `lfInfo` field of the +worker/wrapper Id, ensuring that: + + The `lfInfo` field of a DataCon worker or wrapper is always populated with the correct LFInfo. + +How do we construct a /correct/ LFInfo for workers and wrappers? +(Remember: `LFCon` means "a saturated constructor application") + +(1) Data constructor workers and wrappers with arity > 0 are unambiguously +functions and should be given `LFReEntrant`, regardless of the runtime +relevance of the arguments. + - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, + and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + +(2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes +no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + +(3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. +A datacon /wrapper/ with zero arity must be a fully saturated application of +the worker to zero-width arguments only (which are dropped after unarisation), +and therefore is also given `LFCon`. + +For example, consider the following data constructors: + + data T1 a where + TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a + + data T2 a where + TCon2 :: {-# UNPACK #-} !() -> T2 a + + data T3 a where + TCon3 :: T3 '[] + +`TCon1`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has an unlifted equality argument, which is zero-width. + +`TCon2`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has no arguments. + +Wrinkle (W1). Perhaps surprisingly, it is possible for the /wrapper/ to be an +`LFCon` even though the /worker/ is not. Consider `T3` above. Here is the +Core representation of the worker and wrapper: + + $WTCon3 :: T3 '[] -- Wrapper + $WTCon3 = TCon3 @[] -- A saturated constructor application: LFCon + + TCon3 :: forall (a :: * -> *). (a ~# []) => T a -- Worker + TCon3 = /\a. \(co :: a~#[]). TCon3 co -- A function: LFReEntrant + +For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they +both have arity == 1. + +For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 +while the worker is `LFCon` since its arity == 0 + +For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the +worker `LFReEntrant` since its arity == 1 + +One might think we could give *workers* with only zero-width-args the `LFCon` +LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. +However, these workers are unambiguously functions +-- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. +See also the discussion in #23158. + +See also the Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +in GHC.StgToCmm.Types. + ------------------------------------------------- -- Data constructor representation -- @@ -709,11 +798,18 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + `setLFInfo` wrap_lf_info -- The signature is purely for passes like the Simplifier, not for -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv + -- See Note [LFInfo of DataCon workers and wrappers] + wrap_lf_info + | wrap_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wrap_arity wrap_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + wrap_arg_dmds = replicate (length theta) topDmd ++ map mk_dmd arg_ibangs -- Don't forget the dictionary arguments when building ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty @@ -124,6 +123,10 @@ unwrapType ty | otherwise = NS_Done +-- | Count the arity of a function post-unarisation, including zero-width arguments. +-- +-- The post-unarisation arity may be larger than the arity of the original +-- function type. See Note [Unarisation]. countFunRepArgs :: Arity -> Type -> RepArity countFunRepArgs 0 _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94db08351659f012361c44ff1e9d5224f1407f06...f801b269a9475f86cc003a431b1045f3cf0db897 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94db08351659f012361c44ff1e9d5224f1407f06...f801b269a9475f86cc003a431b1045f3cf0db897 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 14:35:01 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 May 2023 10:35:01 -0400 Subject: [Git][ghc/ghc][wip/T23146] Merge outdated Note [Data con representation] into Note [Data constructor representation] Message-ID: <64551415be451_e3e0622b3d29839777@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 0ccbf4a0 by Rodrigo Mesquita at 2023-05-05T15:34:52+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 2 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Stg/Syntax.hs Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConId`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -528,7 +540,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -985,51 +997,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,50 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In STG, constructor applications `StgConApp` and `StgRhsCon` are always /fully saturated/. +However, the number of arguments saturating the application may differ +post-unarisation because we drop void arguments from `StgConApp` and `StgRhsCon` +constructor applications during unarisation. + +Therefore, in `StgConApp` and `StgRhsCon`: +* Before unarisation, we have the saturated list of the arguments [StgArg] +* Post unarisation, we have the saturated list of non-void arguments, the type +of which should really be [NonVoid StgArg] + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +289,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -421,7 +465,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that -- returns 'empty'. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ccbf4a018b7819d04445bfd8e4406c3413d9f71 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ccbf4a018b7819d04445bfd8e4406c3413d9f71 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 14:44:03 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 May 2023 10:44:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/clean17 Message-ID: <645516337a063_e3e0627cadfb040762a@gitlab.mail> Matthew Pickering pushed new branch wip/clean17 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/clean17 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 14:54:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 May 2023 10:54:18 -0400 Subject: [Git][ghc/ghc][wip/T23146] 180 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <6455189ae5dc5_e3e062d23d3f44179f3@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - f382f304 by Ben Gamari at 2023-05-05T15:53:19+01:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 50f47437 by Ben Gamari at 2023-05-05T15:53:19+01:00 codeGen: Fix some Haddocks - - - - - 69d3fd21 by Ben Gamari at 2023-05-05T15:53:19+01:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 900942b1 by Rodrigo Mesquita at 2023-05-05T15:53:19+01:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 641aaa5c by Rodrigo Mesquita at 2023-05-05T15:53:19+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - dc5132f2 by Rodrigo Mesquita at 2023-05-05T15:53:19+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e0784ad7 by Rodrigo Mesquita at 2023-05-05T15:53:19+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - a20ba1e4 by Rodrigo Mesquita at 2023-05-05T15:53:19+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - cd033ac4 by Rodrigo Mesquita at 2023-05-05T15:54:02+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ccbf4a018b7819d04445bfd8e4406c3413d9f71...cd033ac4a775e295bbd860925767f896d81d0600 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ccbf4a018b7819d04445bfd8e4406c3413d9f71...cd033ac4a775e295bbd860925767f896d81d0600 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 14:55:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 May 2023 10:55:18 -0400 Subject: [Git][ghc/ghc][wip/T23146] Merge outdated Note [Data con representation] into Note [Data constructor representation] Message-ID: <645518d68e12c_e3e0627131c04418763@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: c77f81c8 by Rodrigo Mesquita at 2023-05-05T15:55:10+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 2 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Stg/Syntax.hs Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConId`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -528,7 +540,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -985,51 +997,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,52 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After the unarisation pass: +* In `StgConApp` and `StgRhsCon` and `StgAlt` we filter out the void arguments, + leaving only non-void ones. +* In `StgApp` and `StgOpApp` we retain void arguments. + +We can do this because we know that `StgConApp` and `StgRhsCon` are saturated applications, +so we lose no information by dropping those void args. In contrast, in `StgApp` we need the + void argument to compare the number of args in the call with the arity of the function. + +This is an open design choice. We could instead choose to treat all these applications +consistently (keeping the void args). But for some reason we don't, and this Note simply +documents that design choice. + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +291,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -422,7 +468,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] Type -- Type, for rewriting to an StgRhsClosure -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c77f81c87e43b1dd1d34d7c928b323b675cab8c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c77f81c87e43b1dd1d34d7c928b323b675cab8c5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 15:03:13 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 05 May 2023 11:03:13 -0400 Subject: [Git][ghc/ghc][wip/dynamic-alpine] Build vanilla alpine bindists Message-ID: <64551ab1ed4f5_e3e0627131c04428882@gitlab.mail> Matthew Pickering pushed to branch wip/dynamic-alpine at Glasgow Haskell Compiler / GHC Commits: 8fd803a4 by Matthew Pickering at 2023-05-05T16:03:01+01:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -424,7 +424,7 @@ distroVariables Alpine = mconcat -- T10458, ghcilink002: due to #17869 -- linker_unload_native: due to musl not supporting any means of probing dynlib dependencies -- (see Note [Object unloading]). - , "BROKEN_TESTS" =: "encoding004 T10458 ghcilink002 linker_unload_native" + , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native" ] distroVariables Centos7 = mconcat [ "HADRIAN_ARGS" =: "--docs=no-sphinx" @@ -903,8 +903,11 @@ job_groups = , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) - , standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static) - , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + -- Fully static build, in theory usable on any linux distribution. + , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) + -- Dynamically linked build, suitable for building your own static executables on alpine + , standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla) + , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") ) @@ -919,6 +922,10 @@ job_groups = ] where + + -- ghcilink002 broken due to #17869 + fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 ") + hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url") tsan_jobs = ===================================== .gitlab/jobs.yaml ===================================== @@ -597,7 +597,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -606,6 +606,68 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-alpine3_12-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "8 weeks", + "paths": [ + "ghc-x86_64-linux-alpine3_12-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--docs=no-sphinx", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -659,7 +721,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -2472,7 +2534,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2535,7 +2597,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2545,6 +2607,69 @@ "XZ_OPT": "-9" } }, + "release-x86_64-linux-alpine3_12-release+no_split_sections": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "release+no_split_sections", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", + "IGNORE_PERF_FAILURES": "all", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", + "XZ_OPT": "-9" + } + }, "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3528,6 +3653,67 @@ "TEST_ENV": "x86_64-freebsd13-validate" } }, + "x86_64-linux-alpine3_12-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "2 weeks", + "paths": [ + "ghc-x86_64-linux-alpine3_12-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--docs=no-sphinx", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-validate" + } + }, "x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3581,7 +3767,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fd803a4fdbab1f8512e6bc935eb8d8e79ccfb0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fd803a4fdbab1f8512e6bc935eb8d8e79ccfb0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 17:11:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 13:11:05 -0400 Subject: [Git][ghc/ghc][master] Add structured error messages for GHC.Rename.Utils Message-ID: <645538a9759dc_e3e062d23d3f4458684@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30 changed files: - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - testsuite/tests/deSugar/should_compile/ds053.stderr - testsuite/tests/deriving/should_compile/T13919.stderr - testsuite/tests/driver/t22391/t22391.stderr - testsuite/tests/driver/t22391/t22391j.stderr - testsuite/tests/driver/werror.stderr - testsuite/tests/gadt/T12087.stderr - testsuite/tests/gadt/T14320.stderr - testsuite/tests/gadt/T16427.stderr - testsuite/tests/gadt/T18191.stderr - testsuite/tests/ghci/prog018/prog018.stdout - testsuite/tests/indexed-types/should_compile/ExplicitForAllFams2.stderr - testsuite/tests/indexed-types/should_compile/T16356_Compile2.stderr - testsuite/tests/indexed-types/should_compile/T16632.stderr - testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr - testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr - testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr - testsuite/tests/indexed-types/should_fail/T16110_Fail1.stderr - testsuite/tests/mdo/should_fail/mdofail002.stderr - testsuite/tests/mdo/should_fail/mdofail003.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/275836d211d119cb8786a91ca3108a4daa693cb2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/275836d211d119cb8786a91ca3108a4daa693cb2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 17:11:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 13:11:44 -0400 Subject: [Git][ghc/ghc][master] Use TemplateHaskellQuotes in TH.Syntax to construct Names Message-ID: <645538d09fea2_e3e0622b3d298462053@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - 1 changed file: - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -6,6 +6,7 @@ Trustworthy, DeriveFunctor, BangPatterns, RecordWildCards, ImplicitParams #-} {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} +{-# LANGUAGE TemplateHaskellQuotes #-} ----------------------------------------------------------------------------- -- | @@ -54,7 +55,7 @@ import Data.Ratio import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..) ) + TYPE, RuntimeRep(..), Multiplicity (..) ) import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) import GHC.Ptr ( Ptr, plusPtr ) import GHC.Lexeme ( startsVarSym, startsVarId ) @@ -65,7 +66,6 @@ import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types -import GHC.Stack #if __GLASGOW_HASKELL__ >= 901 import GHC.Types ( Levity(..) ) @@ -1067,8 +1067,7 @@ instance Lift (Fixed.Fixed a) where ex <- lift x return (ConE mkFixedName `AppE` ex) where - mkFixedName = - mkNameG DataName "base" "Data.Fixed" "MkFixed" + mkFixedName = 'Fixed.MkFixed instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) @@ -1139,19 +1138,8 @@ instance Lift ByteArray where ptr :: ForeignPtr Word8 ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb)) - --- We can't use a TH quote in this module because we're in the template-haskell --- package, so we conconct this quite defensive solution to make the correct name --- which will work if the package name or module name changes in future. addrToByteArrayName :: Name -addrToByteArrayName = helper - where - helper :: HasCallStack => Name - helper = - case getCallStack ?callStack of - [] -> error "addrToByteArrayName: empty call stack" - (_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray" - +addrToByteArrayName = 'addrToByteArray addrToByteArray :: Int -> Addr# -> ByteArray addrToByteArray (I# len) addr = runST $ ST $ @@ -1371,23 +1359,24 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) trueName, falseName :: Name -trueName = mkNameG DataName "ghc-prim" "GHC.Types" "True" -falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False" +trueName = 'True +falseName = 'False nothingName, justName :: Name -nothingName = mkNameG DataName "base" "GHC.Maybe" "Nothing" -justName = mkNameG DataName "base" "GHC.Maybe" "Just" +nothingName = 'Nothing +justName = 'Just leftName, rightName :: Name -leftName = mkNameG DataName "base" "Data.Either" "Left" -rightName = mkNameG DataName "base" "Data.Either" "Right" +leftName = 'Left +rightName = 'Right nonemptyName :: Name -nonemptyName = mkNameG DataName "base" "GHC.Base" ":|" +nonemptyName = '(:|) oneName, manyName :: Name -oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" -manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" +oneName = 'One +manyName = 'Many + ----------------------------------------------------- -- -- Generic Lift implementations View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/983ce55815f2dd57f84ee86eee97febf7d80b470 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/983ce55815f2dd57f84ee86eee97febf7d80b470 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 17:42:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 13:42:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Use TemplateHaskellQuotes in TH.Syntax to construct Names Message-ID: <64554007bc141_e3e0631535c104658b0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - 9abd0bd8 by Matthew Pickering at 2023-05-05T13:42:22-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 01f0f5a6 by Aaron Allen at 2023-05-05T13:42:22-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 07ccfc64 by Matthew Pickering at 2023-05-05T13:42:22-04:00 docs: Add Note [Timing of plugin initialization] - - - - - ad010960 by Matthew Pickering at 2023-05-05T13:42:22-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 18 changed files: - .gitlab-ci.yml - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Runtime/Loader.hs - ghc/Main.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/plugins/all.T - + testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs - testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs → testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs - + testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs - testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal - testsuite/tests/plugins/plugins04.stderr - testsuite/tests/plugins/test-hooks-plugin.hs - + testsuite/tests/plugins/test-log-hooks-plugin.hs - + testsuite/tests/plugins/test-log-hooks-plugin.stderr - + testsuite/tests/plugins/test-phase-hooks-plugin.hs - + testsuite/tests/plugins/test-phase-hooks-plugin.stderr Changes: ===================================== .gitlab-ci.yml ===================================== @@ -999,7 +999,7 @@ project-version: - . ./version.sh # Download existing ghcup metadata - - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-0.0.7.yaml" + - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://gitlab.haskell.org/ghc/ghcup-metadata/-/raw/updates/ghcup-0.0.7.yaml" - .gitlab/generate_job_metadata @@ -1048,6 +1048,37 @@ ghcup-metadata-nightly: rules: - if: $NIGHTLY +# Update the +ghcup-metadata-nightly-push: + stage: deploy + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + dependencies: null + tags: + - x86_64-linux + variables: + BUILD_FLAVOUR: default + GIT_SUBMODULE_STRATEGY: "none" + needs: + - job: ghcup-metadata-nightly + artifacts: true + script: + - git clone https://gitlab.haskell.org/ghc/ghcup-metadata.git + - cp metadata_test.yaml ghcup-metadata/ghcup-0.0.7.yaml + - cd ghcup-metadata + - git config user.email "ghc-ci at gitlab-haskell.org" + - git config user.name "GHC GitLab CI" + - git remote add gitlab_origin https://oauth2:$PROJECT_PUSH_TOKEN at gitlab.haskell.org/ghc/ghcup-metadata.git + - git add . + - git commit -m "Update metadata" + - git push gitlab_origin HEAD:updates -o ci.skip + rules: + - if: $NIGHTLY + # Only run the update on scheduled nightly pipelines, ie once a day + - if: $CI_PIPELINE_SOURCE == "schedule" + # And only update the metadata for master branch + - if: '$CI_COMMIT_BRANCH == "master"' + + ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -694,6 +694,10 @@ data WorkerLimit -- produced by calling 'depanal'. load' :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag load' mhmi_cache how_much mHscMessage mod_graph = do + -- In normal usage plugins are initialised already by ghc/Main.hs this is protective + -- 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 } guessOutputFile hsc_env <- getSession @@ -2852,13 +2856,11 @@ label_self thread_name = do runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () -runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do +runPipelines n_job hsc_env mHscMessager all_pipelines = do liftIO $ label_self "main --make thread" - - plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines - _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines hsc_env mHscMessager all_pipelines + _n -> runParPipelines n_job hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -244,12 +244,13 @@ compileOne' mHscMessage addFilesToClean tmpfs TFL_GhcSession $ [ml_obj_file $ ms_location summary] + -- Initialise plugins here for any plugins enabled locally for a module. plugin_hsc_env <- initializePlugins hsc_env let pipe_env = mkPipeEnv NoStop input_fn Nothing pipelineOutput status <- hscRecompStatus mHscMessage plugin_hsc_env upd_summary mb_old_iface mb_old_linkable (mod_index, nmods) let pipeline = hscPipeline pipe_env (setDumpPrefix pipe_env plugin_hsc_env, upd_summary, status) - (iface, linkable) <- runPipeline (hsc_hooks hsc_env) pipeline + (iface, linkable) <- runPipeline (hsc_hooks plugin_hsc_env) pipeline -- See Note [ModDetails and --make mode] details <- initModDetails plugin_hsc_env iface linkable' <- traverse (initWholeCoreBindings plugin_hsc_env iface details) (homeMod_bytecode linkable) @@ -526,7 +527,12 @@ findHSLib platform ws dirs lib = do -- Compile files in one-shot mode. oneShot :: HscEnv -> StopPhase -> [(String, Maybe Phase)] -> IO () -oneShot hsc_env stop_phase srcs = do +oneShot orig_hsc_env stop_phase srcs = do + -- In oneshot mode, initialise plugins specified on command line + -- we also initialise in ghc/Main but this might be used as an entry point by API clients who + -- should initialise their own plugins but may not. + -- See Note [Timing of plugin initialization] + hsc_env <- initializePlugins orig_hsc_env o_files <- mapMaybeM (compileFile hsc_env stop_phase) srcs case stop_phase of StopPreprocess -> return () ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -62,7 +62,6 @@ import GHC.Parser.Header import GHC.Data.StringBuffer import GHC.Types.SourceError import GHC.Unit.Finder -import GHC.Runtime.Loader import Data.IORef import GHC.Types.Name.Env import GHC.Platform.Ways @@ -82,6 +81,7 @@ import GHC.StgToJS.Linker.Linker (embedJsFile) import Language.Haskell.Syntax.Module.Name import GHC.Unit.Home.ModInfo +import GHC.Runtime.Loader (initializePlugins) newtype HookedUse a = HookedUse { runHookedUse :: (Hooks, PhaseHook) -> IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via (ReaderT (Hooks, PhaseHook) IO) @@ -724,9 +724,11 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do new_includes = addImplicitQuoteInclude paths [current_dir] paths = includePaths dflags0 dflags = dflags0 { includePaths = new_includes } - hsc_env = hscSetFlags dflags hsc_env0 - + hsc_env1 = hscSetFlags dflags hsc_env0 + -- Initialise plugins as the flags passed into runHscPhase might have local plugins just + -- specific to this module. + hsc_env <- initializePlugins hsc_env1 -- gather the imports and module name (hspp_buf,mod_name,imps,src_imps, ghc_prim_imp) <- do @@ -786,18 +788,17 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do -- run the compiler! let msg :: Messager msg hsc_env _ what _ = oneShotMsg (hsc_logger hsc_env) what - plugin_hsc_env' <- initializePlugins hsc_env -- Need to set the knot-tying mutable variable for interface -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var. -- See also Note [hsc_type_env_var hack] type_env_var <- newIORef emptyNameEnv - let plugin_hsc_env = plugin_hsc_env' { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) } + let hsc_env' = hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) } - status <- hscRecompStatus (Just msg) plugin_hsc_env mod_summary + status <- hscRecompStatus (Just msg) hsc_env' mod_summary Nothing emptyHomeModInfoLinkable (1, 1) - return (plugin_hsc_env, mod_summary, status) + return (hsc_env', mod_summary, status) -- | Calculate the ModLocation from the provided DynFlags. This function is only used -- in one-shot mode and therefore takes into account the effect of -o/-ohi flags ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -2,7 +2,7 @@ -- | Dynamically lookup up values from modules and loading them. module GHC.Runtime.Loader ( - initializePlugins, + initializePlugins, initializeSessionPlugins, -- * Loading plugins loadFrontendPlugin, @@ -74,7 +74,34 @@ import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types import Data.List (unzip4) import GHC.Iface.Errors.Ppr +import GHC.Driver.Monad +{- Note [Timing of plugin initialization] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Plugins needs to be initialised as soon as possible in the pipeline. This is because +driver plugins are executed immediately after being loaded, which can modify anything +in the HscEnv, including the logger and DynFlags (for example #21279). For example, +in ghc/Main.hs the logger is used almost immediately after the session has been initialised +and so if a user overwrites the logger expecting all output to go there then unless +the plugins are initialised before that point then unexpected things will happen. + +We initialise plugins in ghc/Main.hs for the main ghc executable. + +When people are using the GHC API, they also need to initialise plugins +at the highest level possible for things to work as expected. We keep +some defensive calls to plugin initialisation in functions like `load'` and `oneshot` +to catch cases where API users have not initialised their own plugins. + +In addition to this, there needs to be an initialisation call for each module +just in case the user has enabled a plugin just for that module using OPTIONS_GHC +pragma. + +-} + +-- | Initialise plugins specified by the current DynFlags and update the session. +initializeSessionPlugins :: GhcMonad m => m () +initializeSessionPlugins = getSession >>= liftIO . initializePlugins >>= setSession -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before ===================================== ghc/Main.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Platform.Host import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) #endif -import GHC.Runtime.Loader ( loadFrontendPlugin ) +import GHC.Runtime.Loader ( loadFrontendPlugin, initializeSessionPlugins ) import GHC.Unit.Env import GHC.Unit (UnitId, homeUnitDepends) @@ -257,16 +257,23 @@ main' postLoadMode units dflags0 args flagWarnings = do -- we've finished manipulating the DynFlags, update the session _ <- GHC.setSessionDynFlags dflags5 dflags6 <- GHC.getSessionDynFlags - hsc_env <- GHC.getSession + + -- Must do this before loading plugins + liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6) + + -- Initialise plugins here because the plugin author might already expect this + -- subsequent call to `getLogger` to be affected by a plugin. + initializeSessionPlugins + hsc_env <- getSession logger <- getLogger + ---------------- Display configuration ----------- case verbosity dflags6 of v | v == 4 -> liftIO $ dumpUnitsSimple hsc_env | v >= 5 -> liftIO $ dumpUnits hsc_env | otherwise -> return () - liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6) ---------------- Final sanity checking ----------- liftIO $ checkOptions postLoadMode dflags6 srcs objs units ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -6,6 +6,7 @@ Trustworthy, DeriveFunctor, BangPatterns, RecordWildCards, ImplicitParams #-} {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} +{-# LANGUAGE TemplateHaskellQuotes #-} ----------------------------------------------------------------------------- -- | @@ -54,7 +55,7 @@ import Data.Ratio import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), - TYPE, RuntimeRep(..) ) + TYPE, RuntimeRep(..), Multiplicity (..) ) import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) import GHC.Ptr ( Ptr, plusPtr ) import GHC.Lexeme ( startsVarSym, startsVarId ) @@ -65,7 +66,6 @@ import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types -import GHC.Stack #if __GLASGOW_HASKELL__ >= 901 import GHC.Types ( Levity(..) ) @@ -1067,8 +1067,7 @@ instance Lift (Fixed.Fixed a) where ex <- lift x return (ConE mkFixedName `AppE` ex) where - mkFixedName = - mkNameG DataName "base" "Data.Fixed" "MkFixed" + mkFixedName = 'Fixed.MkFixed instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) @@ -1139,19 +1138,8 @@ instance Lift ByteArray where ptr :: ForeignPtr Word8 ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb)) - --- We can't use a TH quote in this module because we're in the template-haskell --- package, so we conconct this quite defensive solution to make the correct name --- which will work if the package name or module name changes in future. addrToByteArrayName :: Name -addrToByteArrayName = helper - where - helper :: HasCallStack => Name - helper = - case getCallStack ?callStack of - [] -> error "addrToByteArrayName: empty call stack" - (_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray" - +addrToByteArrayName = 'addrToByteArray addrToByteArray :: Int -> Addr# -> ByteArray addrToByteArray (I# len) addr = runST $ ST $ @@ -1371,23 +1359,24 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) trueName, falseName :: Name -trueName = mkNameG DataName "ghc-prim" "GHC.Types" "True" -falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False" +trueName = 'True +falseName = 'False nothingName, justName :: Name -nothingName = mkNameG DataName "base" "GHC.Maybe" "Nothing" -justName = mkNameG DataName "base" "GHC.Maybe" "Just" +nothingName = 'Nothing +justName = 'Just leftName, rightName :: Name -leftName = mkNameG DataName "base" "Data.Either" "Left" -rightName = mkNameG DataName "base" "Data.Either" "Right" +leftName = 'Left +rightName = 'Right nonemptyName :: Name -nonemptyName = mkNameG DataName "base" "GHC.Base" ":|" +nonemptyName = '(:|) oneName, manyName :: Name -oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" -manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" +oneName = 'One +manyName = 'Many + ----------------------------------------------------- -- -- Generic Lift implementations ===================================== testsuite/tests/plugins/all.T ===================================== @@ -317,3 +317,17 @@ test('plugins-external', pre_cmd('$MAKE -s --no-print-directory -C shared-plugin package.plugins01 TOP={top}'), when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], makefile_test, []) + +test('test-phase-hooks-plugin', + [extra_files(['hooks-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-phase-hooks-plugin TOP={top}'), + + when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + compile, + ['-package-db hooks-plugin/pkg.test-phase-hooks-plugin/local.package.conf -fplugin Hooks.PhasePlugin -package hooks-plugin ' + config.plugin_way_flags]) + +test('test-log-hooks-plugin', + [extra_files(['hooks-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-log-hooks-plugin TOP={top}')], + compile_fail, + ['-package-db hooks-plugin/pkg.test-log-hooks-plugin/local.package.conf -fplugin Hooks.LogPlugin -package hooks-plugin ' + config.plugin_way_flags]) ===================================== testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs ===================================== @@ -0,0 +1,24 @@ +module Hooks.LogPlugin (plugin) where + +import GHC.Plugins +import GHC.Driver.Hooks +import GHC.Tc.Utils.Monad +import GHC.Utils.Logger +import GHC.Driver.Pipeline.Execute +import System.IO + +plugin :: Plugin +plugin = defaultPlugin { driverPlugin = hooksP } + +hooksP :: [CommandLineOption] -> HscEnv -> IO HscEnv +hooksP opts hsc_env = do + hSetBuffering stdout NoBuffering + let logger = hsc_logger hsc_env + logger' = pushLogHook logHook logger + hsc_env' = hsc_env { hsc_logger = logger' } + return hsc_env' + +logHook :: LogAction -> LogAction +logHook action logFlags messageClass srcSpan msgDoc = do + putStrLn "Log hook called" + action logFlags messageClass srcSpan msgDoc ===================================== testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs → testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs ===================================== @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall #-} -module Hooks.Plugin (plugin) where +module Hooks.MetaPlugin (plugin) where import GHC.Types.SourceText import GHC.Plugins ===================================== testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs ===================================== @@ -0,0 +1,30 @@ +{-# LANGUAGE GADTs #-} +{-# OPTIONS_GHC -Wall #-} +module Hooks.PhasePlugin (plugin) where + +import GHC.Plugins +import GHC.Driver.Hooks +import GHC.Tc.Utils.Monad +import GHC.Driver.Pipeline.Execute +import GHC.Driver.Pipeline.Phases +import System.IO + +plugin :: Plugin +plugin = defaultPlugin { driverPlugin = hooksP } + +hooksP :: [CommandLineOption] -> HscEnv -> IO HscEnv +hooksP opts hsc_env = do + hSetBuffering stdout NoBuffering + let hooks = hsc_hooks hsc_env + hooks' = hooks { runPhaseHook = Just fakeRunPhaseHook } + hsc_env' = hsc_env { hsc_hooks = hooks' } + return hsc_env' + +fakeRunPhaseHook :: PhaseHook +fakeRunPhaseHook = PhaseHook $ \tPhase -> do + liftIO $ case tPhase of + T_Cpp{} -> putStrLn "Cpp hook fired" + T_Hsc{} -> putStrLn "Hsc hook fired" + T_FileArgs{} -> putStrLn "FileArgs hook fired" + _ -> pure () + runPhase tPhase ===================================== testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal ===================================== @@ -4,6 +4,6 @@ version: 0.1 build-type: Simple library - exposed-modules: Hooks.Plugin + exposed-modules: Hooks.MetaPlugin, Hooks.PhasePlugin, Hooks.LogPlugin build-depends: base, ghc default-language: Haskell2010 ===================================== testsuite/tests/plugins/plugins04.stderr ===================================== @@ -1,2 +1 @@ -Module graph contains a cycle: - module ‘HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself +attempting to use module ‘main:HomePackagePlugin’ (./HomePackagePlugin.hs) which is not loaded ===================================== testsuite/tests/plugins/test-hooks-plugin.hs ===================================== @@ -1,4 +1,4 @@ -{-# OPTIONS -fplugin=Hooks.Plugin #-} +{-# OPTIONS -fplugin=Hooks.MetaPlugin #-} {-# LANGUAGE TemplateHaskell #-} module Main where ===================================== testsuite/tests/plugins/test-log-hooks-plugin.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = pure "type error" ===================================== testsuite/tests/plugins/test-log-hooks-plugin.stderr ===================================== @@ -0,0 +1,9 @@ +Log hook called + +test-log-hooks-plugin.hs:4:13: error: [GHC-83865] + • Couldn't match type ‘[Char]’ with ‘()’ + Expected: () + Actual: String + • In the first argument of ‘pure’, namely ‘"type error"’ + In the expression: pure "type error" + In an equation for ‘main’: main = pure "type error" ===================================== testsuite/tests/plugins/test-phase-hooks-plugin.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE CPP #-} +module Main where + +main :: IO () +main = pure () ===================================== testsuite/tests/plugins/test-phase-hooks-plugin.stderr ===================================== @@ -0,0 +1,5 @@ +FileArgs hook fired +Cpp hook fired +FileArgs hook fired +FileArgs hook fired +Hsc hook fired View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53c2d50d425d31e6aa1bc927df57e5f82e7d9d51...ad0109608cbabb6702e36fd85013ddc9d77020e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53c2d50d425d31e6aa1bc927df57e5f82e7d9d51...ad0109608cbabb6702e36fd85013ddc9d77020e8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 17:53:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 05 May 2023 13:53:18 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: ROMES:WIP Message-ID: <6455428eafac9_e3e063173913847175c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 7da8a61e by Rodrigo Mesquita at 2023-05-05T17:22:01+01:00 ROMES:WIP - - - - - 3243fd3b by Rodrigo Mesquita at 2023-05-05T18:53:09+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 16 changed files: - configure.ac - distrib/configure.ac.in - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Settings/Packages.hs - m4/ghc_toolchain.m4 - − m4/ghc_unregisterised.m4 - utils/ghc-toolchain/src/Main.hs → utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - + utils/ghc-toolchain/src/GHC/Toolchain.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs Changes: ===================================== configure.ac ===================================== @@ -298,10 +298,28 @@ then exit 1 fi -dnl ** Do an unregisterised build? +dnl ** Flag to override unregisterised build dnl -------------------------------------------------------------- -GHC_UNREGISTERISED +FP_DEFAULT_CHOICE_OVERRIDE_CHECK( + [unregisterised], + [unregisterised], + [registerised], + [Unregisterised], + [Build a toolchain with the unregisterised ABI (disabled by default on platforms with registerised support)], + [NO], + [YES], + [no]) + +dnl ** Flag to override tables next to code +dnl -------------------------------------------------------------- + +FP_DEFAULT_CHOICE_OVERRIDE_CHECK( + [tables-next-to-code], + [tables next to code], + [tables apart from code], + [TablesNextToCode], + [Build a tool chain with info tables laid out next to code (enabled by default when using the registerised ABI, on platforms that support it)]) # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT @@ -310,7 +328,7 @@ FP_FIND_ROOT if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then FP_SETUP_WINDOWS_TOOLCHAIN else - # TODO + # TODO () AC_PATH_TOOL([CC],[gcc], [clang]) AC_PATH_TOOL([CXX],[g++], [clang++]) AC_PATH_TOOL([NM],[nm]) @@ -561,23 +579,12 @@ dnl -------------------------------------------------------------- dnl ** does #! work? AC_SYS_INTERPRETER() -dnl ** look for GCC and find out which version -dnl Figure out which C compiler to use. Gcc is preferred. -dnl If gcc, make sure it's at least 4.7 -dnl -FP_GCC_VERSION - -dnl ** See whether cc supports -no-pie -FP_GCC_SUPPORTS_NO_PIE - dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on dnl RISCV64 GCC. FP_CC_SUPPORTS__ATOMICS -FP_GCC_EXTRA_FLAGS - dnl ** look to see if we have a C compiler using an llvm back end. dnl FP_CC_LLVM_BACKEND ===================================== distrib/configure.ac.in ===================================== @@ -149,11 +149,6 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion]) OptCmd="$OPT" AC_SUBST([OptCmd]) -dnl ** Check gcc version and flags we need to pass it ** -FP_GCC_VERSION -FP_GCC_SUPPORTS_NO_PIE -FP_GCC_EXTRA_FLAGS - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/config.mk.in ===================================== @@ -234,28 +234,16 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ LdHasFilelist = @LdHasFilelist@ LdIsGNULd = @LdIsGNULd@ LdHasNoCompactUnwind = @LdHasNoCompactUnwind@ -ArArgs = @ArArgs@ -ArSupportsAtFile = @ArSupportsAtFile@ -ArSupportsDashL = @ArSupportsDashL@ HaskellHostOs = @HaskellHostOs@ HaskellHostArch = @HaskellHostArch@ -HaskellTargetOs = @HaskellTargetOs@ -HaskellTargetArch = @HaskellTargetArch@ -TargetWordSize = @TargetWordSize@ -TargetWordBigEndian = @TargetWordBigEndian@ -TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ -TargetHasIdentDirective = @TargetHasIdentDirective@ -TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ -TablesNextToCode = @TablesNextToCode@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsCxxCompilerCommand = @SettingsCxxCompilerCommand@ ===================================== hadrian/cabal.project ===================================== @@ -1,4 +1,5 @@ packages: ./ + ../utils/ghc-toolchain/ -- This essentially freezes the build plan for hadrian index-state: 2023-03-30T10:00:00Z ===================================== hadrian/cfg/system.config.in ===================================== @@ -39,9 +39,7 @@ python = @PythonCmd@ # Information about builders: #============================ -ar-supports-at-file = @ArSupportsAtFile@ system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@ -ar-supports-dash-l = @ArSupportsDashL@ system-ar-supports-dash-l = @ArSupportsDashL_STAGE0@ cc-llvm-backend = @CcLlvmBackend@ hs-cpp-args = @HaskellCPPArgs@ @@ -49,11 +47,8 @@ hs-cpp-args = @HaskellCPPArgs@ # Build options: #=============== -ghc-unregisterised = @Unregisterised@ -tables-next-to-code = @TablesNextToCode@ use-libffi-for-adjustors = @UseLibffiForAdjustors@ ghc-source-path = @hardtop@ -leading-underscore = @LeadingUnderscore@ # Information about build, host and target systems: #================================================== @@ -136,12 +131,10 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ld-is-gnu-ld = @LdIsGNULd@ -ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ ===================================== hadrian/hadrian.cabal ===================================== @@ -163,6 +163,7 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , ghc-toolchain ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Base.hs ===================================== @@ -31,6 +31,7 @@ module Base ( -- * Paths hadrianPath, configPath, configFile, sourcePath, shakeFilesDir, stageBinPath, stageLibPath, templateHscPath, + hostTargetFile, targetTargetFile, ghcBinDeps, ghcLibDeps, haddockDeps, relativePackageDbPath, packageDbPath, packageDbStamp, mingwStamp, systemCxxStdLibConf, systemCxxStdLibConfPath @@ -79,6 +80,16 @@ configPath = hadrianPath -/- "cfg" configFile :: FilePath configFile = configPath -/- "system.config" +-- | The target configuration file generated by ghc-toolchain for the +-- compilation host +hostTargetFile :: FilePath +hostTargetFile = "default.target" -- ROMES:TODO: Not hardcode this value? + +-- | The target configuration file generated by ghc-toolchain for the +-- compilation target +targetTargetFile :: FilePath +targetTargetFile = "default.target" -- ROMES:TODO: Not hardcode this value, depends on target + -- | Path to source files of the build system, e.g. this file is located at -- @sourcePath -/- "Base.hs"@. We use this to track some of the source files. sourcePath :: FilePath ===================================== hadrian/src/Hadrian/Oracles/TextFile.hs ===================================== @@ -12,7 +12,8 @@ ----------------------------------------------------------------------------- module Hadrian.Oracles.TextFile ( lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupSystemConfig, lookupValues, - lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, textFileOracle + lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, textFileOracle, + getHostTargetConfig, getTargetTargetConfig ) where import Control.Monad @@ -24,6 +25,8 @@ import Development.Shake.Classes import Development.Shake.Config import Base +import qualified GHC.Toolchain.Target as Toolchain + -- | Lookup a value in a text file, tracking the result. Each line of the file -- is expected to have @key = value@ format. lookupValue :: FilePath -> String -> Action (Maybe String) @@ -79,6 +82,21 @@ lookupDependencies depFile file = do Just [] -> error $ "No source file found for file " ++ quote file Just (source : files) -> return (source, files) +-- | Parse a target from a text file, tracking the result. The file is expected +-- to contain a parseable Toolchain.Target value generated by ghc-toolchain. +getTargetConfig :: FilePath -> Action Toolchain.Target +getTargetConfig file = askOracle $ TargetFile file + +-- | Get the host's target configuration through 'getTarget' +getHostTargetConfig :: Action Toolchain.Target +getHostTargetConfig = getTargetConfig hostTargetFile + -- where + -- msg = "The host's target configuration file " ++ quote hostTargetFile ++ " does not exist! ghc-toolchain might have failed to generate it." + +-- | Get the target's target configuration through 'getTarget' +getTargetTargetConfig :: Action Toolchain.Target +getTargetTargetConfig = getTargetConfig targetTargetFile + newtype KeyValue = KeyValue (FilePath, String) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) type instance RuleResult KeyValue = Maybe String @@ -87,6 +105,10 @@ newtype KeyValues = KeyValues (FilePath, String) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) type instance RuleResult KeyValues = Maybe [String] +newtype TargetFile = TargetFile FilePath + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult TargetFile = Toolchain.Target + -- | These oracle rules are used to cache and track answers to the following -- queries, which are implemented by parsing text files: -- @@ -97,6 +119,10 @@ type instance RuleResult KeyValues = Maybe [String] -- -- 2) Parsing Makefile dependency files generated by commands like @gcc -MM@: -- see 'lookupDependencies'. +-- +-- 3) Parsing target files as generated by ghc-toolchain. See functions +-- 'lookupTarget' and lookupTargetConfig' +-- textFileOracle :: Rules () textFileOracle = do kv <- newCache $ \file -> do @@ -111,3 +137,27 @@ textFileOracle = do contents <- map words <$> readFileLines file return $ Map.fromList [ (key, values) | (key:values) <- contents ] void $ addOracleCache $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file + + tf <- newCache $ \file -> do + need [file] + putVerbose $ "| TargetFile oracle: reading " ++ quote file ++ "..." + target <- read <$> readFile' file + return (target :: Toolchain.Target) + void $ addOracle $ \(TargetFile file) -> tf file + +-- ROMES:TODO: get back to this!!!!!! +instance Eq Toolchain.Target where + (==) _ _ = True + +instance Ord Toolchain.Target where + (<=) _ _ = False +instance Hashable Toolchain.Target where + hashWithSalt _ _ = 0 +instance Binary Toolchain.Target where + put _ = undefined + get = undefined + +instance NFData Toolchain.Target where + rnf _ = () + + ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -17,6 +17,9 @@ import Hadrian.Expression import Base import Oracles.Setting +import GHC.Toolchain.Target (Target(..)) +import qualified GHC.Toolchain as Toolchain + data Flag = ArSupportsAtFile | ArSupportsDashL | SystemArSupportsAtFile @@ -44,38 +47,50 @@ data Flag = ArSupportsAtFile | UseLibpthread | NeedLibatomic +data FlagKey = SystemConfigKey String + | HostTargetKey (Toolchain.Target -> Bool) + | TargetTargetKey (Toolchain.Target -> Bool) + -- Note, if a flag is set to empty string we treat it as set to NO. This seems -- fragile, but some flags do behave like this. flag :: Flag -> Action Bool flag f = do - let key = case f of - ArSupportsAtFile -> "ar-supports-at-file" - ArSupportsDashL -> "ar-supports-dash-l" - SystemArSupportsAtFile-> "system-ar-supports-at-file" - SystemArSupportsDashL-> "system-ar-supports-dash-l" - CrossCompiling -> "cross-compiling" - CcLlvmBackend -> "cc-llvm-backend" - GhcUnregisterised -> "ghc-unregisterised" - TablesNextToCode -> "tables-next-to-code" - GmpInTree -> "intree-gmp" - GmpFrameworkPref -> "gmp-framework-preferred" - LeadingUnderscore -> "leading-underscore" - UseSystemFfi -> "use-system-ffi" - BootstrapThreadedRts -> "bootstrap-threaded-rts" - BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" - UseLibffiForAdjustors -> "use-libffi-for-adjustors" - UseLibdw -> "use-lib-dw" - UseLibnuma -> "use-lib-numa" - UseLibm -> "use-lib-m" - UseLibrt -> "use-lib-rt" - UseLibdl -> "use-lib-dl" - UseLibbfd -> "use-lib-bfd" - UseLibpthread -> "use-lib-pthread" - NeedLibatomic -> "need-libatomic" - value <- lookupSystemConfig key - when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag " - ++ quote (key ++ " = " ++ value) ++ " cannot be parsed." - return $ value == "YES" + let flagkey :: FlagKey = case f of + ArSupportsAtFile -> TargetTargetKey (Toolchain.arSupportsAtFile . tgtAr) + ArSupportsDashL -> TargetTargetKey (Toolchain.arSupportsDashL . tgtAr) + SystemArSupportsAtFile-> HostTargetKey (Toolchain.arSupportsAtFile . tgtAr) + SystemArSupportsDashL-> HostTargetKey (Toolchain.arSupportsDashL . tgtAr) + CrossCompiling -> SystemConfigKey "cross-compiling" + CcLlvmBackend -> SystemConfigKey "cc-llvm-backend" + GhcUnregisterised -> TargetTargetKey tgtUnregisterised + TablesNextToCode -> TargetTargetKey tgtTablesNextToCode + GmpInTree -> SystemConfigKey "intree-gmp" + GmpFrameworkPref -> SystemConfigKey "gmp-framework-preferred" + LeadingUnderscore -> TargetTargetKey tgtSymbolsHaveLeadingUnderscore + UseSystemFfi -> SystemConfigKey "use-system-ffi" + BootstrapThreadedRts -> SystemConfigKey "bootstrap-threaded-rts" + BootstrapEventLoggingRts -> SystemConfigKey "bootstrap-event-logging-rts" + UseLibffiForAdjustors -> SystemConfigKey "use-libffi-for-adjustors" + UseLibdw -> SystemConfigKey "use-lib-dw" + UseLibnuma -> SystemConfigKey "use-lib-numa" + UseLibm -> SystemConfigKey "use-lib-m" + UseLibrt -> SystemConfigKey "use-lib-rt" + UseLibdl -> SystemConfigKey "use-lib-dl" + UseLibbfd -> SystemConfigKey "use-lib-bfd" + UseLibpthread -> SystemConfigKey "use-lib-pthread" + NeedLibatomic -> SystemConfigKey "need-libatomic" + case flagkey of + SystemConfigKey key -> do + value <- lookupSystemConfig key + when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag " + ++ quote (key ++ " = " ++ value) ++ " cannot be parsed." + return $ value == "YES" + HostTargetKey key -> do + value <- key <$> getHostTargetConfig + return value + TargetTargetKey key -> do + value <- key <$> getTargetTargetConfig + return value -- | Get a configuration setting. getFlag :: Flag -> Expr c b Bool ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -276,7 +276,7 @@ rtsPackageArgs = package rts ? do way <- getWay path <- getBuildPath top <- expr topDirectory - useSystemFfi <- expr $ flag UseSystemFfi + useSystemFfi <- getFlag UseSystemFfi ffiIncludeDir <- getSetting FfiIncludeDir ffiLibraryDir <- getSetting FfiLibDir libdwIncludeDir <- getSetting LibdwIncludeDir ===================================== m4/ghc_toolchain.m4 ===================================== @@ -20,7 +20,9 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--triple=$target" >> acargs echo "--cc=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - # TODO + # TODO (previously we had in configure script use of --traditional??) + # First thing disable the comment: + # Also, differentiatiate between hscpp and cpp? #echo "--cpp=$CPP" >> acargs ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) echo "--cc-link=$CC" >> acargs @@ -42,7 +44,11 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--disable-unregisterised" >> acargs fi - # TODO: TNTC + if test "$TablesNextToCode" = "YES"; then + echo "--enable-tables-next-to-code" >> acargs + else + echo "--disable-tables-next-to-code" >> acargs + fi ( set -- @@ -50,7 +56,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], set -- "[$]@" "$arg" done ./acghc-toolchain "[$]@" || exit 1 - python -c 'import sys; print(sys.argv)' "[$]@" + python3 -c 'import sys; print(sys.argv)' "[$]@" ) M a -> IO (Either [Error] a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f02181995fcccea4e456431db8698dfd7a1309d6...3243fd3b5275a445d703c5e122ab1573ba097152 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f02181995fcccea4e456431db8698dfd7a1309d6...3243fd3b5275a445d703c5e122ab1573ba097152 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 19:52:40 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 05 May 2023 15:52:40 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Improve comments Message-ID: <64555e882c382_e3e0633cc6dec49412e@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 7cd3dda6 by Ben Gamari at 2023-05-05T19:52:38+00:00 Improve comments - - - - - 1 changed file: - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -365,15 +365,15 @@ data GenClosure b -- | A primitive word from a bitmap encoded stack frame payload -- - -- The type itself cannot be restored (i.e. it might also represent a byte - -- or an int). + -- The type itself cannot be restored (i.e. it might represent a Word8# + -- or an Int#). | UnknownTypeWordSizedPrimitive { wordVal :: !Word } deriving (Show, Generic, Functor, Foldable, Traversable) -- | A decoded @StgStack@ with `StackFrame`s -- --- This is separate from it's `Closure` incarnation, as unification would +-- This is separate from its `Closure` incarnation, as unification would -- require two kinds of boxes for bitmap encoded stack content: One for -- primitives and one for closures. This turned out to be a nightmare with lots -- of pattern matches and leaking data structures to enable access to primitives View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cd3dda60f9593804a7770609f39a4983b8ca298 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cd3dda60f9593804a7770609f39a4983b8ca298 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 20:00:13 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 05 May 2023 16:00:13 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 136 commits: Add support for -debug in the testsuite Message-ID: <6455604d4720c_e3e0631535c104946f7@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - 71c0f118 by Sven Tennie at 2023-05-05T19:59:52+00:00 ghc-heap: Decode StgStack and its frames Previously, ghc-heap could only decode heap closures. The approach is explained in detail in note [Decoding the stack]. - - - - - cc3d412d by Sven Tennie at 2023-05-05T19:59:52+00:00 Splitting StackFrames from Closures: Compiles - - - - - eccb5e42 by Sven Tennie at 2023-05-05T19:59:52+00:00 Fix tests - - - - - 80faa5b7 by Sven Tennie at 2023-05-05T19:59:52+00:00 Validate - - - - - 81f592f3 by Sven Tennie at 2023-05-05T19:59:52+00:00 Remove unnecessary instances - - - - - 633487f9 by Sven Tennie at 2023-05-05T19:59:52+00:00 Smaller diff - - - - - b479f2b3 by Sven Tennie at 2023-05-05T19:59:52+00:00 Add comment - - - - - c3b6d2de by Sven Tennie at 2023-05-05T19:59:52+00:00 Add comment - - - - - 97792e9a by Sven Tennie at 2023-05-05T19:59:52+00:00 Add C function signatures to Cmm for readability - - - - - 1b265cfd by Sven Tennie at 2023-05-05T19:59:52+00:00 Better assertion message - - - - - 9006a2f1 by Sven Tennie at 2023-05-05T19:59:53+00:00 More iterations to get more underflow frames - - - - - e85771ba by Sven Tennie at 2023-05-05T19:59:53+00:00 Rename - - - - - fec74c95 by Sven Tennie at 2023-05-05T19:59:53+00:00 getClosure returns Closure - - - - - 1590209b by Sven Tennie at 2023-05-05T19:59:53+00:00 getClosure: One WordOffset is enough - - - - - 9306ac1f by Sven Tennie at 2023-05-05T19:59:53+00:00 getWord: One offset is enough - - - - - 5d015c94 by Sven Tennie at 2023-05-05T19:59:53+00:00 decodeBitmaps: One offset is enough - - - - - 2577ee98 by Sven Tennie at 2023-05-05T19:59:53+00:00 Formatting, notes - - - - - 1a917069 by Sven Tennie at 2023-05-05T19:59:53+00:00 Minimize diff - - - - - 56fe2462 by Sven Tennie at 2023-05-05T19:59:53+00:00 Fix overloaded naming issues - - - - - a58284ad by Sven Tennie at 2023-05-05T19:59:53+00:00 Reduce diff - - - - - dbffeb4b by Sven Tennie at 2023-05-05T19:59:53+00:00 Use function level pattern match - - - - - bc4da44d by Sven Tennie at 2023-05-05T19:59:53+00:00 Simpify bitmap decoding - - - - - 87c1f82f by Sven Tennie at 2023-05-05T19:59:53+00:00 Get rid of StackFrameIter - - - - - 3557c62f by Sven Tennie at 2023-05-05T19:59:53+00:00 Formatting - - - - - c2ec6788 by Sven Tennie at 2023-05-05T19:59:53+00:00 Add docs / rename - - - - - 373f0f22 by Sven Tennie at 2023-05-05T19:59:53+00:00 Cleanup - - - - - 62c74837 by Sven Tennie at 2023-05-05T19:59:53+00:00 Printer: Add missing frame support - - - - - 0a77b364 by Sven Tennie at 2023-05-05T19:59:53+00:00 Printer: More readable RET_FUN code - - - - - e83bba0d by Sven Tennie at 2023-05-05T19:59:53+00:00 Haddock - - - - - ecab6705 by Sven Tennie at 2023-05-05T19:59:53+00:00 Simplify stackHead - - - - - e94cd054 by Sven Tennie at 2023-05-05T19:59:53+00:00 Formatting - - - - - 2e7ab0e5 by Sven Tennie at 2023-05-05T19:59:53+00:00 Rename: getBoxedClosure -> getStackClosure - - - - - 1a685641 by Sven Tennie at 2023-05-05T19:59:53+00:00 Document Cmm return values - - - - - b57e4efc by Sven Tennie at 2023-05-05T19:59:53+00:00 Un-IO getWord - - - - - 72e3ee93 by Sven Tennie at 2023-05-05T19:59:53+00:00 Un-IO getUnderflowFrameNextChunk - - - - - 67f4ff68 by Sven Tennie at 2023-05-05T19:59:53+00:00 Un-IO getRetFunType - - - - - f041876d by Sven Tennie at 2023-05-05T19:59:53+00:00 Un-IO LargeBitmapGetter - - - - - 50d23617 by Sven Tennie at 2023-05-05T19:59:53+00:00 Un-IO SmallBitmapGetter - - - - - 6ea11206 by Sven Tennie at 2023-05-05T19:59:53+00:00 Formatting and one comment - - - - - e7a1b015 by Sven Tennie at 2023-05-05T19:59:53+00:00 Add missing bang patterns to StackFrames - - - - - 96dc4ee1 by Sven Tennie at 2023-05-05T19:59:53+00:00 Try more general data structure - - - - - 867c723f by Ben Gamari at 2023-05-05T19:59:53+00:00 Improve comments - - - - - 8acd9250 by Sven Tennie at 2023-05-05T19:59:53+00:00 Fix test - - - - - 69495779 by Sven Tennie at 2023-05-05T19:59:53+00:00 Inline - - - - - fce1eec4 by Sven Tennie at 2023-05-05T19:59:53+00:00 Fix test - - - - - 2f714b69 by Sven Tennie at 2023-05-05T19:59:53+00:00 Improve docs - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7cd3dda60f9593804a7770609f39a4983b8ca298...2f714b698664045e77476905517120f27c0aee30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7cd3dda60f9593804a7770609f39a4983b8ca298...2f714b698664045e77476905517120f27c0aee30 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 20:51:11 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 05 May 2023 16:51:11 -0400 Subject: [Git][ghc/ghc][wip/T23333] 3 commits: Add structured error messages for GHC.Rename.Utils Message-ID: <64556c3f753c0_e3e0633cc6dec49944d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23333 at Glasgow Haskell Compiler / GHC Commits: 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5c1de98 by Simon Peyton Jones at 2023-05-05T21:51:05+01:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - 30 changed files: - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/deSugar/should_compile/ds053.stderr - testsuite/tests/deriving/should_compile/T13919.stderr - testsuite/tests/driver/t22391/t22391.stderr - testsuite/tests/driver/t22391/t22391j.stderr - testsuite/tests/driver/werror.stderr - testsuite/tests/gadt/T12087.stderr - testsuite/tests/gadt/T14320.stderr - testsuite/tests/gadt/T16427.stderr - testsuite/tests/gadt/T18191.stderr - testsuite/tests/ghci/prog018/prog018.stdout - testsuite/tests/indexed-types/should_compile/ExplicitForAllFams2.stderr - testsuite/tests/indexed-types/should_compile/T16356_Compile2.stderr - testsuite/tests/indexed-types/should_compile/T16632.stderr - testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/264162062e7327d89bd7baf5a45cbe3105558f8b...a5c1de9893d7496903989c12353ec903c049ed6c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/264162062e7327d89bd7baf5a45cbe3105558f8b...a5c1de9893d7496903989c12353ec903c049ed6c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 21:18:39 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 05 May 2023 17:18:39 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - Discard default monad fail alternatives that are spuriously generated Message-ID: <645572af5cb45_e3e063580eb04502068@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: adc71cd6 by Apoorv Ingle at 2023-05-05T16:14:23-05:00 - Discard default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 8 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - -- (ppr orig) - = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + (ppr orig) + -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -39,7 +39,7 @@ module GHC.Hs.Pat ( mkPrefixConPat, mkCharLitPat, mkNilPat, - isSimplePat, + isSimplePat, isPatSyn, looksLazyPatBind, isBangedLPat, gParPat, patNeedsParens, parenthesizePat, @@ -617,6 +617,10 @@ isSimplePat p = case unLoc p of VarPat _ x -> Just (unLoc x) _ -> Nothing +isPatSyn :: LPat GhcTc -> Bool +isPatSyn (L _ (ConPat {pat_con = L _ (PatSynCon{})})) = True +isPatSyn _ = False + {- Note [Unboxed sum patterns aren't irrefutable] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,21 +858,19 @@ warnDiscardedDoBindings rhs rhs_ty warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty - | Just (SrcSpanAnn _ l, (L (SrcSpanAnn _ loc) f)) <- fish_var fun + | Just (SrcSpanAnn _ l, f) <- fish_var fun , is_gen_then f - -- , isNoSrcSpan l + , isGeneratedSrcSpan l = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun - , text "arg" <+> ppr arg - , text "arg_ty" <+> ppr arg_ty - , text "f" <+> ppr f <+> ppr (is_gen_then f) - , text "l" <+> ppr (isNoSrcSpan l) <+> ppr (isNoSrcSpan loc) + , text "loc" <+> ppr l <+> ppr loc + , text "locGen?" <+> ppr (isGeneratedSrcSpan l) <+> ppr (isGeneratedSrcSpan loc) + , text "noLoc?" <+> ppr (isNoSrcSpan l) <+> ppr (isNoSrcSpan loc) ]) warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application - fish_var :: LHsExpr GhcTc -> Maybe (SrcSpanAnnA , LIdP GhcTc) + fish_var :: LHsExpr GhcTc -> Maybe (SrcSpanAnnA , Id) fish_var (L l (HsVar _ id)) = return (l, id) - fish_var (L _ (PopSrcSpan e)) = pprPanic "warnUnusedBindValue" (ppr e) fish_var (L _ (HsAppType _ e _ _)) = fish_var e fish_var (L l (XExpr (WrapExpr (HsWrap _ e)))) = do (l, e') <- fish_var (L l e) return (l, e') ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -227,7 +227,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty match_groups [] = matchEmpty v ty match_groups (g:gs) = mapM match_group $ g :| gs - match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM (MatchResult CoreExpr) + match_group :: NonEmpty (PatGroup, EquationInfo) -> DsM (MatchResult CoreExpr) match_group eqns@((group,_) :| _) = case group of PgCon {} -> matchConFamily vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns']) @@ -767,12 +767,15 @@ one pattern, and match simply only accepts one pattern. JJQC 30-Nov-1997 -} -matchWrapper ctxt scrs (MG { mg_alts = L _ matches +matchWrapper ctxt scrs (MG { mg_alts = L _ matches' , mg_ext = MatchGroupTc arg_tys rhs_ty origin }) = do { dflags <- getDynFlags ; locn <- getSrcSpanDs - + ; let matches = if any (is_pat_syn_match origin) matches' + then filter (non_wc origin) matches' -- filter out the wild pattern fail alternatives that + -- generate spurious overlapping warnings + else matches' ; new_vars <- case matches of [] -> newSysLocalsDs arg_tys (m:_) -> @@ -827,7 +830,13 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches $ NEL.nonEmpty $ replicate (length (grhssGRHSs m)) initNablas - + is_pat_syn_match :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool + is_pat_syn_match Generated (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat + is_pat_syn_match _ _ = False + non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool + non_wc Generated (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc _ _ = True + matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -91,7 +91,7 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) +import GHC.Types.Basic ( Origin (..) ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -325,7 +325,9 @@ tcApp rn_expr exp_res_ty | (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr = do { traceTc "tcApp {" $ vcat [ text "rn_fun:" <+> ppr rn_fun - , text "rn_args:" <+> ppr rn_args ] + , text "rn_args:" <+> ppr rn_args + , text "fun_ctxt:" <+> ppr fun_ctxt <+> ppr (appCtxtLoc fun_ctxt) + ] ; (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1383,17 +1383,16 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc mk_failable_lexpr_tcm pat lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict - ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr pat + ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat , ppr $ isIrrefutableHsPatRn tc_env is_strict pat ]) ; if isIrrefutableHsPatRn tc_env is_strict pat - -- don't decorate with fail statement if the pattern is irrefutable - -- pattern syns always get a fail block while desugaring so skip + -- don't decorate with fail statement if + -- 1) the pattern is irrefutable then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } - where -- makes the fail block -- TODO: check the discussion around MonadFail.fail type signature. ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1623,9 +1623,9 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs - +-- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on the isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool -isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = goL pat +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict = goL where goL :: LPat GhcRn -> Bool goL = go . unLoc @@ -1649,11 +1649,22 @@ isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = go (ConPat { pat_con = L _ dcName - , pat_args = details }) = case lookupTypeEnv type_env dcName of - Just (ATyCon con) -> - isJust (tyConSingleDataCon_maybe con) - && all goL (hsConPatArgs details) - _ -> False -- conservative. + , pat_args = details }) = + case lookupTypeEnv type_env dcName of + Just (ATyCon tycon) -> + (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon) + && all goL (hsConPatArgs details) + Just id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + Just (AConLike cl) -> case cl of + RealDataCon dc -> let tycon = dataConTyCon dc in + (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon) + && all goL (hsConPatArgs details) + PatSynCon _ -> False -- conservative + + Just ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + _ -> False -- conservative. go (LitPat {}) = False go (NPat {}) = False go (NPlusKPat {}) = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/adc71cd6eb04db55279b7bd5784185292b2ab374 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/adc71cd6eb04db55279b7bd5784185292b2ab374 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 21:41:17 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 05 May 2023 17:41:17 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - Discard default monad fail alternatives that are spuriously generated Message-ID: <645577fd8bb8d_e3e063580eaf05028bf@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 372ad22d by Apoorv Ingle at 2023-05-05T16:41:09-05:00 - Discard default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 8 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - -- (ppr orig) - = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + (ppr orig) + -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -39,7 +39,7 @@ module GHC.Hs.Pat ( mkPrefixConPat, mkCharLitPat, mkNilPat, - isSimplePat, + isSimplePat, isPatSyn, looksLazyPatBind, isBangedLPat, gParPat, patNeedsParens, parenthesizePat, @@ -617,6 +617,10 @@ isSimplePat p = case unLoc p of VarPat _ x -> Just (unLoc x) _ -> Nothing +isPatSyn :: LPat GhcTc -> Bool +isPatSyn (L _ (ConPat {pat_con = L _ (PatSynCon{})})) = True +isPatSyn _ = False + {- Note [Unboxed sum patterns aren't irrefutable] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,21 +858,21 @@ warnDiscardedDoBindings rhs rhs_ty warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty - | Just (SrcSpanAnn _ l, (L (SrcSpanAnn _ loc) f)) <- fish_var fun + | Just (l, f) <- fish_var fun , is_gen_then f - -- , isNoSrcSpan l + , isGeneratedSrcSpan l = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun - , text "arg" <+> ppr arg - , text "arg_ty" <+> ppr arg_ty - , text "f" <+> ppr f <+> ppr (is_gen_then f) - , text "l" <+> ppr (isNoSrcSpan l) <+> ppr (isNoSrcSpan loc) + , text "loc" <+> ppr l + , text "locGen?" <+> ppr (isGeneratedSrcSpan l) + , text "noLoc?" <+> ppr (isNoSrcSpan l) ]) warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application - fish_var :: LHsExpr GhcTc -> Maybe (SrcSpanAnnA , LIdP GhcTc) - fish_var (L l (HsVar _ id)) = return (l, id) - fish_var (L _ (PopSrcSpan e)) = pprPanic "warnUnusedBindValue" (ppr e) + -- It is important that we /do not/ look through HsApp to avoid + -- generating duplicate warnings + fish_var :: LHsExpr GhcTc -> Maybe (SrcSpan , Id) + fish_var (L l (HsVar _ id)) = return (locA l, unLoc id) fish_var (L _ (HsAppType _ e _ _)) = fish_var e fish_var (L l (XExpr (WrapExpr (HsWrap _ e)))) = do (l, e') <- fish_var (L l e) return (l, e') ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -227,7 +227,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty match_groups [] = matchEmpty v ty match_groups (g:gs) = mapM match_group $ g :| gs - match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM (MatchResult CoreExpr) + match_group :: NonEmpty (PatGroup, EquationInfo) -> DsM (MatchResult CoreExpr) match_group eqns@((group,_) :| _) = case group of PgCon {} -> matchConFamily vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns']) @@ -767,12 +767,15 @@ one pattern, and match simply only accepts one pattern. JJQC 30-Nov-1997 -} -matchWrapper ctxt scrs (MG { mg_alts = L _ matches +matchWrapper ctxt scrs (MG { mg_alts = L _ matches' , mg_ext = MatchGroupTc arg_tys rhs_ty origin }) = do { dflags <- getDynFlags ; locn <- getSrcSpanDs - + ; let matches = if any (is_pat_syn_match origin) matches' + then filter (non_wc origin) matches' -- filter out the wild pattern fail alternatives that + -- generate spurious overlapping warnings + else matches' ; new_vars <- case matches of [] -> newSysLocalsDs arg_tys (m:_) -> @@ -827,7 +830,13 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches $ NEL.nonEmpty $ replicate (length (grhssGRHSs m)) initNablas - + is_pat_syn_match :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool + is_pat_syn_match Generated (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat + is_pat_syn_match _ _ = False + non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool + non_wc Generated (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc _ _ = True + matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -91,7 +91,7 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) +import GHC.Types.Basic ( Origin (..) ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -325,7 +325,9 @@ tcApp rn_expr exp_res_ty | (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr = do { traceTc "tcApp {" $ vcat [ text "rn_fun:" <+> ppr rn_fun - , text "rn_args:" <+> ppr rn_args ] + , text "rn_args:" <+> ppr rn_args + , text "fun_ctxt:" <+> ppr fun_ctxt <+> ppr (appCtxtLoc fun_ctxt) + ] ; (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1383,17 +1383,16 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc mk_failable_lexpr_tcm pat lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict - ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr pat + ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat , ppr $ isIrrefutableHsPatRn tc_env is_strict pat ]) ; if isIrrefutableHsPatRn tc_env is_strict pat - -- don't decorate with fail statement if the pattern is irrefutable - -- pattern syns always get a fail block while desugaring so skip + -- don't decorate with fail statement if + -- 1) the pattern is irrefutable then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } - where -- makes the fail block -- TODO: check the discussion around MonadFail.fail type signature. ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1623,9 +1623,9 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs - +-- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on the isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool -isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = goL pat +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict = goL where goL :: LPat GhcRn -> Bool goL = go . unLoc @@ -1649,11 +1649,22 @@ isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = go (ConPat { pat_con = L _ dcName - , pat_args = details }) = case lookupTypeEnv type_env dcName of - Just (ATyCon con) -> - isJust (tyConSingleDataCon_maybe con) - && all goL (hsConPatArgs details) - _ -> False -- conservative. + , pat_args = details }) = + case lookupTypeEnv type_env dcName of + Just (ATyCon tycon) -> + (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon) + && all goL (hsConPatArgs details) + Just id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + Just (AConLike cl) -> case cl of + RealDataCon dc -> let tycon = dataConTyCon dc in + (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon) + && all goL (hsConPatArgs details) + PatSynCon _ -> False -- conservative + + Just ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + _ -> False -- conservative. go (LitPat {}) = False go (NPat {}) = False go (NPlusKPat {}) = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/372ad22d9f9cc27bfa6880f4754475ccc7a1d505 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/372ad22d9f9cc27bfa6880f4754475ccc7a1d505 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 21:42:40 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 05 May 2023 17:42:40 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - Discard default monad fail alternatives that are spuriously generated Message-ID: <6455785027356_e3e063430e8945036b8@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 4f8d5755 by Apoorv Ingle at 2023-05-05T16:42:27-05:00 - Discard default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 8 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - -- (ppr orig) - = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + (ppr orig) + -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -39,7 +39,7 @@ module GHC.Hs.Pat ( mkPrefixConPat, mkCharLitPat, mkNilPat, - isSimplePat, + isSimplePat, isPatSyn, looksLazyPatBind, isBangedLPat, gParPat, patNeedsParens, parenthesizePat, @@ -617,6 +617,10 @@ isSimplePat p = case unLoc p of VarPat _ x -> Just (unLoc x) _ -> Nothing +isPatSyn :: LPat GhcTc -> Bool +isPatSyn (L _ (ConPat {pat_con = L _ (PatSynCon{})})) = True +isPatSyn _ = False + {- Note [Unboxed sum patterns aren't irrefutable] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,31 +858,27 @@ warnDiscardedDoBindings rhs rhs_ty warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty - | Just (SrcSpanAnn _ l, (L (SrcSpanAnn _ loc) f)) <- fish_var fun - , is_gen_then f - -- , isNoSrcSpan l + | Just (l, f) <- fish_var fun + , f `hasKey` thenMClassOpKey -- it is a (>>) + , isGeneratedSrcSpan l -- it is compiler generated = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun - , text "arg" <+> ppr arg - , text "arg_ty" <+> ppr arg_ty - , text "f" <+> ppr f <+> ppr (is_gen_then f) - , text "l" <+> ppr (isNoSrcSpan l) <+> ppr (isNoSrcSpan loc) + , text "loc" <+> ppr l + , text "locGen?" <+> ppr (isGeneratedSrcSpan l) + , text "noLoc?" <+> ppr (isNoSrcSpan l) ]) warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application - fish_var :: LHsExpr GhcTc -> Maybe (SrcSpanAnnA , LIdP GhcTc) - fish_var (L l (HsVar _ id)) = return (l, id) - fish_var (L _ (PopSrcSpan e)) = pprPanic "warnUnusedBindValue" (ppr e) + -- It is important that we /do not/ look through HsApp to avoid + -- generating duplicate warnings + fish_var :: LHsExpr GhcTc -> Maybe (SrcSpan , Id) + fish_var (L l (HsVar _ id)) = return (locA l, unLoc id) fish_var (L _ (HsAppType _ e _ _)) = fish_var e fish_var (L l (XExpr (WrapExpr (HsWrap _ e)))) = do (l, e') <- fish_var (L l e) return (l, e') fish_var (L l (XExpr (ExpansionExpr (HsExpanded _ e)))) = fish_var (L l e) fish_var _ = Nothing - -- is this id a compiler generated (>>) with expanded do - is_gen_then :: Id -> Bool - is_gen_then f = f `hasKey` thenMClassOpKey - warnUnusedBindValue _ _ _ = return () ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -227,7 +227,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty match_groups [] = matchEmpty v ty match_groups (g:gs) = mapM match_group $ g :| gs - match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM (MatchResult CoreExpr) + match_group :: NonEmpty (PatGroup, EquationInfo) -> DsM (MatchResult CoreExpr) match_group eqns@((group,_) :| _) = case group of PgCon {} -> matchConFamily vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns']) @@ -767,12 +767,15 @@ one pattern, and match simply only accepts one pattern. JJQC 30-Nov-1997 -} -matchWrapper ctxt scrs (MG { mg_alts = L _ matches +matchWrapper ctxt scrs (MG { mg_alts = L _ matches' , mg_ext = MatchGroupTc arg_tys rhs_ty origin }) = do { dflags <- getDynFlags ; locn <- getSrcSpanDs - + ; let matches = if any (is_pat_syn_match origin) matches' + then filter (non_wc origin) matches' -- filter out the wild pattern fail alternatives that + -- generate spurious overlapping warnings + else matches' ; new_vars <- case matches of [] -> newSysLocalsDs arg_tys (m:_) -> @@ -827,7 +830,13 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches $ NEL.nonEmpty $ replicate (length (grhssGRHSs m)) initNablas - + is_pat_syn_match :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool + is_pat_syn_match Generated (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat + is_pat_syn_match _ _ = False + non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool + non_wc Generated (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc _ _ = True + matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -91,7 +91,7 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) +import GHC.Types.Basic ( Origin (..) ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -325,7 +325,9 @@ tcApp rn_expr exp_res_ty | (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr = do { traceTc "tcApp {" $ vcat [ text "rn_fun:" <+> ppr rn_fun - , text "rn_args:" <+> ppr rn_args ] + , text "rn_args:" <+> ppr rn_args + , text "fun_ctxt:" <+> ppr fun_ctxt <+> ppr (appCtxtLoc fun_ctxt) + ] ; (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1383,17 +1383,16 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc mk_failable_lexpr_tcm pat lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict - ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr pat + ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat , ppr $ isIrrefutableHsPatRn tc_env is_strict pat ]) ; if isIrrefutableHsPatRn tc_env is_strict pat - -- don't decorate with fail statement if the pattern is irrefutable - -- pattern syns always get a fail block while desugaring so skip + -- don't decorate with fail statement if + -- 1) the pattern is irrefutable then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } - where -- makes the fail block -- TODO: check the discussion around MonadFail.fail type signature. ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1623,9 +1623,9 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs - +-- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on the isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool -isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = goL pat +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict = goL where goL :: LPat GhcRn -> Bool goL = go . unLoc @@ -1649,11 +1649,22 @@ isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = go (ConPat { pat_con = L _ dcName - , pat_args = details }) = case lookupTypeEnv type_env dcName of - Just (ATyCon con) -> - isJust (tyConSingleDataCon_maybe con) - && all goL (hsConPatArgs details) - _ -> False -- conservative. + , pat_args = details }) = + case lookupTypeEnv type_env dcName of + Just (ATyCon tycon) -> + (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon) + && all goL (hsConPatArgs details) + Just id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + Just (AConLike cl) -> case cl of + RealDataCon dc -> let tycon = dataConTyCon dc in + (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon) + && all goL (hsConPatArgs details) + PatSynCon _ -> False -- conservative + + Just ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + _ -> False -- conservative. go (LitPat {}) = False go (NPat {}) = False go (NPlusKPat {}) = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f8d57550995e70a60bf7d7972cd4a65190dbdec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f8d57550995e70a60bf7d7972cd4a65190dbdec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 21:44:49 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 05 May 2023 17:44:49 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - Discard default monad fail alternatives that are spuriously generated Message-ID: <645578d170a58_e3e0635685238504281@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 6f3e0a3c by Apoorv Ingle at 2023-05-05T16:44:39-05:00 - Discard default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 8 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - -- (ppr orig) - = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + (ppr orig) + -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -39,7 +39,7 @@ module GHC.Hs.Pat ( mkPrefixConPat, mkCharLitPat, mkNilPat, - isSimplePat, + isSimplePat, isPatSyn, looksLazyPatBind, isBangedLPat, gParPat, patNeedsParens, parenthesizePat, @@ -617,6 +617,10 @@ isSimplePat p = case unLoc p of VarPat _ x -> Just (unLoc x) _ -> Nothing +isPatSyn :: LPat GhcTc -> Bool +isPatSyn (L _ (ConPat {pat_con = L _ (PatSynCon{})})) = True +isPatSyn _ = False + {- Note [Unboxed sum patterns aren't irrefutable] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,31 +858,27 @@ warnDiscardedDoBindings rhs rhs_ty warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty - | Just (SrcSpanAnn _ l, (L (SrcSpanAnn _ loc) f)) <- fish_var fun - , is_gen_then f - -- , isNoSrcSpan l + | Just (l, f) <- fish_var fun + , f `hasKey` thenMClassOpKey -- it is a (>>) + , isGeneratedSrcSpan l -- it is compiler generated = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun - , text "arg" <+> ppr arg - , text "arg_ty" <+> ppr arg_ty - , text "f" <+> ppr f <+> ppr (is_gen_then f) - , text "l" <+> ppr (isNoSrcSpan l) <+> ppr (isNoSrcSpan loc) + , text "loc" <+> ppr l + , text "locGen?" <+> ppr (isGeneratedSrcSpan l) + , text "noLoc?" <+> ppr (isNoSrcSpan l) ]) warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application - fish_var :: LHsExpr GhcTc -> Maybe (SrcSpanAnnA , LIdP GhcTc) - fish_var (L l (HsVar _ id)) = return (l, id) - fish_var (L _ (PopSrcSpan e)) = pprPanic "warnUnusedBindValue" (ppr e) + -- It is important that we /do not/ look through HsApp to avoid + -- generating duplicate warnings + fish_var :: LHsExpr GhcTc -> Maybe (SrcSpan , Id) + fish_var (L l (HsVar _ id)) = return (locA l, unLoc id) fish_var (L _ (HsAppType _ e _ _)) = fish_var e fish_var (L l (XExpr (WrapExpr (HsWrap _ e)))) = do (l, e') <- fish_var (L l e) return (l, e') fish_var (L l (XExpr (ExpansionExpr (HsExpanded _ e)))) = fish_var (L l e) fish_var _ = Nothing - -- is this id a compiler generated (>>) with expanded do - is_gen_then :: Id -> Bool - is_gen_then f = f `hasKey` thenMClassOpKey - warnUnusedBindValue _ _ _ = return () ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -227,7 +227,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty match_groups [] = matchEmpty v ty match_groups (g:gs) = mapM match_group $ g :| gs - match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM (MatchResult CoreExpr) + match_group :: NonEmpty (PatGroup, EquationInfo) -> DsM (MatchResult CoreExpr) match_group eqns@((group,_) :| _) = case group of PgCon {} -> matchConFamily vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns']) @@ -767,12 +767,15 @@ one pattern, and match simply only accepts one pattern. JJQC 30-Nov-1997 -} -matchWrapper ctxt scrs (MG { mg_alts = L _ matches +matchWrapper ctxt scrs (MG { mg_alts = L _ matches' , mg_ext = MatchGroupTc arg_tys rhs_ty origin }) = do { dflags <- getDynFlags ; locn <- getSrcSpanDs - + ; let matches = if any (is_pat_syn_match origin) matches' + then filter (non_wc origin) matches' -- filter out the wild pattern fail alternatives that + -- generate spurious overlapping warnings + else matches' ; new_vars <- case matches of [] -> newSysLocalsDs arg_tys (m:_) -> @@ -827,7 +830,13 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches $ NEL.nonEmpty $ replicate (length (grhssGRHSs m)) initNablas - + is_pat_syn_match :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool + is_pat_syn_match Generated (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat + is_pat_syn_match _ _ = False + non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool + non_wc Generated (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc _ _ = True + matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -91,7 +91,7 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) +import GHC.Types.Basic ( Origin (..) ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -325,7 +325,9 @@ tcApp rn_expr exp_res_ty | (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr = do { traceTc "tcApp {" $ vcat [ text "rn_fun:" <+> ppr rn_fun - , text "rn_args:" <+> ppr rn_args ] + , text "rn_args:" <+> ppr rn_args + , text "fun_ctxt:" <+> ppr fun_ctxt <+> ppr (appCtxtLoc fun_ctxt) + ] ; (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1383,17 +1383,16 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc mk_failable_lexpr_tcm pat lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict - ; traceTc "mk_fail_lexpr_tcm" (vcat [ppr pat + ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat , ppr $ isIrrefutableHsPatRn tc_env is_strict pat ]) ; if isIrrefutableHsPatRn tc_env is_strict pat - -- don't decorate with fail statement if the pattern is irrefutable - -- pattern syns always get a fail block while desugaring so skip + -- don't decorate with fail statement if + -- 1) the pattern is irrefutable then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } - where -- makes the fail block -- TODO: check the discussion around MonadFail.fail type signature. ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1623,9 +1623,9 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs - +-- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on the isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool -isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = goL pat +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict = goL where goL :: LPat GhcRn -> Bool goL = go . unLoc @@ -1649,11 +1649,22 @@ isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = go (ConPat { pat_con = L _ dcName - , pat_args = details }) = case lookupTypeEnv type_env dcName of - Just (ATyCon con) -> - isJust (tyConSingleDataCon_maybe con) - && all goL (hsConPatArgs details) - _ -> False -- conservative. + , pat_args = details }) = + case lookupTypeEnv type_env dcName of + Just (ATyCon tycon) -> + (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon) + && all goL (hsConPatArgs details) + Just id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + Just (AConLike cl) -> case cl of + RealDataCon dc -> let tycon = dataConTyCon dc in + (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon) + && all goL (hsConPatArgs details) + PatSynCon _ -> False -- conservative + + Just ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + _ -> False -- conservative. go (LitPat {}) = False go (NPat {}) = False go (NPlusKPat {}) = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f3e0a3cf048015761819ab9bd0e848c90a7ecf8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f3e0a3cf048015761819ab9bd0e848c90a7ecf8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 22:42:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 18:42:53 -0400 Subject: [Git][ghc/ghc][master] 3 commits: driver: Use hooks from plugin_hsc_env Message-ID: <6455866d331a5_e3e0636322aa451094a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - 16 changed files: - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Runtime/Loader.hs - ghc/Main.hs - testsuite/tests/plugins/all.T - + testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs - testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs → testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs - + testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs - testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal - testsuite/tests/plugins/plugins04.stderr - testsuite/tests/plugins/test-hooks-plugin.hs - + testsuite/tests/plugins/test-log-hooks-plugin.hs - + testsuite/tests/plugins/test-log-hooks-plugin.stderr - + testsuite/tests/plugins/test-phase-hooks-plugin.hs - + testsuite/tests/plugins/test-phase-hooks-plugin.stderr Changes: ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -694,6 +694,10 @@ data WorkerLimit -- produced by calling 'depanal'. load' :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag load' mhmi_cache how_much mHscMessage mod_graph = do + -- In normal usage plugins are initialised already by ghc/Main.hs this is protective + -- 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 } guessOutputFile hsc_env <- getSession @@ -2852,13 +2856,11 @@ label_self thread_name = do runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () -runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do +runPipelines n_job hsc_env mHscMessager all_pipelines = do liftIO $ label_self "main --make thread" - - plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines - _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines hsc_env mHscMessager all_pipelines + _n -> runParPipelines n_job hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -244,12 +244,13 @@ compileOne' mHscMessage addFilesToClean tmpfs TFL_GhcSession $ [ml_obj_file $ ms_location summary] + -- Initialise plugins here for any plugins enabled locally for a module. plugin_hsc_env <- initializePlugins hsc_env let pipe_env = mkPipeEnv NoStop input_fn Nothing pipelineOutput status <- hscRecompStatus mHscMessage plugin_hsc_env upd_summary mb_old_iface mb_old_linkable (mod_index, nmods) let pipeline = hscPipeline pipe_env (setDumpPrefix pipe_env plugin_hsc_env, upd_summary, status) - (iface, linkable) <- runPipeline (hsc_hooks hsc_env) pipeline + (iface, linkable) <- runPipeline (hsc_hooks plugin_hsc_env) pipeline -- See Note [ModDetails and --make mode] details <- initModDetails plugin_hsc_env iface linkable' <- traverse (initWholeCoreBindings plugin_hsc_env iface details) (homeMod_bytecode linkable) @@ -526,7 +527,12 @@ findHSLib platform ws dirs lib = do -- Compile files in one-shot mode. oneShot :: HscEnv -> StopPhase -> [(String, Maybe Phase)] -> IO () -oneShot hsc_env stop_phase srcs = do +oneShot orig_hsc_env stop_phase srcs = do + -- In oneshot mode, initialise plugins specified on command line + -- we also initialise in ghc/Main but this might be used as an entry point by API clients who + -- should initialise their own plugins but may not. + -- See Note [Timing of plugin initialization] + hsc_env <- initializePlugins orig_hsc_env o_files <- mapMaybeM (compileFile hsc_env stop_phase) srcs case stop_phase of StopPreprocess -> return () ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -62,7 +62,6 @@ import GHC.Parser.Header import GHC.Data.StringBuffer import GHC.Types.SourceError import GHC.Unit.Finder -import GHC.Runtime.Loader import Data.IORef import GHC.Types.Name.Env import GHC.Platform.Ways @@ -82,6 +81,7 @@ import GHC.StgToJS.Linker.Linker (embedJsFile) import Language.Haskell.Syntax.Module.Name import GHC.Unit.Home.ModInfo +import GHC.Runtime.Loader (initializePlugins) newtype HookedUse a = HookedUse { runHookedUse :: (Hooks, PhaseHook) -> IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via (ReaderT (Hooks, PhaseHook) IO) @@ -724,9 +724,11 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do new_includes = addImplicitQuoteInclude paths [current_dir] paths = includePaths dflags0 dflags = dflags0 { includePaths = new_includes } - hsc_env = hscSetFlags dflags hsc_env0 - + hsc_env1 = hscSetFlags dflags hsc_env0 + -- Initialise plugins as the flags passed into runHscPhase might have local plugins just + -- specific to this module. + hsc_env <- initializePlugins hsc_env1 -- gather the imports and module name (hspp_buf,mod_name,imps,src_imps, ghc_prim_imp) <- do @@ -786,18 +788,17 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do -- run the compiler! let msg :: Messager msg hsc_env _ what _ = oneShotMsg (hsc_logger hsc_env) what - plugin_hsc_env' <- initializePlugins hsc_env -- Need to set the knot-tying mutable variable for interface -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var. -- See also Note [hsc_type_env_var hack] type_env_var <- newIORef emptyNameEnv - let plugin_hsc_env = plugin_hsc_env' { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) } + let hsc_env' = hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) } - status <- hscRecompStatus (Just msg) plugin_hsc_env mod_summary + status <- hscRecompStatus (Just msg) hsc_env' mod_summary Nothing emptyHomeModInfoLinkable (1, 1) - return (plugin_hsc_env, mod_summary, status) + return (hsc_env', mod_summary, status) -- | Calculate the ModLocation from the provided DynFlags. This function is only used -- in one-shot mode and therefore takes into account the effect of -o/-ohi flags ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -2,7 +2,7 @@ -- | Dynamically lookup up values from modules and loading them. module GHC.Runtime.Loader ( - initializePlugins, + initializePlugins, initializeSessionPlugins, -- * Loading plugins loadFrontendPlugin, @@ -74,7 +74,34 @@ import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types import Data.List (unzip4) import GHC.Iface.Errors.Ppr +import GHC.Driver.Monad +{- Note [Timing of plugin initialization] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Plugins needs to be initialised as soon as possible in the pipeline. This is because +driver plugins are executed immediately after being loaded, which can modify anything +in the HscEnv, including the logger and DynFlags (for example #21279). For example, +in ghc/Main.hs the logger is used almost immediately after the session has been initialised +and so if a user overwrites the logger expecting all output to go there then unless +the plugins are initialised before that point then unexpected things will happen. + +We initialise plugins in ghc/Main.hs for the main ghc executable. + +When people are using the GHC API, they also need to initialise plugins +at the highest level possible for things to work as expected. We keep +some defensive calls to plugin initialisation in functions like `load'` and `oneshot` +to catch cases where API users have not initialised their own plugins. + +In addition to this, there needs to be an initialisation call for each module +just in case the user has enabled a plugin just for that module using OPTIONS_GHC +pragma. + +-} + +-- | Initialise plugins specified by the current DynFlags and update the session. +initializeSessionPlugins :: GhcMonad m => m () +initializeSessionPlugins = getSession >>= liftIO . initializePlugins >>= setSession -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before ===================================== ghc/Main.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Platform.Host import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) #endif -import GHC.Runtime.Loader ( loadFrontendPlugin ) +import GHC.Runtime.Loader ( loadFrontendPlugin, initializeSessionPlugins ) import GHC.Unit.Env import GHC.Unit (UnitId, homeUnitDepends) @@ -257,16 +257,23 @@ main' postLoadMode units dflags0 args flagWarnings = do -- we've finished manipulating the DynFlags, update the session _ <- GHC.setSessionDynFlags dflags5 dflags6 <- GHC.getSessionDynFlags - hsc_env <- GHC.getSession + + -- Must do this before loading plugins + liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6) + + -- Initialise plugins here because the plugin author might already expect this + -- subsequent call to `getLogger` to be affected by a plugin. + initializeSessionPlugins + hsc_env <- getSession logger <- getLogger + ---------------- Display configuration ----------- case verbosity dflags6 of v | v == 4 -> liftIO $ dumpUnitsSimple hsc_env | v >= 5 -> liftIO $ dumpUnits hsc_env | otherwise -> return () - liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6) ---------------- Final sanity checking ----------- liftIO $ checkOptions postLoadMode dflags6 srcs objs units ===================================== testsuite/tests/plugins/all.T ===================================== @@ -317,3 +317,17 @@ test('plugins-external', pre_cmd('$MAKE -s --no-print-directory -C shared-plugin package.plugins01 TOP={top}'), when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], makefile_test, []) + +test('test-phase-hooks-plugin', + [extra_files(['hooks-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-phase-hooks-plugin TOP={top}'), + + when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + compile, + ['-package-db hooks-plugin/pkg.test-phase-hooks-plugin/local.package.conf -fplugin Hooks.PhasePlugin -package hooks-plugin ' + config.plugin_way_flags]) + +test('test-log-hooks-plugin', + [extra_files(['hooks-plugin/']), + pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-log-hooks-plugin TOP={top}')], + compile_fail, + ['-package-db hooks-plugin/pkg.test-log-hooks-plugin/local.package.conf -fplugin Hooks.LogPlugin -package hooks-plugin ' + config.plugin_way_flags]) ===================================== testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs ===================================== @@ -0,0 +1,24 @@ +module Hooks.LogPlugin (plugin) where + +import GHC.Plugins +import GHC.Driver.Hooks +import GHC.Tc.Utils.Monad +import GHC.Utils.Logger +import GHC.Driver.Pipeline.Execute +import System.IO + +plugin :: Plugin +plugin = defaultPlugin { driverPlugin = hooksP } + +hooksP :: [CommandLineOption] -> HscEnv -> IO HscEnv +hooksP opts hsc_env = do + hSetBuffering stdout NoBuffering + let logger = hsc_logger hsc_env + logger' = pushLogHook logHook logger + hsc_env' = hsc_env { hsc_logger = logger' } + return hsc_env' + +logHook :: LogAction -> LogAction +logHook action logFlags messageClass srcSpan msgDoc = do + putStrLn "Log hook called" + action logFlags messageClass srcSpan msgDoc ===================================== testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs → testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs ===================================== @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall #-} -module Hooks.Plugin (plugin) where +module Hooks.MetaPlugin (plugin) where import GHC.Types.SourceText import GHC.Plugins ===================================== testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs ===================================== @@ -0,0 +1,30 @@ +{-# LANGUAGE GADTs #-} +{-# OPTIONS_GHC -Wall #-} +module Hooks.PhasePlugin (plugin) where + +import GHC.Plugins +import GHC.Driver.Hooks +import GHC.Tc.Utils.Monad +import GHC.Driver.Pipeline.Execute +import GHC.Driver.Pipeline.Phases +import System.IO + +plugin :: Plugin +plugin = defaultPlugin { driverPlugin = hooksP } + +hooksP :: [CommandLineOption] -> HscEnv -> IO HscEnv +hooksP opts hsc_env = do + hSetBuffering stdout NoBuffering + let hooks = hsc_hooks hsc_env + hooks' = hooks { runPhaseHook = Just fakeRunPhaseHook } + hsc_env' = hsc_env { hsc_hooks = hooks' } + return hsc_env' + +fakeRunPhaseHook :: PhaseHook +fakeRunPhaseHook = PhaseHook $ \tPhase -> do + liftIO $ case tPhase of + T_Cpp{} -> putStrLn "Cpp hook fired" + T_Hsc{} -> putStrLn "Hsc hook fired" + T_FileArgs{} -> putStrLn "FileArgs hook fired" + _ -> pure () + runPhase tPhase ===================================== testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal ===================================== @@ -4,6 +4,6 @@ version: 0.1 build-type: Simple library - exposed-modules: Hooks.Plugin + exposed-modules: Hooks.MetaPlugin, Hooks.PhasePlugin, Hooks.LogPlugin build-depends: base, ghc default-language: Haskell2010 ===================================== testsuite/tests/plugins/plugins04.stderr ===================================== @@ -1,2 +1 @@ -Module graph contains a cycle: - module ‘HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself +attempting to use module ‘main:HomePackagePlugin’ (./HomePackagePlugin.hs) which is not loaded ===================================== testsuite/tests/plugins/test-hooks-plugin.hs ===================================== @@ -1,4 +1,4 @@ -{-# OPTIONS -fplugin=Hooks.Plugin #-} +{-# OPTIONS -fplugin=Hooks.MetaPlugin #-} {-# LANGUAGE TemplateHaskell #-} module Main where ===================================== testsuite/tests/plugins/test-log-hooks-plugin.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = pure "type error" ===================================== testsuite/tests/plugins/test-log-hooks-plugin.stderr ===================================== @@ -0,0 +1,9 @@ +Log hook called + +test-log-hooks-plugin.hs:4:13: error: [GHC-83865] + • Couldn't match type ‘[Char]’ with ‘()’ + Expected: () + Actual: String + • In the first argument of ‘pure’, namely ‘"type error"’ + In the expression: pure "type error" + In an equation for ‘main’: main = pure "type error" ===================================== testsuite/tests/plugins/test-phase-hooks-plugin.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE CPP #-} +module Main where + +main :: IO () +main = pure () ===================================== testsuite/tests/plugins/test-phase-hooks-plugin.stderr ===================================== @@ -0,0 +1,5 @@ +FileArgs hook fired +Cpp hook fired +FileArgs hook fired +FileArgs hook fired +Hsc hook fired View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/983ce55815f2dd57f84ee86eee97febf7d80b470...6e776ed33dfbdd288064001039235de6d2174d8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/983ce55815f2dd57f84ee86eee97febf7d80b470...6e776ed33dfbdd288064001039235de6d2174d8a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 22:43:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 18:43:21 -0400 Subject: [Git][ghc/ghc][master] Incrementally update ghcup metadata in ghc/ghcup-metadata Message-ID: <64558689d7bab_e3e0635685238514590@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -999,7 +999,7 @@ project-version: - . ./version.sh # Download existing ghcup metadata - - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://raw.githubusercontent.com/haskell/ghcup-metadata/develop/ghcup-0.0.7.yaml" + - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://gitlab.haskell.org/ghc/ghcup-metadata/-/raw/updates/ghcup-0.0.7.yaml" - .gitlab/generate_job_metadata @@ -1048,6 +1048,37 @@ ghcup-metadata-nightly: rules: - if: $NIGHTLY +# Update the +ghcup-metadata-nightly-push: + stage: deploy + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + dependencies: null + tags: + - x86_64-linux + variables: + BUILD_FLAVOUR: default + GIT_SUBMODULE_STRATEGY: "none" + needs: + - job: ghcup-metadata-nightly + artifacts: true + script: + - git clone https://gitlab.haskell.org/ghc/ghcup-metadata.git + - cp metadata_test.yaml ghcup-metadata/ghcup-0.0.7.yaml + - cd ghcup-metadata + - git config user.email "ghc-ci at gitlab-haskell.org" + - git config user.name "GHC GitLab CI" + - git remote add gitlab_origin https://oauth2:$PROJECT_PUSH_TOKEN at gitlab.haskell.org/ghc/ghcup-metadata.git + - git add . + - git commit -m "Update metadata" + - git push gitlab_origin HEAD:updates -o ci.skip + rules: + - if: $NIGHTLY + # Only run the update on scheduled nightly pipelines, ie once a day + - if: $CI_PIPELINE_SOURCE == "schedule" + # And only update the metadata for master branch + - if: '$CI_COMMIT_BRANCH == "master"' + + ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1df8511e45e9071aa5e488ac21c4ccd24d91837 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1df8511e45e9071aa5e488ac21c4ccd24d91837 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 5 23:14:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 19:14:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: driver: Use hooks from plugin_hsc_env Message-ID: <64558dd79cf_e3e0637d5a50c519791@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 6d4236c6 by Rodrigo Mesquita at 2023-05-05T19:14:14-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - d21dfdfa by Torsten Schmits at 2023-05-05T19:14:26-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/exts/ffi.rst - docs/users_guide/using-warnings.rst - ghc/Main.hs - testsuite/tests/mdo/should_compile/mdo002.hs - testsuite/tests/plugins/all.T - + testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs - testsuite/tests/plugins/hooks-plugin/Hooks/Plugin.hs → testsuite/tests/plugins/hooks-plugin/Hooks/MetaPlugin.hs - + testsuite/tests/plugins/hooks-plugin/Hooks/PhasePlugin.hs - testsuite/tests/plugins/hooks-plugin/hooks-plugin.cabal - testsuite/tests/plugins/plugins04.stderr - testsuite/tests/plugins/test-hooks-plugin.hs - + testsuite/tests/plugins/test-log-hooks-plugin.hs - + testsuite/tests/plugins/test-log-hooks-plugin.stderr - + testsuite/tests/plugins/test-phase-hooks-plugin.hs - + testsuite/tests/plugins/test-phase-hooks-plugin.stderr - testsuite/tests/polykinds/MonoidsFD.hs - testsuite/tests/polykinds/MonoidsTF.hs - testsuite/tests/profiling/should_run/T3001-2.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad0109608cbabb6702e36fd85013ddc9d77020e8...d21dfdfa320d24999a8c23c20a9e6a47cc36d385 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad0109608cbabb6702e36fd85013ddc9d77020e8...d21dfdfa320d24999a8c23c20a9e6a47cc36d385 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 01:21:51 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 05 May 2023 21:21:51 -0400 Subject: [Git][ghc/ghc][wip/expand-do] experimenting with irrefutable patterns Message-ID: <6455abafa1eb0_e3e0639f844985330bb@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: a0785856 by Apoorv Ingle at 2023-05-05T20:21:39-05:00 experimenting with irrefutable patterns - - - - - 2 changed files: - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1383,11 +1383,12 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc mk_failable_lexpr_tcm pat lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict + ; b <- isIrrefutableHsPatRn tc_env is_strict pat ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat - , ppr $ isIrrefutableHsPatRn tc_env is_strict pat + , text "isIrrefutable:" <+> ppr b ]) - ; if isIrrefutableHsPatRn tc_env is_strict pat + ; if b -- don't decorate with fail statement if -- 1) the pattern is irrefutable then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1623,55 +1623,77 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs --- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on the -isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool -isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict = goL +-- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on type checking +isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> TcM Bool +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = + do traceTc "isIrrefutableHsPatRn" empty + goL pat where - goL :: LPat GhcRn -> Bool + goL :: LPat GhcRn -> TcM Bool goL = go . unLoc - go :: Pat GhcRn -> Bool - go (WildPat {}) = True - go (VarPat {}) = True + go :: Pat GhcRn -> TcM Bool + go (WildPat {}) = return True + go (VarPat {}) = return True go (LazyPat _ p') | is_strict = isIrrefutableHsPatRn tc_env False p' - | otherwise = True + | otherwise = return True go (BangPat _ pat) = goL pat go (ParPat _ _ pat _) = goL pat go (AsPat _ _ _ pat) = goL pat go (ViewPat _ _ pat) = goL pat go (SigPat _ pat _) = goL pat - go (TuplePat _ pats _) = all goL pats - go (SumPat {}) = False + go (TuplePat _ pats _) = + do traceTc "isIrrefutableHsPatRn TuplePat" empty + foldM (\a p -> do {b <- goL p; return (a && b)}) True pats + + go (SumPat {}) = return False -- See Note [Unboxed sum patterns aren't irrefutable] - go (ListPat {}) = False + go (ListPat {}) = return False go (ConPat { pat_con = L _ dcName , pat_args = details }) = case lookupTypeEnv type_env dcName of - Just (ATyCon tycon) -> - (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon) - && all goL (hsConPatArgs details) + Just (ATyCon tycon) -> do + b <- foldM (\a p -> do {b <- goL p; return (a && b)}) True (hsConPatArgs details) + traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon + , ppr (isNewTyCon tycon) + , ppr (tcHasFixedRuntimeRep tycon)]) + let b' = (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon + || tcHasFixedRuntimeRep tycon) + return (b && b') Just id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) - Just (AConLike cl) -> case cl of - RealDataCon dc -> let tycon = dataConTyCon dc in - (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon) - && all goL (hsConPatArgs details) - PatSynCon _ -> False -- conservative + Just (AConLike cl) -> + case cl of + RealDataCon dc -> + do let tycon = dataConTyCon dc + b <- foldM (\a p -> do {b <- goL p; return (a && b)}) + True (hsConPatArgs details) + traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon + , ppr (isNewTyCon tycon) + , ppr (tcHasFixedRuntimeRep tycon)] ) + let b' = (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon + || tcHasFixedRuntimeRep tycon) + return (b && b') + PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) + return False -- conservative Just ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) - _ -> False -- conservative. - go (LitPat {}) = False - go (NPat {}) = False - go (NPlusKPat {}) = False + Nothing -> do traceTc "isIrrefutableHsPatRn no tycon" empty + return True -- this may not be the right thing to do + go (LitPat {}) = do traceTc "isIrrefutableHsPatRn LitPat" empty + return False + go (NPat {}) = return False + go (NPlusKPat {}) = return False -- We conservatively assume that no TH splices are irrefutable -- since we cannot know until the splice is evaluated. - go (SplicePat {}) = False + go (SplicePat {}) = return False go (XPat ext) = case ext of - HsPatExpanded _ pat -> go pat + HsPatExpanded _ pat -> do traceTc "isIrrefutableHsPatRn HsPatEx" empty + go pat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a07858562ef9733d0c7fd7cc64fc868d2e574c6a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a07858562ef9733d0c7fd7cc64fc868d2e574c6a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 01:51:55 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 05 May 2023 21:51:55 -0400 Subject: [Git][ghc/ghc][wip/expand-do] experimenting with irrefutable patterns Message-ID: <6455b2bb6ab67_e3e0637e7031053368b@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: ab8861a6 by Apoorv Ingle at 2023-05-05T20:51:44-05:00 experimenting with irrefutable patterns - - - - - 2 changed files: - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1383,11 +1383,12 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc mk_failable_lexpr_tcm pat lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict + ; b <- isIrrefutableHsPatRn tc_env is_strict pat ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat - , ppr $ isIrrefutableHsPatRn tc_env is_strict pat + , text "isIrrefutable:" <+> ppr b ]) - ; if isIrrefutableHsPatRn tc_env is_strict pat + ; if b -- don't decorate with fail statement if -- 1) the pattern is irrefutable then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1623,55 +1623,78 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs --- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on the -isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool -isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict = goL +-- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on type checking +isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> TcM Bool +isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict pat = + do traceTc "isIrrefutableHsPatRn" empty + goL pat where - goL :: LPat GhcRn -> Bool + goL :: LPat GhcRn -> TcM Bool goL = go . unLoc - go :: Pat GhcRn -> Bool - go (WildPat {}) = True - go (VarPat {}) = True + go :: Pat GhcRn -> TcM Bool + go (WildPat {}) = return True + go (VarPat {}) = return True go (LazyPat _ p') | is_strict = isIrrefutableHsPatRn tc_env False p' - | otherwise = True + | otherwise = return True go (BangPat _ pat) = goL pat go (ParPat _ _ pat _) = goL pat go (AsPat _ _ _ pat) = goL pat go (ViewPat _ _ pat) = goL pat go (SigPat _ pat _) = goL pat - go (TuplePat _ pats _) = all goL pats - go (SumPat {}) = False + go (TuplePat _ pats _) = + do traceTc "isIrrefutableHsPatRn TuplePat" empty + foldM (\a p -> do {b <- goL p; return (a && b)}) True pats + + go (SumPat {}) = return False -- See Note [Unboxed sum patterns aren't irrefutable] - go (ListPat {}) = False + go (ListPat {}) = return False go (ConPat { pat_con = L _ dcName , pat_args = details }) = - case lookupTypeEnv type_env dcName of - Just (ATyCon tycon) -> - (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon) - && all goL (hsConPatArgs details) - Just id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) - Just (AConLike cl) -> case cl of - RealDataCon dc -> let tycon = dataConTyCon dc in - (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon) - && all goL (hsConPatArgs details) - PatSynCon _ -> False -- conservative - - Just ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) - _ -> False -- conservative. - go (LitPat {}) = False - go (NPat {}) = False - go (NPlusKPat {}) = False + do { tyth <- tcLookupGlobal dcName + ; traceTc "isIrrefutableHsPatRn dataCon" (ppr tyth) + ; case tyth of + (ATyCon tycon) -> + do { b <- foldM (\a p -> do {b <- goL p; return (a && b)}) True (hsConPatArgs details) + ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon + , ppr (isNewTyCon tycon) + , ppr (tcHasFixedRuntimeRep tycon)]) + ; let b' = (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon + || tcHasFixedRuntimeRep tycon) + ; return (b && b') } + id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + (AConLike cl) -> + case cl of + RealDataCon dc -> + do let tycon = dataConTyCon dc + b <- foldM (\a p -> do {b <- goL p; return (a && b)}) + True (hsConPatArgs details) + traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon + , ppr (isNewTyCon tycon) + , ppr (tcHasFixedRuntimeRep tycon)] ) + let b' = (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon + || tcHasFixedRuntimeRep tycon) + return (b && b') + PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) + return False -- conservative + + ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + } + go (LitPat {}) = do traceTc "isIrrefutableHsPatRn LitPat" empty + return False + go (NPat {}) = return False + go (NPlusKPat {}) = return False -- We conservatively assume that no TH splices are irrefutable -- since we cannot know until the splice is evaluated. - go (SplicePat {}) = False + go (SplicePat {}) = return False go (XPat ext) = case ext of - HsPatExpanded _ pat -> go pat + HsPatExpanded _ pat -> do traceTc "isIrrefutableHsPatRn HsPatEx" empty + go pat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab8861a684d86355df6be6837a52f0beca19501f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab8861a684d86355df6be6837a52f0beca19501f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 02:01:54 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 05 May 2023 22:01:54 -0400 Subject: [Git][ghc/ghc][wip/expand-do] experimenting with irrefutable patterns Message-ID: <6455b5127f40c_e3e0637e7031053445b@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 4e9c64e6 by Apoorv Ingle at 2023-05-05T21:01:42-05:00 experimenting with irrefutable patterns - - - - - 3 changed files: - compiler/GHC/HsToCore/Match.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -836,7 +836,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool non_wc Generated (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False non_wc _ _ = True - + matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1383,11 +1383,12 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc mk_failable_lexpr_tcm pat lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict + ; b <- isIrrefutableHsPatRn tc_env is_strict pat ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat - , ppr $ isIrrefutableHsPatRn tc_env is_strict pat + , text "isIrrefutable:" <+> ppr b ]) - ; if isIrrefutableHsPatRn tc_env is_strict pat + ; if b -- don't decorate with fail statement if -- 1) the pattern is irrefutable then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Types.Id import GHC.Types.Var import GHC.Types.Name import GHC.Types.Name.Reader -import GHC.Types.TypeEnv (lookupTypeEnv) import GHC.Core.Multiplicity import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic ) import GHC.Tc.Utils.Env @@ -1623,55 +1622,78 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs --- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on the -isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> Bool -isIrrefutableHsPatRn tc_env@(TcGblEnv{tcg_type_env = type_env}) is_strict = goL +-- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on type checking +isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> TcM Bool +isIrrefutableHsPatRn _ is_strict pat = + do traceTc "isIrrefutableHsPatRn" empty + goL pat where - goL :: LPat GhcRn -> Bool + goL :: LPat GhcRn -> TcM Bool goL = go . unLoc - go :: Pat GhcRn -> Bool - go (WildPat {}) = True - go (VarPat {}) = True + go :: Pat GhcRn -> TcM Bool + go (WildPat {}) = return True + go (VarPat {}) = return True go (LazyPat _ p') | is_strict = isIrrefutableHsPatRn tc_env False p' - | otherwise = True + | otherwise = return True go (BangPat _ pat) = goL pat go (ParPat _ _ pat _) = goL pat go (AsPat _ _ _ pat) = goL pat go (ViewPat _ _ pat) = goL pat go (SigPat _ pat _) = goL pat - go (TuplePat _ pats _) = all goL pats - go (SumPat {}) = False + go (TuplePat _ pats _) = + do traceTc "isIrrefutableHsPatRn TuplePat" empty + foldM (\a p -> do {b <- goL p; return (a && b)}) True pats + + go (SumPat {}) = return False -- See Note [Unboxed sum patterns aren't irrefutable] - go (ListPat {}) = False + go (ListPat {}) = return False go (ConPat { pat_con = L _ dcName , pat_args = details }) = - case lookupTypeEnv type_env dcName of - Just (ATyCon tycon) -> - (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon) - && all goL (hsConPatArgs details) - Just id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) - Just (AConLike cl) -> case cl of - RealDataCon dc -> let tycon = dataConTyCon dc in - (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon) - && all goL (hsConPatArgs details) - PatSynCon _ -> False -- conservative - - Just ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) - _ -> False -- conservative. - go (LitPat {}) = False - go (NPat {}) = False - go (NPlusKPat {}) = False + do { tyth <- tcLookupGlobal dcName + ; traceTc "isIrrefutableHsPatRn dataCon" (ppr tyth) + ; case tyth of + (ATyCon tycon) -> + do { b <- foldM (\a p -> do {b <- goL p; return (a && b)}) True (hsConPatArgs details) + ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon + , ppr (isNewTyCon tycon) + , ppr (tcHasFixedRuntimeRep tycon)]) + ; let b' = (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon + || tcHasFixedRuntimeRep tycon) + ; return (b && b') } + id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + (AConLike cl) -> + case cl of + RealDataCon dc -> + do let tycon = dataConTyCon dc + b <- foldM (\a p -> do {b <- goL p; return (a && b)}) + True (hsConPatArgs details) + traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon + , ppr (isNewTyCon tycon) + , ppr (tcHasFixedRuntimeRep tycon)] ) + let b' = (isJust (tyConSingleDataCon_maybe tycon) + || isNewTyCon tycon + || tcHasFixedRuntimeRep tycon) + return (b && b') + PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) + return False -- conservative + + ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + } + go (LitPat {}) = do traceTc "isIrrefutableHsPatRn LitPat" empty + return False + go (NPat {}) = return False + go (NPlusKPat {}) = return False -- We conservatively assume that no TH splices are irrefutable -- since we cannot know until the splice is evaluated. - go (SplicePat {}) = False + go (SplicePat {}) = return False go (XPat ext) = case ext of - HsPatExpanded _ pat -> go pat + HsPatExpanded _ pat -> do traceTc "isIrrefutableHsPatRn HsPatEx" empty + go pat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e9c64e654f6542aff51606a13ca866f58410755 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e9c64e654f6542aff51606a13ca866f58410755 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 02:04:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 22:04:47 -0400 Subject: [Git][ghc/ghc][master] docs: Remove mentions of ArrayArray# from unlifted FFI section Message-ID: <6455b5bfa4592_e3e06376f7188538954@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 1 changed file: - docs/users_guide/exts/ffi.rst Changes: ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -126,7 +126,7 @@ types may be used as arguments to FFI calls, subject to these restrictions: * Valid arguments for ``foreign import unsafe`` FFI calls: ``Array#``, - ``SmallArray#``, ``ArrayArray#``, ``ByteArray#``, and the mutable + ``SmallArray#``, ``ByteArray#``, and the mutable counterparts of these types. * Valid arguments for ``foreign import safe`` FFI calls: ``ByteArray#`` and ``MutableByteArray#``. The byte array must be @@ -174,10 +174,6 @@ are: +--------------------------------+-----------+-------------+-----------+---------------+ | ``MutableSmallArray#`` | Unsound | Unsound | Sound | Unsound | +--------------------------------+-----------+-------------+-----------+---------------+ - | ``ArrayArray#`` | Unsound | Unsound | Sound | Unsound | - +--------------------------------+-----------+-------------+-----------+---------------+ - | ``MutableArrayArray#`` | Unsound | Unsound | Sound | Unsound | - +--------------------------------+-----------+-------------+-----------+---------------+ | unpinned ``ByteArray#`` | Unsound | Unsound | Sound | Unsound | +--------------------------------+-----------+-------------+-----------+---------------+ | unpinned ``MutableByteArray#`` | Unsound | Unsound | Sound | Sound | @@ -210,32 +206,32 @@ anything from ``Rts.h``:: In other situations, the C function may need knowledge of the RTS closure types. The following example sums the first element of each ``ByteArray#`` (interpreting the bytes as an array of ``CInt``) -element of an ``ArrayArray##`` [3]_:: +element of an ``Array# ByteArray#`` [3]_:: // C source, must include the RTS to make the struct StgArrBytes - // available along with its fields: ptrs and payload. + // available along with its fields, such as `payload`. #include "Rts.h" - int sum_first (StgArrBytes **bufs) { - StgArrBytes **bufs = (StgArrBytes**)bufsTmp; + int sum_first (StgArrBytes **bufs, StgWord sz) { int res = 0; - for(StgWord ix = 0;ix < arr->ptrs;ix++) { + for(StgWord ix = 0; ix < sz; ix++) { res = res + ((int*)(bufs[ix]->payload))[0]; } return res; } - -- Haskell source, all elements in the argument array must be - -- either ByteArray# or MutableByteArray#. This is not enforced - -- by the type system in this example since ArrayArray is untyped. + -- Haskell source foreign import ccall unsafe "sum_first" - sumFirst :: ArrayArray# -> IO CInt + sumFirst :: Array# ByteArray# -> CInt -> IO CInt + + sumFirst' :: Array# ByteArray# -> IO CInt + sumFirst' arr = sumFirst arr (sizeofArray# arr) -Although GHC allows the user to pass all unlifted boxed types to -foreign functions, some of them are not amenable to useful work. -Although ``Array#`` is unlifted, the elements in its payload are -lifted, and a foreign C function cannot safely force thunks. Consequently, -a foreign C function may not dereference any of the addresses that comprise -the payload of the ``Array#``. +Although GHC allows the user to pass all unlifted boxed types to foreign +functions, some of them are not amenable to useful work. Although ``Array#`` +is unlifted, the elements in its payload can be lifted, and a foreign C +function cannot safely force thunks. Consequently, a foreign C function may not +dereference any of the addresses that comprise the payload of ``Array# a`` if +``a`` has a lifted representation. .. _ffi-newtype-io: @@ -1136,4 +1132,5 @@ byte array can be pinned as a result of three possible causes: as reading bytes from a ``MutableByteArray#``. Users should prefer ``GHC.Exts.readWord8Array#`` for this. .. [3] As in [2]_, the FFI is not actually needed for this. ``GHC.Exts`` - includes primitives for reading from on ``ArrayArray#``. + includes primitives for reading from an ``Array# a``, such as + ``GHC.Exts.indexArray#``. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f303d27dfdbf4c33af00d1a7802c8398b4a74d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f303d27dfdbf4c33af00d1a7802c8398b4a74d2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 02:05:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 05 May 2023 22:05:31 -0400 Subject: [Git][ghc/ghc][master] Add structured error messages for GHC.Rename.Module Message-ID: <6455b5ebe9a40_e3e06392faefc54519@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 23 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/using-warnings.rst - testsuite/tests/mdo/should_compile/mdo002.hs - testsuite/tests/polykinds/MonoidsFD.hs - testsuite/tests/polykinds/MonoidsTF.hs - testsuite/tests/profiling/should_run/T3001-2.hs - testsuite/tests/profiling/should_run/ioprof.hs - testsuite/tests/rebindable/rebindable2.hs - testsuite/tests/rebindable/rebindable2.stdout - testsuite/tests/simplCore/T9646/StrictPrim.hs - testsuite/tests/simplCore/should_run/T17744A.hs - testsuite/tests/simplCore/should_run/T3591.hs - testsuite/tests/typecheck/should_run/T1735_Help/State.hs - testsuite/tests/typecheck/should_run/T4809_IdentityT.hs - testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs - testsuite/tests/wcompat-warnings/Template.hs - testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -929,6 +929,7 @@ minusWcompatOpts :: [WarningFlag] minusWcompatOpts = [ Opt_WarnSemigroup , Opt_WarnNonCanonicalMonoidInstances + , Opt_WarnNonCanonicalMonadInstances , Opt_WarnCompatUnqualifiedImports , Opt_WarnTypeEqualityOutOfScope ] ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -22,7 +22,6 @@ import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr ) import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls ) import GHC.Hs -import GHC.Types.Error import GHC.Types.FieldLabel import GHC.Types.Name.Reader import GHC.Rename.HsType @@ -452,11 +451,9 @@ checkCanonicalInstances :: Name -> LHsSigType GhcRn -> LHsBinds GhcRn -> RnM () checkCanonicalInstances cls poly_ty mbinds = do whenWOptM Opt_WarnNonCanonicalMonadInstances $ checkCanonicalMonadInstances - "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return" whenWOptM Opt_WarnNonCanonicalMonoidInstances $ checkCanonicalMonoidInstances - "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid" where -- Warn about unsound/non-canonical 'Applicative'/'Monad' instance @@ -472,19 +469,17 @@ checkCanonicalInstances cls poly_ty mbinds = do -- * Warn if 'pure' is defined backwards (i.e. @pure = return@). -- * Warn if '(*>)' is defined backwards (i.e. @(*>) = (>>)@). -- - checkCanonicalMonadInstances refURL + checkCanonicalMonadInstances | cls == applicativeClassName = forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpanA loc $ case mbind of FunBind { fun_id = L _ name , fun_matches = mg } | name == pureAName, isAliasMG mg == Just returnMName - -> addWarnNonCanonicalMethod1 refURL - Opt_WarnNonCanonicalMonadInstances "pure" "return" + -> addWarnNonCanonicalMonad NonCanonical_Pure | name == thenAName, isAliasMG mg == Just thenMName - -> addWarnNonCanonicalMethod1 refURL - Opt_WarnNonCanonicalMonadInstances "(*>)" "(>>)" + -> addWarnNonCanonicalMonad NonCanonical_ThenA _ -> return () @@ -494,12 +489,10 @@ checkCanonicalInstances cls poly_ty mbinds = do FunBind { fun_id = L _ name , fun_matches = mg } | name == returnMName, isAliasMG mg /= Just pureAName - -> addWarnNonCanonicalMethod2 refURL - Opt_WarnNonCanonicalMonadInstances "return" "pure" + -> addWarnNonCanonicalMonad NonCanonical_Return | name == thenMName, isAliasMG mg /= Just thenAName - -> addWarnNonCanonicalMethod2 refURL - Opt_WarnNonCanonicalMonadInstances "(>>)" "(*>)" + -> addWarnNonCanonicalMonad NonCanonical_ThenM _ -> return () @@ -518,15 +511,14 @@ checkCanonicalInstances cls poly_ty mbinds = do -- -- * Warn if '(<>)' is defined backwards (i.e. @(<>) = mappend@). -- - checkCanonicalMonoidInstances refURL + checkCanonicalMonoidInstances | cls == semigroupClassName = forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpanA loc $ case mbind of FunBind { fun_id = L _ name , fun_matches = mg } | name == sappendName, isAliasMG mg == Just mappendName - -> addWarnNonCanonicalMethod1 refURL - Opt_WarnNonCanonicalMonoidInstances "(<>)" "mappend" + -> addWarnNonCanonicalMonoid NonCanonical_Sappend _ -> return () @@ -536,9 +528,7 @@ checkCanonicalInstances cls poly_ty mbinds = do FunBind { fun_id = L _ name , fun_matches = mg } | name == mappendName, isAliasMG mg /= Just sappendName - -> addWarnNonCanonicalMethod2 refURL - Opt_WarnNonCanonicalMonoidInstances - "mappend" "(<>)" + -> addWarnNonCanonicalMonoid NonCanonical_Mappend _ -> return () @@ -554,51 +544,14 @@ checkCanonicalInstances cls poly_ty mbinds = do , HsVar _ lrhsName <- unLoc body = Just (unLoc lrhsName) isAliasMG _ = Nothing - -- got "lhs = rhs" but expected something different - addWarnNonCanonicalMethod1 refURL flag lhs rhs = do - let dia = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag flag) noHints $ - vcat [ text "Noncanonical" <+> - quotes (text (lhs ++ " = " ++ rhs)) <+> - text "definition detected" - , instDeclCtxt1 poly_ty - , text "Move definition from" <+> - quotes (text rhs) <+> - text "to" <+> quotes (text lhs) - , text "See also:" <+> - text refURL - ] - addDiagnostic dia - - -- expected "lhs = rhs" but got something else - addWarnNonCanonicalMethod2 refURL flag lhs rhs = do - let dia = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag flag) noHints $ - vcat [ text "Noncanonical" <+> - quotes (text lhs) <+> - text "definition detected" - , instDeclCtxt1 poly_ty - , quotes (text lhs) <+> - text "will eventually be removed in favour of" <+> - quotes (text rhs) - , text "Either remove definition for" <+> - quotes (text lhs) <+> text "(recommended)" <+> - text "or define as" <+> - quotes (text (lhs ++ " = " ++ rhs)) - , text "See also:" <+> - text refURL - ] - addDiagnostic dia - - -- stolen from GHC.Tc.TyCl.Instance - instDeclCtxt1 :: LHsSigType GhcRn -> SDoc - instDeclCtxt1 hs_inst_ty - = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) - - inst_decl_ctxt :: SDoc -> SDoc - inst_decl_ctxt doc = hang (text "in the instance declaration for") - 2 (quotes doc <> text ".") + addWarnNonCanonicalMonoid reason = + addWarnNonCanonicalDefinition (NonCanonicalMonoid reason) + addWarnNonCanonicalMonad reason = + addWarnNonCanonicalDefinition (NonCanonicalMonad reason) + + addWarnNonCanonicalDefinition reason = + addDiagnostic (TcRnNonCanonicalDefinition reason poly_ty) rnClsInstDecl :: ClsInstDecl GhcPs -> RnM (ClsInstDecl GhcRn, FreeVars) rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1859,6 +1859,9 @@ instance Diagnostic TcRnMessage where locations = text "Bound at:" <+> vcat (map ppr (sortBy leftmost_smallest (NE.toList locs))) + TcRnNonCanonicalDefinition reason inst_ty + -> mkSimpleDecorated $ + pprNonCanonicalDefinition inst_ty reason diagnosticReason = \case TcRnUnknownMessage m @@ -2484,6 +2487,11 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnBindingNameConflict{} -> ErrorWithoutFlag + TcRnNonCanonicalDefinition (NonCanonicalMonoid _) _ + -> WarningWithFlag Opt_WarnNonCanonicalMonoidInstances + TcRnNonCanonicalDefinition (NonCanonicalMonad _) _ + -> WarningWithFlag Opt_WarnNonCanonicalMonadInstances + diagnosticHints = \case TcRnUnknownMessage m @@ -3145,6 +3153,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnBindingNameConflict{} -> noHints + TcRnNonCanonicalDefinition reason _ + -> suggestNonCanonicalDefinition reason diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode @@ -5451,3 +5461,78 @@ pprAmbiguousGreName gre | otherwise = pprPanic "addNameClassErrRn" (ppr gre) -- Invariant: either 'lcl' is True or 'iss' is non-empty + +pprNonCanonicalDefinition :: LHsSigType GhcRn + -> NonCanonicalDefinition + -> SDoc +pprNonCanonicalDefinition inst_ty = \case + NonCanonicalMonoid sub -> case sub of + NonCanonical_Sappend -> + msg1 "(<>)" "mappend" + NonCanonical_Mappend -> + msg2 "mappend" "(<>)" + NonCanonicalMonad sub -> case sub of + NonCanonical_Pure -> + msg1 "pure" "return" + NonCanonical_ThenA -> + msg1 "(*>)" "(>>)" + NonCanonical_Return -> + msg2 "return" "pure" + NonCanonical_ThenM -> + msg2 "(>>)" "(*>)" + where + msg1 :: String -> String -> SDoc + msg1 lhs rhs = + vcat [ text "Noncanonical" <+> + quotes (text (lhs ++ " = " ++ rhs)) <+> + text "definition detected" + , inst + ] + + msg2 :: String -> String -> SDoc + msg2 lhs rhs = + vcat [ text "Noncanonical" <+> + quotes (text lhs) <+> + text "definition detected" + , inst + , quotes (text lhs) <+> + text "will eventually be removed in favour of" <+> + quotes (text rhs) + ] + + inst = instDeclCtxt1 inst_ty + + -- stolen from GHC.Tc.TyCl.Instance + instDeclCtxt1 :: LHsSigType GhcRn -> SDoc + instDeclCtxt1 hs_inst_ty + = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) + + inst_decl_ctxt :: SDoc -> SDoc + inst_decl_ctxt doc = hang (text "in the instance declaration for") + 2 (quotes doc <> text ".") + +suggestNonCanonicalDefinition :: NonCanonicalDefinition -> [GhcHint] +suggestNonCanonicalDefinition reason = + [action doc] + where + action = case reason of + NonCanonicalMonoid sub -> case sub of + NonCanonical_Sappend -> move sappendName mappendName + NonCanonical_Mappend -> remove mappendName sappendName + NonCanonicalMonad sub -> case sub of + NonCanonical_Pure -> move pureAName returnMName + NonCanonical_ThenA -> move thenAName thenMName + NonCanonical_Return -> remove returnMName pureAName + NonCanonical_ThenM -> remove thenMName thenAName + + move = SuggestMoveNonCanonicalDefinition + remove = SuggestRemoveNonCanonicalDefinition + + doc = case reason of + NonCanonicalMonoid _ -> doc_monoid + NonCanonicalMonad _ -> doc_monad + + doc_monoid = + "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid" + doc_monad = + "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return" ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -116,6 +116,9 @@ module GHC.Tc.Errors.Types ( , UnusedImportName (..) , NestedForallsContextsIn(..) , UnusedNameProv(..) + , NonCanonicalDefinition(..) + , NonCanonical_Monoid(..) + , NonCanonical_Monad(..) ) where import GHC.Prelude @@ -4037,6 +4040,19 @@ data TcRnMessage where -- ^ The locations of the duplicates -> TcRnMessage + {-| TcRnNonCanonicalDefinition is a warning indicating that an instance + defines an implementation for a method that should not be defined in a way + that deviates from its default implementation, for example because it has + been scheduled to be absorbed into another method, like @pure@ making + @return@ obsolete. + + Test cases: + WCompatWarningsOn, WCompatWarningsOff, WCompatWarningsOnOff + -} + TcRnNonCanonicalDefinition :: !NonCanonicalDefinition -- ^ Specifics + -> !(LHsSigType GhcRn) -- ^ The instance type + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -5567,3 +5583,34 @@ data UnusedNameProv | UnusedNameTypePattern | UnusedNameMatch | UnusedNameLocalBind + +-- | Different reasons for TcRnNonCanonicalDefinition. +data NonCanonicalDefinition = + -- | Related to @(<>)@ and @mappend at . + NonCanonicalMonoid NonCanonical_Monoid + | + -- | Related to @(*>)@/@(>>)@ and @pure@/@return at . + NonCanonicalMonad NonCanonical_Monad + deriving (Generic) + +-- | Possible cases for the -Wnoncanonical-monoid-instances. +data NonCanonical_Monoid = + -- | @(<>) = mappend@ was defined. + NonCanonical_Sappend + | + -- | @mappend@ was defined as something other than @(<>)@. + NonCanonical_Mappend + +-- | Possible cases for the -Wnoncanonical-monad-instances. +data NonCanonical_Monad = + -- | @pure = return@ was defined. + NonCanonical_Pure + | + -- | @(*>) = (>>)@ was defined. + NonCanonical_ThenA + | + -- | @return@ was defined as something other than @pure at . + NonCanonical_Return + | + -- | @(>>)@ was defined as something other than @(*>)@. + NonCanonical_ThenM ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -598,6 +598,8 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnIllegalInferredTyVars" = 54832 GhcDiagnosticCode "TcRnAmbiguousName" = 87543 GhcDiagnosticCode "TcRnBindingNameConflict" = 10498 + GhcDiagnosticCode "NonCanonicalMonoid" = 50928 + GhcDiagnosticCode "NonCanonicalMonad" = 22705 -- PatSynInvalidRhsReason GhcDiagnosticCode "PatSynNotInvertible" = 69317 @@ -856,6 +858,7 @@ type family ConRecursInto con where ConRecursInto "DodgyImportsHiding" = 'Just ImportLookupReason ConRecursInto "TcRnImportLookup" = 'Just ImportLookupReason ConRecursInto "TcRnUnusedImport" = 'Just UnusedImportReason + ConRecursInto "TcRnNonCanonicalDefinition" = 'Just NonCanonicalDefinition -- -- TH errors ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -438,6 +438,21 @@ data GhcHint bind anything useful. -} | SuggestRemoveRecordWildcard + {-| Suggest moving a method implementation to a different instance to its + superclass that defines the canonical version of the method. + -} + | SuggestMoveNonCanonicalDefinition + Name -- ^ move the implementation from this method + Name -- ^ ... to this method + String -- ^ Documentation URL + + {-| Suggest removing a method implementation when a superclass defines the + canonical version of that method. + -} + | SuggestRemoveNonCanonicalDefinition + Name -- ^ method with non-canonical implementation + Name -- ^ possible other method to use as the RHS instead + String -- ^ Documentation URL -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -234,6 +234,17 @@ instance Outputable GhcHint where -> text "Enable Safe Haskell through either Safe, Trustworthy or Unsafe." SuggestRemoveRecordWildcard -> text "Omit the" <+> quotes (text "..") + SuggestMoveNonCanonicalDefinition lhs rhs refURL -> + text "Move definition from" <+> + quotes (pprPrefixUnqual rhs) <+> + text "to" <+> quotes (pprPrefixUnqual lhs) $$ + text "See also:" <+> text refURL + SuggestRemoveNonCanonicalDefinition lhs rhs refURL -> + text "Either remove definition for" <+> + quotes (pprPrefixUnqual lhs) <+> text "(recommended)" <+> + text "or define as" <+> + quotes (pprPrefixUnqual lhs <+> text "=" <+> pprPrefixUnqual rhs) $$ + text "See also:" <+> text refURL perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" @@ -343,3 +354,7 @@ pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope) pp_ns rdr | ns /= tried_ns = pprNameSpace ns | otherwise = empty where ns = rdrNameSpace rdr + +pprPrefixUnqual :: Name -> SDoc +pprPrefixUnqual name = + pprPrefixOcc (getOccName name) ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -163,6 +163,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wsemigroup` * :ghc-flag:`-Wnoncanonical-monoid-instances` + * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wcompat-unqualified-imports` * :ghc-flag:`-Wtype-equality-out-of-scope` @@ -566,7 +567,7 @@ of ``-W(no-)*``. :since: 8.0 - :default: off + :default: on Warn if noncanonical ``Applicative`` or ``Monad`` instances declarations are detected. @@ -584,6 +585,8 @@ of ``-W(no-)*``. * Warn if ``pure`` is defined backwards (i.e. ``pure = return``). * Warn if ``(*>)`` is defined backwards (i.e. ``(*>) = (>>)``). + This warning is part of the :ghc-flag:`-Wcompat` option group. + .. ghc-flag:: -Wnoncanonical-monadfail-instances :shortdesc: *(deprecated)* warn when ``Monad`` or ``MonadFail`` instances have @@ -610,6 +613,8 @@ of ``-W(no-)*``. :since: 8.0 + :default: on + Warn if noncanonical ``Semigroup`` or ``Monoid`` instances declarations are detected. @@ -625,8 +630,7 @@ of ``-W(no-)*``. * Warn if ``(<>)`` is defined backwards (i.e. ``(<>) = mappend``). - This warning is off by default. However, it is part of the - :ghc-flag:`-Wcompat` option group. + This warning is part of the :ghc-flag:`-Wcompat` option group. .. ghc-flag:: -Wmissing-monadfail-instances :shortdesc: *(deprecated)* ===================================== testsuite/tests/mdo/should_compile/mdo002.hs ===================================== @@ -13,11 +13,10 @@ instance Functor X where fmap f (X a) = X (f a) instance Applicative X where - pure = return + pure = X (<*>) = ap instance Monad X where - return = X (X a) >>= f = f a instance MonadFix X where ===================================== testsuite/tests/polykinds/MonoidsFD.hs ===================================== @@ -25,7 +25,7 @@ class Monoidy to comp id m | m to → comp id where -- We use functional dependencies to help the typechecker understand that -- m and ~> uniquely determine comp (times) and id. --- +-- -- This kind of type class would not have been possible in previous -- versions of GHC; with the new kind system, however, we can abstract -- over kinds!2 Now, let’s create types for the additive and @@ -89,18 +89,17 @@ instance Monoidy (→) (,) () m ⇒ Monoid m where mempty = munit () instance Applicative Wrapper where - pure = return + pure x = runNT munit $ Id x (<*>) = ap -- instance (Functor m, Monoidy NT FC Id m) ⇒ Monad m where instance Monad Wrapper where - return x = runNT munit $ Id x x >>= f = runNT mjoin $ FC (f `fmap` x) -- And so the following works: test3 - = do { print (mappend mempty (Sum 2)) + = do { print (mappend mempty (Sum 2)) -- Sum 2 ; print (mappend (Product 2) (Product 3)) -- Product 6 ===================================== testsuite/tests/polykinds/MonoidsTF.hs ===================================== @@ -103,11 +103,10 @@ instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m) mempty = munit () instance Applicative Wrapper where - pure = return + pure x = runNT munit $ Id x (<*>) = ap instance Monad Wrapper where - return x = runNT munit $ Id x x >>= f = runNT mjoin $ FC (f `fmap` x) -- And so the following works: ===================================== testsuite/tests/profiling/should_run/T3001-2.hs ===================================== @@ -90,22 +90,20 @@ instance Functor PutM where fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w instance Monad PutM where - return a = Put $ PairS a mempty - m >>= k = Put $ let PairS a w = unPut m PairS b w' = unPut (k a) in PairS b (w `mappend` w') - m >> k = Put $ +instance Applicative PutM where + pure a = Put $ PairS a mempty + (<*>) = ap + + m *> k = Put $ let PairS _ w = unPut m PairS b w' = unPut k in PairS b (w `mappend` w') -instance Applicative PutM where - pure = return - (<*>) = ap - tell :: Builder -> Put tell b = Put $ PairS () b @@ -189,9 +187,6 @@ joinZ bb lb | otherwise = L.Chunk bb lb instance Monad Get where - return a = Get (\s -> (a, s)) - {-# INLINE return #-} - m >>= k = Get (\s -> let (a, s') = unGet m s in unGet (k a) s') {-# INLINE (>>=) #-} @@ -200,7 +195,9 @@ instance MonadFail Get where fail = error "failDesc" instance Applicative Get where - pure = return + pure a = Get (\s -> (a, s)) + {-# INLINE pure #-} + (<*>) = ap getZ :: Get S ===================================== testsuite/tests/profiling/should_run/ioprof.hs ===================================== @@ -10,13 +10,13 @@ newtype M s a = M { unM :: s -> (s,a) } instance Monad (M s) where (M m) >>= k = M $ \s -> case m s of (s',a) -> unM (k a) s' - return a = M $ \s -> (s,a) + instance Functor (M s) where fmap = liftM instance Applicative (M s) where - pure = return + pure a = M $ \s -> (s,a) (<*>) = ap errorM :: String -> M s a ===================================== testsuite/tests/rebindable/rebindable2.hs ===================================== @@ -24,16 +24,15 @@ module Main where }; instance (Applicative TM) where { - pure = return; + pure a = MkTM (debugFunc "pure" (Prelude.pure a)); + (*>) ma mb = MkTM (debugFunc "*>" ((Prelude.*>) (unTM ma) (unTM mb))); (<*>) = ap; }; instance (Monad TM) where { - return a = MkTM (debugFunc "return" (Prelude.return a)); - + return = pure; (>>=) ma amb = MkTM (debugFunc ">>=" ((Prelude.>>=) (unTM ma) (\a -> unTM (amb a)))); - - (>>) ma mb = MkTM (debugFunc ">>" ((Prelude.>>) (unTM ma) (unTM mb))); + (>>) = (*>) }; instance (MonadFail TM) where { ===================================== testsuite/tests/rebindable/rebindable2.stdout ===================================== @@ -1,18 +1,18 @@ start test test_do failure -++ >> +++ *> ++ >>= ++ fail -- fail -- >>= --- >> +-- *> end test test_do failure start test test_do success -++ >> +++ *> ++ >>= -++ return --- return +++ pure +-- pure -- >>= --- >> +-- *> end test test_do success start test test_fromInteger 135 ===================================== testsuite/tests/simplCore/T9646/StrictPrim.hs ===================================== @@ -18,7 +18,10 @@ newtype StrictPrim s a instance Applicative (StrictPrim s) where {-# INLINE pure #-} - pure = return + pure !x = StrictPrim ( \ !s -> (# s, x #)) + + {-# INLINE (*>) #-} + (!m) *> (!k) = do { _ <- m ; k } {-# INLINE (<*>) #-} (<*>) a b = do f <- a ; v <- b ; return $! (f $! v) @@ -31,11 +34,6 @@ instance Functor (StrictPrim s) where instance Monad (StrictPrim s) where - {-# INLINE return #-} - return !x = StrictPrim ( \ !s -> (# s, x #)) - - {-# INLINE (>>) #-} - (!m) >> (!k) = do { _ <- m ; k } {-# INLINE (>>=) #-} (StrictPrim !m) >>= (!k) = ===================================== testsuite/tests/simplCore/should_run/T17744A.hs ===================================== @@ -17,10 +17,9 @@ instance Functor (Parser t) where fmap f p = apply (fmap f) p instance Applicative (Parser t) where - pure = return + pure = Result mempty instance Monad (Parser t) where - return = Result mempty Result s r >>= f = feed s (f r) p >>= f = apply (>>= f) p ===================================== testsuite/tests/simplCore/should_run/T3591.hs ===================================== @@ -1,4 +1,4 @@ -{- +{- Copyright 2009 Mario Blazevic This file is part of the Streaming Component Combinators (SCC) project. @@ -20,7 +20,7 @@ -- | Module "Trampoline" defines the pipe computations and their basic building blocks. {-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses, - TypeFamilies, KindSignatures, FlexibleContexts, + TypeFamilies, KindSignatures, FlexibleContexts, FlexibleInstances, OverlappingInstances, UndecidableInstances #-} @@ -75,11 +75,10 @@ instance Functor Identity where fmap = liftM instance Applicative Identity where - pure = return + pure a = Identity a (<*>) = ap instance Monad Identity where - return a = Identity a m >>= k = k (runIdentity m) newtype Trampoline m s r = Trampoline {bounce :: m (TrampolineState m s r)} @@ -89,11 +88,10 @@ instance (Monad m, Functor s) => Functor (Trampoline m s) where fmap = liftM instance (Monad m, Functor s) => Applicative (Trampoline m s) where - pure = return + pure x = Trampoline (return (Done x)) (<*>) = ap instance (Monad m, Functor s) => Monad (Trampoline m s) where - return x = Trampoline (return (Done x)) t >>= f = Trampoline (bounce t >>= apply f) where apply f (Done x) = bounce (f x) apply f (Suspend s) = return (Suspend (fmap (>>= f) s)) @@ -111,7 +109,7 @@ instance Functor (Await x) where data EitherFunctor l r x = LeftF (l x) | RightF (r x) instance (Functor l, Functor r) => Functor (EitherFunctor l r) where - fmap f v = trace "fmap Either" $ + fmap f v = trace "fmap Either" $ case v of LeftF l -> trace "fmap LeftF" $ LeftF (fmap f l) RightF r -> trace "fmap RightF" $ RightF (fmap f r) @@ -178,7 +176,7 @@ liftOut :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Trampoli liftOut (Trampoline ma) = trace "liftOut" $ Trampoline (liftM inject ma) where inject :: TrampolineState m a x -> TrampolineState m d x inject (Done x) = Done x - inject (Suspend a) = trace "inject suspend" $ Suspend (liftFunctor $ trace "calling fmap" $ + inject (Suspend a) = trace "inject suspend" $ Suspend (liftFunctor $ trace "calling fmap" $ fmap liftOut (trace "poking a" a)) data Sink (m :: Type -> Type) a x = ===================================== testsuite/tests/typecheck/should_run/T1735_Help/State.hs ===================================== @@ -7,7 +7,6 @@ import Control.Monad (ap, liftM) newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } instance Monad m => Monad (StateT s m) where - return a = StateT $ \s -> return (a, s) m >>= k = StateT $ \s -> do ~(a, s') <- runStateT m s runStateT (k a) s' @@ -19,7 +18,7 @@ instance Monad m => Functor (StateT s m) where fmap = liftM instance Monad m => Applicative (StateT s m) where - pure = return + pure a = StateT $ \s -> pure (a, s) (<*>) = ap get :: Monad m => StateT s m s ===================================== testsuite/tests/typecheck/should_run/T4809_IdentityT.hs ===================================== @@ -19,9 +19,8 @@ data XML -- * IdentityT Monad Transformer newtype IdentityT m a = IdentityT { runIdentityT :: m a } - deriving (Functor, Monad, MonadIO, MonadPlus) + deriving (Functor, Applicative, Monad, MonadIO, MonadPlus) -instance Monad m => Applicative (IdentityT m) where instance Monad m => Alternative (IdentityT m) where instance MonadTrans IdentityT where ===================================== testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs ===================================== @@ -34,12 +34,9 @@ import Control.Monad (MonadPlus(..),liftM) -- | The monad transformer that allows a monad to generate XML values. newtype XMLGenT m a = XMLGenT (m a) - deriving (Monad, Functor, MonadIO, MonadPlus, MonadWriter w, MonadReader r, - MonadState s, MonadRWS r w s, MonadCont, MonadError e) - -instance Monad m => Applicative (XMLGenT m) where - pure = return - (<*>) = ap + deriving (Monad, Functor, Applicative, MonadIO, MonadPlus, MonadWriter w, + MonadReader r, MonadState s, MonadRWS r w s, MonadCont, + MonadError e) instance Monad m => Alternative (XMLGenT m) where ===================================== testsuite/tests/wcompat-warnings/Template.hs ===================================== @@ -13,3 +13,18 @@ instance Semi.Semigroup S where instance Monoid S where S a `mappend` S b = S (a+b) mempty = S 0 + +newtype M a = M a + +instance Functor M where + fmap = undefined + +instance Applicative M where + liftA2 = undefined + pure = return + (*>) = (>>) + +instance Monad M where + return = undefined + (>>=) = undefined + (>>) = undefined ===================================== testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr ===================================== @@ -3,15 +3,47 @@ Template.hs:5:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. This will become an error in a future release. -Template.hs:11:3: warning: [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] +Template.hs:11:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] Noncanonical ‘(<>) = mappend’ definition detected in the instance declaration for ‘Semigroup S’. - Move definition from ‘mappend’ to ‘(<>)’ - See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid + Suggested fix: + Move definition from ‘mappend’ to ‘(<>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid -Template.hs:14:3: warning: [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] +Template.hs:14:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] Noncanonical ‘mappend’ definition detected in the instance declaration for ‘Monoid S’. ‘mappend’ will eventually be removed in favour of ‘(<>)’ - Either remove definition for ‘mappend’ (recommended) or define as ‘mappend = (<>)’ - See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid + Suggested fix: + Either remove definition for ‘mappend’ (recommended) or define as ‘mappend = (<>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid + +Template.hs:24:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)] + Noncanonical ‘pure = return’ definition detected + in the instance declaration for ‘Applicative M’. + Suggested fix: + Move definition from ‘return’ to ‘pure’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return + +Template.hs:25:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)] + Noncanonical ‘(*>) = (>>)’ definition detected + in the instance declaration for ‘Applicative M’. + Suggested fix: + Move definition from ‘(>>)’ to ‘(*>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return + +Template.hs:28:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)] + Noncanonical ‘return’ definition detected + in the instance declaration for ‘Monad M’. + ‘return’ will eventually be removed in favour of ‘pure’ + Suggested fix: + Either remove definition for ‘return’ (recommended) or define as ‘return = pure’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return + +Template.hs:30:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)] + Noncanonical ‘(>>)’ definition detected + in the instance declaration for ‘Monad M’. + ‘(>>)’ will eventually be removed in favour of ‘(*>)’ + Suggested fix: + Either remove definition for ‘(>>)’ (recommended) or define as ‘(>>) = (*>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/994bda563604461ffb8454d6e298b0310520bcc8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/994bda563604461ffb8454d6e298b0310520bcc8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 04:08:02 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sat, 06 May 2023 00:08:02 -0400 Subject: [Git][ghc/ghc][wip/expand-do] something good in sight Message-ID: <6455d2a2e4c71_e3e0631942c185457af@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 69fa92cb by Apoorv Ingle at 2023-05-05T23:07:55-05:00 something good in sight - - - - - 3 changed files: - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -346,10 +346,10 @@ subordinates env instMap decl = case decl of data_fams = do DataFamInstDecl { dfid_eqn = (FamEqn { feqn_tycon = L l _ - , feqn_rhs = defn } :: FamEqn GhcRn (HsDataDefn GhcRn))} <- unLoc <$> cid_datafam_insts d + , feqn_rhs = defn })} <- unLoc <$> cid_datafam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn ty_fams = do - TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ } :: FamEqn GhcRn (LHsType GhcRn)) } <- unLoc <$> cid_tyfam_insts d + TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ }) } <- unLoc <$> cid_tyfam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] in data_fams ++ ty_fams ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -108,8 +108,8 @@ arrowMatchContextExhaustiveWarningFlag = \ case -- 'HsMatchContext' (does not matter whether it is the redundancy check or the -- exhaustiveness check). isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool -isMatchContextPmChecked _ origin LambdaExpr -- It is likely that this is generated by expanding do stmts - = isGenerated origin +-- isMatchContextPmChecked _ origin LambdaExpr -- It is likely that this is generated by expanding do stmts +-- = isGenerated origin isMatchContextPmChecked dflags origin kind | isGenerated origin = False ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1623,8 +1623,9 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs -- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on type checking +-- does depend on the type environment however isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> TcM Bool -isIrrefutableHsPatRn _ is_strict pat = +isIrrefutableHsPatRn tc_env is_strict pat = do traceTc "isIrrefutableHsPatRn" empty goL pat where @@ -1662,9 +1663,7 @@ isIrrefutableHsPatRn _ is_strict pat = ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon , ppr (isNewTyCon tycon) , ppr (tcHasFixedRuntimeRep tycon)]) - ; let b' = (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon - || tcHasFixedRuntimeRep tycon) + ; let b' = isJust (tyConSingleDataCon_maybe tycon) ; return (b && b') } id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) (AConLike cl) -> @@ -1676,9 +1675,7 @@ isIrrefutableHsPatRn _ is_strict pat = traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon , ppr (isNewTyCon tycon) , ppr (tcHasFixedRuntimeRep tycon)] ) - let b' = (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon - || tcHasFixedRuntimeRep tycon) + let b' = isJust (tyConSingleDataCon_maybe tycon) return (b && b') PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) return False -- conservative View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69fa92cb1ec0c366ca13046697019123e2b9673a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69fa92cb1ec0c366ca13046697019123e2b9673a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 11:21:08 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 06 May 2023 07:21:08 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Remove duplicated code in Printer.c (rebase fixup) Message-ID: <64563824d56d1_e3e064858a23057209a@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 31d6f67b by Sven Tennie at 2023-05-06T11:20:11+00:00 Remove duplicated code in Printer.c (rebase fixup) - - - - - 1 changed file: - rts/Printer.c Changes: ===================================== rts/Printer.c ===================================== @@ -279,6 +279,24 @@ printClosure( const StgClosure *obj ) break; } + case UNDERFLOW_FRAME: + { + StgUnderflowFrame* u = (StgUnderflowFrame*)obj; + debugBelch("UNDERFLOW_FRAME("); + printPtr((StgPtr)u->next_chunk); + debugBelch(")\n"); + break; + } + + case STOP_FRAME: + { + StgStopFrame* u = (StgStopFrame*)obj; + debugBelch("STOP_FRAME("); + printPtr((StgPtr)GET_INFO((StgClosure *)u)); + debugBelch(")\n"); + break; + } + case CATCH_RETRY_FRAME: { StgCatchRetryFrame* frame = (StgCatchRetryFrame*)obj; @@ -318,63 +336,6 @@ printClosure( const StgClosure *obj ) break; } - case UNDERFLOW_FRAME: - { - StgUnderflowFrame* u = (StgUnderflowFrame*)obj; - debugBelch("UNDERFLOW_FRAME("); - printPtr((StgPtr)u->next_chunk); - debugBelch(")\n"); - break; - } - - case STOP_FRAME: - { - StgStopFrame* u = (StgStopFrame*)obj; - debugBelch("STOP_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); - debugBelch(")\n"); - break; - } - - case ATOMICALLY_FRAME: - { - StgAtomicallyFrame* u = (StgAtomicallyFrame*)obj; - debugBelch("ATOMICALLY_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); - debugBelch(","); - printPtr((StgPtr)u->code); - debugBelch(","); - printPtr((StgPtr)u->result); - debugBelch(")\n"); - break; - } - - case CATCH_RETRY_FRAME: - { - StgCatchRetryFrame* u = (StgCatchRetryFrame*)obj; - debugBelch("CATCH_RETRY_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); - debugBelch(","); - printPtr((StgPtr)u->first_code); - debugBelch(","); - printPtr((StgPtr)u->alt_code); - debugBelch(")\n"); - break; - } - - case CATCH_STM_FRAME: - { - StgCatchSTMFrame* u = (StgCatchSTMFrame*)obj; - debugBelch("CATCH_STM_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); - debugBelch(","); - printPtr((StgPtr)u->code); - debugBelch(","); - printPtr((StgPtr)u->handler); - debugBelch(")\n"); - break; - } - case ARR_WORDS: { StgWord i; @@ -618,9 +579,6 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) case UPDATE_FRAME: case CATCH_FRAME: - case CATCH_RETRY_FRAME: - case CATCH_STM_FRAME: - case ATOMICALLY_FRAME: case UNDERFLOW_FRAME: case STOP_FRAME: case ATOMICALLY_FRAME: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31d6f67b093b1e2e34496e0dc71e12cfcce7efe5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31d6f67b093b1e2e34496e0dc71e12cfcce7efe5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 11:25:46 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 06 May 2023 07:25:46 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Printer.c: Smaller diff + correct cast Message-ID: <6456393ac0677_e3e06485f0dc857259f@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: a661ec56 by Sven Tennie at 2023-05-06T11:25:22+00:00 Printer.c: Smaller diff + correct cast - - - - - 1 changed file: - rts/Printer.c Changes: ===================================== rts/Printer.c ===================================== @@ -296,7 +296,20 @@ printClosure( const StgClosure *obj ) debugBelch(")\n"); break; } - + + case ATOMICALLY_FRAME: + { + StgAtomicallyFrame* frame = (StgAtomicallyFrame*)obj; + debugBelch("ATOMICALLY_FRAME("); + printPtr((StgPtr)GET_INFO((StgClosure *)frame)); + debugBelch(","); + printPtr((StgPtr)frame->code); + debugBelch(","); + printPtr((StgPtr)frame->result); + debugBelch(")\n"); + break; + } + case CATCH_RETRY_FRAME: { StgCatchRetryFrame* frame = (StgCatchRetryFrame*)obj; @@ -323,19 +336,6 @@ printClosure( const StgClosure *obj ) break; } - case ATOMICALLY_FRAME: - { - StgAtomicallyFrame* frame = (StgAtomicallyFrame*)obj; - debugBelch("ATOMICALLY_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)frame)); - debugBelch(","); - printPtr((StgPtr)frame->code); - debugBelch(","); - printPtr((StgPtr)frame->result); - debugBelch(")\n"); - break; - } - case ARR_WORDS: { StgWord i; @@ -715,17 +715,17 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type); switch (fun_info->f.fun_type) { case ARG_GEN: - printSmallBitmap(spBottom, &ret_fun->payload, + printSmallBitmap(spBottom, (StgPtr) &ret_fun->payload, BITMAP_BITS(fun_info->f.b.bitmap), BITMAP_SIZE(fun_info->f.b.bitmap)); break; case ARG_GEN_BIG: - printLargeBitmap(spBottom, &ret_fun->payload, + printLargeBitmap(spBottom, (StgPtr) &ret_fun->payload, GET_FUN_LARGE_BITMAP(fun_info), GET_FUN_LARGE_BITMAP(fun_info)->size); break; default: - printSmallBitmap(spBottom, &ret_fun->payload, + printSmallBitmap(spBottom, (StgPtr) &ret_fun->payload, BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type])); break; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a661ec564e5bab4c0cadb1af9ba2566b9b610df3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a661ec564e5bab4c0cadb1af9ba2566b9b610df3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 6 17:50:08 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 06 May 2023 13:50:08 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23070-pipeline-monad Message-ID: <64569350c3ce8_e3e06556bf76060142a@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23070-pipeline-monad at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23070-pipeline-monad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 7 08:11:09 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Sun, 07 May 2023 04:11:09 -0400 Subject: [Git][ghc/ghc][wip/amg/tweak-co-opt] 997 commits: Introduce a standard thunk for allocating strings Message-ID: <64575d1d75820_e3e0661cb56186560f2@gitlab.mail> Adam Gundry pushed to branch wip/amg/tweak-co-opt at Glasgow Haskell Compiler / GHC Commits: 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - f4f0ca72 by Adam Gundry at 2023-05-05T20:18:44+01:00 Tweak isAxiom_maybe to ignore non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - e22c1c14 by Adam Gundry at 2023-05-05T20:18:44+01:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. - - - - - 13 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32a2258f2d2652b96a8923b3b7b8ec5748332338...e22c1c143a1dc407a60f5cf9d3b393a54a99f0cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32a2258f2d2652b96a8923b3b7b8ec5748332338...e22c1c143a1dc407a60f5cf9d3b393a54a99f0cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 7 08:10:15 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Sun, 07 May 2023 04:10:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/wip/tweak-co-opt Message-ID: <64575ce7537a6_e3e06604d24606554b2@gitlab.mail> Adam Gundry pushed new branch wip/wip/tweak-co-opt at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/wip/tweak-co-opt You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 7 08:11:27 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Sun, 07 May 2023 04:11:27 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/wip/tweak-co-opt Message-ID: <64575d2fba343_e3e0662cee4f86564f@gitlab.mail> Adam Gundry deleted branch wip/wip/tweak-co-opt at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 7 22:28:07 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 07 May 2023 18:28:07 -0400 Subject: [Git][ghc/ghc][wip/T23070-pipeline-monad] Further refactoring Message-ID: <645825f7295a3_38ffda5229c267dd@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-pipeline-monad at Glasgow Haskell Compiler / GHC Commits: 527a4943 by Simon Peyton Jones at 2023-05-07T23:25:00+01:00 Further refactoring In particular make the Irred pipeline one-stage (Just the Dict pipeline is left) - - - - - 9 changed files: - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - + compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -277,8 +277,8 @@ floatKindEqualities wc = float_wc emptyVarSet wc = Nothing where is_floatable ct - | insolubleEqCt ct = False - | otherwise = tyCoVarsOfCt ct `disjointVarSet` trapping_tvs + | insolubleCt ct = False + | otherwise = tyCoVarsOfCt ct `disjointVarSet` trapping_tvs float_implic :: TcTyCoVarSet -> Implication -> Maybe (Bag Ct, Bag DelayedError) float_implic trapping_tvs (Implic { ic_wanted = wanted, ic_given_eqs = given_eqs @@ -3396,7 +3396,7 @@ approximateWC float_past_equalities wc is_floatable encl_eqs skol_tvs ct | isGivenCt ct = False - | insolubleEqCt ct = False + | insolubleCt ct = False | tyCoVarsOfCt ct `intersectsVarSet` skol_tvs = False | otherwise = case classifyPredType (ctPred ct) of ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -17,7 +17,8 @@ import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType import GHC.Tc.Solver.Rewrite import GHC.Tc.Solver.Monad -import GHC.Tc.Solver.Equality( solveNonCanonicalEquality, solveCanonicalEquality ) +import GHC.Tc.Solver.Equality( solveEquality ) +import GHC.Tc.Solver.Irred( solveIrred ) import GHC.Tc.Types.Evidence import GHC.Tc.Types.EvTerm @@ -87,39 +88,52 @@ last time through, so we can skip the classification step. -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ canonicalize :: Ct -> SolverStage Ct -canonicalize (CNonCanonical ev) - = canNC ev +canonicalize (CNonCanonical ev) = canNC ev +canonicalize (CIrredCan (IrredCt { ir_ev = ev })) = canNC ev -canonicalize (CEqCan can_eq_ct) - = solveCanonicalEquality can_eq_ct +canonicalize (CEqCan (EqCt { eq_ev = ev, eq_eq_rel = eq_rel + , eq_lhs = lhs, eq_rhs = rhs })) + = solveEquality ev eq_rel (canEqLHSType lhs) rhs canonicalize (CQuantCan (QCI { qci_ev = ev, qci_pend_sc = pend_sc })) - = Stage $ canForAll ev pend_sc + = do { ev <- rewriteEvidence ev + ; case classifyPredType (ctEvPred ev) of + ForAllPred tvs th p -> Stage $ solveForAll ev tvs th p pend_sc + _ -> pprPanic "canonicalise" (ppr ev) } -canonicalize (CIrredCan (IrredCt { ir_ev = ev })) - = canNC ev - -- Instead of rewriting the evidence before classifying, it's possible we +canonicalize (CDictCan { cc_ev = ev, cc_pend_sc = pend_sc }) + = do { ev <- rewriteEvidence ev + ; case classifyPredType (ctEvPred ev) of + ClassPred cls tys -> Stage $ solveClass ev cls tys pend_sc + _ -> pprPanic "canonicalise" (ppr ev) } + +canNC :: CtEvidence -> SolverStage Ct +canNC ev + = -- Instead of rewriting the evidence before classifying, it's possible we -- can make progress without the rewrite. Try this first. -- For insolubles (all of which are equalities), do /not/ rewrite the arguments -- In #14350 doing so led entire-unnecessary and ridiculously large -- type function expansion. Instead, canEqNC just applies -- the substitution to the predicate, and may do decomposition; -- e.g. a ~ [a], where [G] a ~ [Int], can decompose + case classifyPredType (ctEvPred ev) of { + EqPred eq_rel ty1 ty2 -> solveEquality ev eq_rel ty1 ty2 ; + _ -> -canonicalize (CDictCan { cc_ev = ev, cc_class = cls - , cc_tyargs = xis, cc_pend_sc = pend_sc }) - = {-# SCC "canClass" #-} - Stage $ canClass ev cls xis pend_sc + -- Do rewriting on the constraint, especially zonking + do { ev <- rewriteEvidence ev + ; let irred = IrredCt { ir_ev = ev, ir_reason = IrredShapeReason } -canNC :: CtEvidence -> SolverStage Ct -canNC ev = - case classifyPredType pred of - ClassPred cls tys -> Stage $ canClassNC ev cls tys - EqPred eq_rel ty1 ty2 -> solveNonCanonicalEquality ev eq_rel ty1 ty2 - IrredPred {} -> Stage $ canIrred ev - ForAllPred tvs th p -> Stage $ canForAllNC ev tvs th p - where - pred = ctEvPred ev + -- And then re-classify + ; case classifyPredType (ctEvPred ev) of + ClassPred cls tys -> Stage $ solveClassNC ev cls tys + ForAllPred tvs th p -> Stage $ solveForAllNC ev tvs th p + IrredPred {} -> solveIrred irred + EqPred eq_rel ty1 ty2 -> solveEquality ev eq_rel ty1 ty2 + -- This case only happens if (say) `c` is unified with `a ~# b`, + -- but that is rare becuase it requires c :: CONSTRAINT UnliftedRep + + }} {- ************************************************************************ @@ -129,19 +143,18 @@ canNC ev = ************************************************************************ -} -canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) --- "NC" means "non-canonical"; that is, we have got here --- from a NonCanonical constraint, not from a CDictCan --- Precondition: EvVar is class evidence -canClassNC ev cls tys +solveClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) +-- NC: this comes from CNonCanonical or CIrredCan +-- Precondition: already rewritten by inert set +solveClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] = do { dflags <- getDynFlags ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys - -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork (listToBag sc_cts) - ; canClass ev cls tys doNotExpand } - -- doNotExpand: We have already expanded superclasses for /this/ dict - -- so set the fuel to doNotExpand to avoid repeating expansion + ; solveClass ev cls tys doNotExpand } + -- doNotExpand: We have already expanded superclasses for /this/ dict + -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -167,24 +180,30 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys doNotExpand - -- doNotExpand: No superclasses for class CallStack - -- See invariants in CDictCan.cc_pend_sc - } + ; solveClass new_ev cls tys doNotExpand } + -- doNotExpand: No superclasses for class CallStack + -- See invariants in CDictCan.cc_pend_sc | otherwise = do { dflags <- getDynFlags ; let fuel | classHasSCs cls = wantedsFuel dflags | otherwise = doNotExpand -- See Invariants in `CCDictCan.cc_pend_sc` - ; canClass ev cls tys fuel - } - + ; solveClass ev cls tys fuel } where loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev +solveClass :: CtEvidence -> Class -> [Type] -> ExpansionFuel -> TcS (StopOrContinue Ct) +solveClass ev cls tys pend_sc + = -- Sll classes do *nominal* matching + assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ + continueWith (CDictCan { cc_ev = ev + , cc_tyargs = tys + , cc_class = cls + , cc_pend_sc = pend_sc }) + solveCallStack :: CtEvidence -> EvCallStack -> TcS () -- Also called from GHC.Tc.Solver when defaulting call stacks solveCallStack ev ev_cs = do @@ -195,25 +214,6 @@ solveCallStack ev ev_cs = do let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) setEvBindIfWanted ev IsCoherent ev_tm -canClass :: CtEvidence - -> Class -> [Type] - -> ExpansionFuel -- n > 0 <=> un-explored superclasses - -> TcS (StopOrContinue Ct) --- Precondition: EvVar is class evidence - -canClass ev cls tys pend_sc - = -- all classes do *nominal* matching - assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ - do { (redns@(Reductions _ xis), rewriters) <- rewriteArgsNom ev cls_tc tys - ; let redn = mkClassPredRedn cls redns - ; rewriteEvidence rewriters ev redn $ \new_ev -> - do { traceTcS "canClass" (vcat [ ppr new_ev, ppr (reductionReducedType redn) ]) - ; continueWith (CDictCan { cc_ev = new_ev - , cc_tyargs = xis - , cc_class = cls - , cc_pend_sc = pend_sc }) }} - where - cls_tc = classTyCon cls {- Note [The superclass story] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -715,40 +715,8 @@ which looks for primitive equalities specially in the quantified constraints. See also Note [Evidence for quantified constraints] in GHC.Core.Predicate. - - -************************************************************************ -* * -* Irreducibles canonicalization -* * -************************************************************************ -} -canIrred :: CtEvidence -> TcS (StopOrContinue Ct) --- Precondition: ty not a tuple and no other evidence form -canIrred ev - = do { let pred = ctEvPred ev - ; traceTcS "can_pred" (text "IrredPred = " <+> ppr pred) - ; (redn, rewriters) <- rewrite ev pred - ; rewriteEvidence rewriters ev redn $ \ new_ev -> - - do { -- Re-classify, in case rewriting has improved its shape - -- Code is like the canNC, except - -- that the IrredPred branch stops work - ; case classifyPredType (ctEvPred new_ev) of - ClassPred cls tys -> canClassNC new_ev cls tys - EqPred eq_rel ty1 ty2 -> -- IrredPreds have kind Constraint, so - -- cannot become EqPreds - pprPanic "canIrred: EqPred" - (ppr ev $$ ppr eq_rel $$ ppr ty1 $$ ppr ty2) - ForAllPred tvs th p -> -- this is highly suspect; Quick Look - -- should never leave a meta-var filled - -- in with a polytype. This is #18987. - do traceTcS "canEvNC:forall" (ppr pred) - canForAllNC ev tvs th p - IrredPred {} -> continueWith $ - mkIrredCt IrredShapeReason new_ev } } - {- ********************************************************************* * * * Quantified predicates @@ -827,16 +795,18 @@ type signature. -} -canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType - -> TcS (StopOrContinue Ct) -canForAllNC ev tvs theta pred +solveForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType + -> TcS (StopOrContinue Ct) +-- NC: this came from CNonCanonical, so we have not yet expanded superclasses +-- Precondition: already rewritten by inert set +solveForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe = do { dflags <- getDynFlags ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork (listToBag sc_cts) - ; canForAll ev doNotExpand } + ; solveForAll ev tvs theta pred doNotExpand } -- doNotExpand: as we have already (eagerly) expanded superclasses for this class | otherwise @@ -847,27 +817,13 @@ canForAllNC ev tvs theta pred -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] -- See Note [Quantified constraints] | otherwise = doNotExpand - ; canForAll ev fuel } + ; solveForAll ev tvs theta pred fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) --- We have a constraint (forall as. blah => C tys) -canForAll ev fuel - = do { -- First rewrite it to apply the current substitution - ; (redn, rewriters) <- rewrite ev (ctEvPred ev) - ; rewriteEvidence rewriters ev redn $ \ new_ev -> - - do { -- Now decompose into its pieces and solve it - -- (It takes a lot less code to rewrite before decomposing.) - ; case classifyPredType (ctEvPred new_ev) of - ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred fuel - _ -> pprPanic "canForAll" (ppr new_ev) - } } - solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) +-- Precondition: already rewritten by inert set solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] @@ -966,12 +922,7 @@ we'll find a match in the InstEnv. ************************************************************************ -} -rewriteEvidence :: RewriterSet -- ^ See Note [Wanteds rewrite Wanteds] - -- in GHC.Tc.Types.Constraint - -> CtEvidence -- ^ old evidence - -> Reduction -- ^ new predicate + coercion, of type ~ new predicate - -> (CtEvidence -> TcS (StopOrContinue Ct)) - -> TcS (StopOrContinue Ct) +rewriteEvidence :: CtEvidence -> SolverStage CtEvidence -- (rewriteEvidence old_ev new_pred co do_next) -- Main purpose: create new evidence for new_pred; -- unless new_pred is cached already @@ -1005,33 +956,42 @@ the rewriter set. We check this with an assertion. -} -rewriteEvidence rewriters old_ev (Reduction co new_pred) do_next +rewriteEvidence ev + = Stage $ do { traceTcS "rewriteEvidence" (ppr ev) + ; (redn, rewriters) <- rewrite ev (ctEvPred ev) + ; finish_rewrite ev redn rewriters } + +finish_rewrite :: CtEvidence -- ^ old evidence + -> Reduction -- ^ new predicate + coercion, of type ~ new predicate + -> RewriterSet -- ^ See Note [Wanteds rewrite Wanteds] + -- in GHC.Tc.Types.Constraint + -> TcS (StopOrContinue CtEvidence) +finish_rewrite old_ev (Reduction co new_pred) rewriters | isReflCo co -- See Note [Rewriting with Refl] = assert (isEmptyRewriterSet rewriters) $ - do_next (setCtEvPredType old_ev new_pred) + continueWith (setCtEvPredType old_ev new_pred) -rewriteEvidence rewriters ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) - (Reduction co new_pred) do_next +finish_rewrite ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) + (Reduction co new_pred) rewriters = assert (isEmptyRewriterSet rewriters) $ -- this is a Given, not a wanted do { new_ev <- newGivenEvVar loc (new_pred, new_tm) - ; do_next new_ev } + ; continueWith new_ev } where -- mkEvCast optimises ReflCo new_tm = mkEvCast (evId old_evar) (downgradeRole Representational (ctEvRole ev) co) -rewriteEvidence new_rewriters - ev@(CtWanted { ctev_dest = dest +finish_rewrite ev@(CtWanted { ctev_dest = dest , ctev_loc = loc , ctev_rewriters = rewriters }) - (Reduction co new_pred) do_next + (Reduction co new_pred) new_rewriters = do { mb_new_ev <- newWanted loc rewriters' new_pred ; massert (coercionRole co == ctEvRole ev) ; setWantedEvTerm dest IsCoherent $ mkEvCast (getEvExpr mb_new_ev) (downgradeRole Representational (ctEvRole ev) (mkSymCo co)) ; case mb_new_ev of - Fresh new_ev -> do_next new_ev + Fresh new_ev -> continueWith new_ev Cached _ -> stopWith ev "Cached wanted" } where rewriters' = rewriters S.<> new_rewriters ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -2,7 +2,7 @@ {-# LANGUAGE MultiWayIf #-} module GHC.Tc.Solver.Equality( - solveCanonicalEquality, solveNonCanonicalEquality + solveEquality ) where @@ -10,6 +10,7 @@ import GHC.Prelude import GHC.Tc.Solver.Rewrite import GHC.Tc.Solver.Monad +import GHC.Tc.Solver.Irred( tryInertIrreds ) import GHC.Tc.Solver.Dict( matchLocalInst, chooseInstance ) import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Types( findFunEqsByTyCon ) @@ -100,14 +101,9 @@ It's as if we treat (->) and (=>) as different type constructors, which indeed they are! -} -solveCanonicalEquality :: EqCt -> SolverStage Ct -solveCanonicalEquality (EqCt { eq_ev = ev, eq_eq_rel = eq_rel - , eq_lhs = lhs, eq_rhs = rhs }) - = solveNonCanonicalEquality ev eq_rel (canEqLHSType lhs) rhs - -solveNonCanonicalEquality :: CtEvidence -> EqRel -> Type -> Type - -> SolverStage Ct -solveNonCanonicalEquality ev eq_rel ty1 ty2 +solveEquality :: CtEvidence -> EqRel -> Type -> Type + -> SolverStage Ct +solveEquality ev eq_rel ty1 ty2 = do { Pair ty1' ty2' <- zonkEqTypes ev eq_rel ty1 ty2 ; let ev' | debugIsOn = setCtEvPredType ev $ mkPrimEqPredRole (eqRelRole eq_rel) ty1' ty2' @@ -118,12 +114,12 @@ solveNonCanonicalEquality ev eq_rel ty1 ty2 ; case mb_canon of { - Left irred_ct -> do { solveIrredEquality irred_ct + Left irred_ct -> do { tryInertIrreds irred_ct ; return (CIrredCan irred_ct) } ; Right eq_ct -> do { interactEq eq_ct ; tryFunDeps eq_ct - ; tryQuantifiedConstraints eq_ct + ; tryQCsEqCt eq_ct ; return (CEqCan eq_ct) } } } @@ -2674,8 +2670,9 @@ See -} -------------------- -solveIrredEquality :: IrredCt -> SolverStage () -solveIrredEquality irred@(IrredCt { ir_ev = ev }) +{- +tryQCsIrredCt :: IrredCt -> SolverStage () +tryQCsIrredCt irred@(IrredCt { ir_ev = ev }) | EqPred eq_rel t1 t2 <- classifyPredType (ctEvPred ev) = lookup_eq_in_qcis (CIrredCan irred) eq_rel t1 t2 -- If the final_qci_check fails, we'll do continueWith on an IrredCt @@ -2689,10 +2686,11 @@ solveIrredEquality irred@(IrredCt { ir_ev = ev }) -- this can't happen case, but it's not a hot path, and this is -- simple and robust = pprPanic "solveIrredEquality" (ppr ev) +-} -------------------- -tryQuantifiedConstraints :: EqCt -> SolverStage () -tryQuantifiedConstraints work_item@(EqCt { eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel }) +tryQCsEqCt :: EqCt -> SolverStage () +tryQCsEqCt work_item@(EqCt { eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel }) = lookup_eq_in_qcis (CEqCan work_item) eq_rel (canEqLHSType lhs) rhs -------------------- @@ -2701,6 +2699,8 @@ lookup_eq_in_qcis :: Ct -> EqRel -> TcType -> TcType -> SolverStage () -- [W] t1 ~# t2 -- and a Given quantified contraint like (forall a b. blah => a ~ b) -- Why? See Note [Looking up primitive equalities in quantified constraints] +-- See also GHC.Tc.Solver.Canonical +-- Note [Equality superclasses in quantified constraints] lookup_eq_in_qcis work_ct eq_rel lhs rhs = Stage $ do { ev_binds_var <- getTcEvBindsVar ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -42,7 +42,10 @@ module GHC.Tc.Solver.InertSet ( CycleBreakerVarStack, pushCycleBreakerVarStack, addCycleBreakerBindings, - forAllCycleBreakerBindings_ + forAllCycleBreakerBindings_, + + -- * Solving one from another + InteractResult(..), solveOneFromTheOther ) where @@ -65,15 +68,17 @@ import GHC.Core.Class( Class ) import GHC.Core.TyCon import GHC.Core.Unify -import GHC.Data.Bag import GHC.Utils.Misc ( partitionWith ) import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Data.Maybe +import GHC.Data.Bag import Data.List.NonEmpty ( NonEmpty(..), (<|) ) import qualified Data.List.NonEmpty as NE -import GHC.Utils.Panic.Plain -import GHC.Data.Maybe +import Data.Function ( on ) + import Control.Monad ( forM_ ) {- @@ -1945,3 +1950,198 @@ forAllCycleBreakerBindings_ :: Monad m forAllCycleBreakerBindings_ (top_env :| _rest_envs) action = forM_ top_env (uncurry action) {-# INLINABLE forAllCycleBreakerBindings_ #-} -- to allow SPECIALISE later + + +{- ********************************************************************* +* * + Solving one from another +* * +********************************************************************* -} + +data InteractResult + = KeepInert -- Keep the inert item, and solve the work item from it + -- (if the latter is Wanted; just discard it if not) + | KeepWork -- Keep the work item, and solve the inert item from it + +instance Outputable InteractResult where + ppr KeepInert = text "keep inert" + ppr KeepWork = text "keep work-item" + +solveOneFromTheOther :: Ct -- Inert (Dict or Irred) + -> Ct -- WorkItem (same predicate as inert) + -> InteractResult +-- Precondition: +-- * inert and work item represent evidence for the /same/ predicate +-- * Both are CDictCan or CIrredCan +-- +-- We can always solve one from the other: even if both are wanted, +-- although we don't rewrite wanteds with wanteds, we can combine +-- two wanteds into one by solving one from the other + +solveOneFromTheOther ct_i ct_w + | CtWanted { ctev_loc = loc_w } <- ev_w + , prohibitedSuperClassSolve loc_i loc_w + -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance + = -- Inert must be Given + KeepWork + + | CtWanted {} <- ev_w + = -- Inert is Given or Wanted + case ev_i of + CtGiven {} -> KeepInert + -- work is Wanted; inert is Given: easy choice. + + CtWanted {} -- Both are Wanted + -- If only one has no pending superclasses, use it + -- Otherwise we can get infinite superclass expansion (#22516) + -- in silly cases like class C T b => C a b where ... + | not is_psc_i, is_psc_w -> KeepInert + | is_psc_i, not is_psc_w -> KeepWork + + -- If only one is a WantedSuperclassOrigin (arising from expanding + -- a Wanted class constraint), keep the other: wanted superclasses + -- may be unexpected by users + | not is_wsc_orig_i, is_wsc_orig_w -> KeepInert + | is_wsc_orig_i, not is_wsc_orig_w -> KeepWork + + -- otherwise, just choose the lower span + -- reason: if we have something like (abs 1) (where the + -- Num constraint cannot be satisfied), it's better to + -- get an error about abs than about 1. + -- This test might become more elaborate if we see an + -- opportunity to improve the error messages + | ((<) `on` ctLocSpan) loc_i loc_w -> KeepInert + | otherwise -> KeepWork + + -- From here on the work-item is Given + + | CtWanted { ctev_loc = loc_i } <- ev_i + , prohibitedSuperClassSolve loc_w loc_i + = KeepInert -- Just discard the un-usable Given + -- This never actually happens because + -- Givens get processed first + + | CtWanted {} <- ev_i + = KeepWork + + -- From here on both are Given + -- See Note [Replacement vs keeping] + + | lvl_i == lvl_w + = same_level_strategy + + | otherwise -- Both are Given, levels differ + = different_level_strategy + where + ev_i = ctEvidence ct_i + ev_w = ctEvidence ct_w + + pred = ctEvPred ev_i + + loc_i = ctEvLoc ev_i + loc_w = ctEvLoc ev_w + orig_i = ctLocOrigin loc_i + orig_w = ctLocOrigin loc_w + lvl_i = ctLocLevel loc_i + lvl_w = ctLocLevel loc_w + + is_psc_w = isPendingScDict ct_w + is_psc_i = isPendingScDict ct_i + + is_wsc_orig_i = isWantedSuperclassOrigin orig_i + is_wsc_orig_w = isWantedSuperclassOrigin orig_w + + different_level_strategy -- Both Given + | isIPLikePred pred = if lvl_w > lvl_i then KeepWork else KeepInert + | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork + -- See Note [Replacement vs keeping] part (1) + -- For the isIPLikePred case see Note [Shadowing of Implicit Parameters] + + same_level_strategy -- Both Given + = case (orig_i, orig_w) of + + (GivenSCOrigin _ depth_i blocked_i, GivenSCOrigin _ depth_w blocked_w) + | blocked_i, not blocked_w -> KeepWork -- Case 2(a) from + | not blocked_i, blocked_w -> KeepInert -- Note [Replacement vs keeping] + + -- Both blocked or both not blocked + + | depth_w < depth_i -> KeepWork -- Case 2(c) from + | otherwise -> KeepInert -- Note [Replacement vs keeping] + + (GivenSCOrigin {}, _) -> KeepWork -- Case 2(b) from Note [Replacement vs keeping] + + _ -> KeepInert -- Case 2(d) from Note [Replacement vs keeping] + +{- +Note [Replacement vs keeping] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we have two Given constraints both of type (C tys), say, which should +we keep? More subtle than you might think! This is all implemented in +solveOneFromTheOther. + + 1) Constraints come from different levels (different_level_strategy) + + - For implicit parameters we want to keep the innermost (deepest) + one, so that it overrides the outer one. + See Note [Shadowing of Implicit Parameters] + + - For everything else, we want to keep the outermost one. Reason: that + makes it more likely that the inner one will turn out to be unused, + and can be reported as redundant. See Note [Tracking redundant constraints] + in GHC.Tc.Solver. + + It transpires that using the outermost one is responsible for an + 8% performance improvement in nofib cryptarithm2, compared to + just rolling the dice. I didn't investigate why. + + 2) Constraints coming from the same level (i.e. same implication) + + (a) If both are GivenSCOrigin, choose the one that is unblocked if possible + according to Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance. + + (b) Prefer constraints that are not superclass selections. Example: + + f :: (Eq a, Ord a) => a -> Bool + f x = x == x + + Eager superclass expansion gives us two [G] Eq a constraints. We + want to keep the one from the user-written Eq a, not the superclass + selection. This means we report the Ord a as redundant with + -Wredundant-constraints, not the Eq a. + + Getting this wrong was #20602. See also + Note [Tracking redundant constraints] in GHC.Tc.Solver. + + (c) If both are GivenSCOrigin, chooose the one with the shallower + superclass-selection depth, in the hope of identifying more correct + redundant constraints. This is really a generalization of point (b), + because the superclass depth of a non-superclass constraint is 0. + + (If the levels differ, we definitely won't have both with GivenSCOrigin.) + + (d) Finally, when there is still a choice, use KeepInert rather than + KeepWork, for two reasons: + - to avoid unnecessary munging of the inert set. + - to cut off superclass loops; see Note [Superclass loops] in GHC.Tc.Solver.Canonical + +Doing the level-check for implicit parameters, rather than making the work item +always override, is important. Consider + + data T a where { T1 :: (?x::Int) => T Int; T2 :: T a } + + f :: (?x::a) => T a -> Int + f T1 = ?x + f T2 = 3 + +We have a [G] (?x::a) in the inert set, and at the pattern match on T1 we add +two new givens in the work-list: [G] (?x::Int) + [G] (a ~ Int) +Now consider these steps + - process a~Int, kicking out (?x::a) + - process (?x::Int), the inner given, adding to inert set + - process (?x::a), the outer given, overriding the inner given +Wrong! The level-check ensures that the inner implicit parameter wins. +(Actually I think that the order in which the work-list is processed means +that this chain of events won't happen, but that's very fragile.) +-} \ No newline at end of file ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -15,19 +15,17 @@ import GHC.Tc.Instance.Class ( safeOverlap ) import GHC.Tc.Types.Evidence import GHC.Tc.Types import GHC.Tc.Types.Constraint -import GHC.Tc.Types.Origin import GHC.Tc.Solver.Types import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.Predicate -import GHC.Core.Coercion import GHC.Builtin.Names ( ipClassKey ) import GHC.Types.Unique( hasKey ) -import GHC.Types.Basic ( SwapFlag(..), IntWithInf, intGtLimit ) +import GHC.Types.Basic ( IntWithInf, intGtLimit ) import GHC.Data.Bag @@ -41,7 +39,6 @@ import GHC.Driver.Session import qualified GHC.LanguageExtensions as LangExt import Data.List( deleteFirstsBy ) -import Data.Function ( on ) import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe @@ -414,262 +411,15 @@ interactWithInertsStage wi do { inerts <- getTcSInerts ; let ics = inert_cans inerts ; case wi of - CIrredCan ir_ct -> interactIrred ics ir_ct - CDictCan {} -> interactDict ics wi - CEqCan {} -> continueWith wi -- "Canonicalisation" stage is - -- full solver for equalities + CDictCan {} -> interactDict ics wi + CEqCan {} -> continueWith wi -- "Canonicalisation" stage is + -- full solver for equalities + CIrredCan {} -> continueWith wi -- Ditto Irreds _ -> pprPanic "interactWithInerts" (ppr wi) } -- CNonCanonical have been canonicalised -data InteractResult - = KeepInert -- Keep the inert item, and solve the work item from it - -- (if the latter is Wanted; just discard it if not) - | KeepWork -- Keep the work item, and solve the inert item from it - -instance Outputable InteractResult where - ppr KeepInert = text "keep inert" - ppr KeepWork = text "keep work-item" - -solveOneFromTheOther :: Ct -- Inert (Dict or Irred) - -> Ct -- WorkItem (same predicate as inert) - -> InteractResult --- Precondition: --- * inert and work item represent evidence for the /same/ predicate --- * Both are CDictCan or CIrredCan --- --- We can always solve one from the other: even if both are wanted, --- although we don't rewrite wanteds with wanteds, we can combine --- two wanteds into one by solving one from the other - -solveOneFromTheOther ct_i ct_w - | CtWanted { ctev_loc = loc_w } <- ev_w - , prohibitedSuperClassSolve loc_i loc_w - -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance - = -- Inert must be Given - KeepWork - - | CtWanted {} <- ev_w - = -- Inert is Given or Wanted - case ev_i of - CtGiven {} -> KeepInert - -- work is Wanted; inert is Given: easy choice. - - CtWanted {} -- Both are Wanted - -- If only one has no pending superclasses, use it - -- Otherwise we can get infinite superclass expansion (#22516) - -- in silly cases like class C T b => C a b where ... - | not is_psc_i, is_psc_w -> KeepInert - | is_psc_i, not is_psc_w -> KeepWork - - -- If only one is a WantedSuperclassOrigin (arising from expanding - -- a Wanted class constraint), keep the other: wanted superclasses - -- may be unexpected by users - | not is_wsc_orig_i, is_wsc_orig_w -> KeepInert - | is_wsc_orig_i, not is_wsc_orig_w -> KeepWork - - -- otherwise, just choose the lower span - -- reason: if we have something like (abs 1) (where the - -- Num constraint cannot be satisfied), it's better to - -- get an error about abs than about 1. - -- This test might become more elaborate if we see an - -- opportunity to improve the error messages - | ((<) `on` ctLocSpan) loc_i loc_w -> KeepInert - | otherwise -> KeepWork - - -- From here on the work-item is Given - - | CtWanted { ctev_loc = loc_i } <- ev_i - , prohibitedSuperClassSolve loc_w loc_i - = KeepInert -- Just discard the un-usable Given - -- This never actually happens because - -- Givens get processed first - - | CtWanted {} <- ev_i - = KeepWork - - -- From here on both are Given - -- See Note [Replacement vs keeping] - - | lvl_i == lvl_w - = same_level_strategy - - | otherwise -- Both are Given, levels differ - = different_level_strategy - where - ev_i = ctEvidence ct_i - ev_w = ctEvidence ct_w - - pred = ctEvPred ev_i - - loc_i = ctEvLoc ev_i - loc_w = ctEvLoc ev_w - orig_i = ctLocOrigin loc_i - orig_w = ctLocOrigin loc_w - lvl_i = ctLocLevel loc_i - lvl_w = ctLocLevel loc_w - - is_psc_w = isPendingScDict ct_w - is_psc_i = isPendingScDict ct_i - - is_wsc_orig_i = isWantedSuperclassOrigin orig_i - is_wsc_orig_w = isWantedSuperclassOrigin orig_w - - different_level_strategy -- Both Given - | isIPLikePred pred = if lvl_w > lvl_i then KeepWork else KeepInert - | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork - -- See Note [Replacement vs keeping] part (1) - -- For the isIPLikePred case see Note [Shadowing of Implicit Parameters] - - same_level_strategy -- Both Given - = case (orig_i, orig_w) of - - (GivenSCOrigin _ depth_i blocked_i, GivenSCOrigin _ depth_w blocked_w) - | blocked_i, not blocked_w -> KeepWork -- Case 2(a) from - | not blocked_i, blocked_w -> KeepInert -- Note [Replacement vs keeping] - - -- Both blocked or both not blocked - - | depth_w < depth_i -> KeepWork -- Case 2(c) from - | otherwise -> KeepInert -- Note [Replacement vs keeping] - - (GivenSCOrigin {}, _) -> KeepWork -- Case 2(b) from Note [Replacement vs keeping] - - _ -> KeepInert -- Case 2(d) from Note [Replacement vs keeping] - -{- -Note [Replacement vs keeping] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we have two Given constraints both of type (C tys), say, which should -we keep? More subtle than you might think! This is all implemented in -solveOneFromTheOther. - - 1) Constraints come from different levels (different_level_strategy) - - - For implicit parameters we want to keep the innermost (deepest) - one, so that it overrides the outer one. - See Note [Shadowing of Implicit Parameters] - - - For everything else, we want to keep the outermost one. Reason: that - makes it more likely that the inner one will turn out to be unused, - and can be reported as redundant. See Note [Tracking redundant constraints] - in GHC.Tc.Solver. - - It transpires that using the outermost one is responsible for an - 8% performance improvement in nofib cryptarithm2, compared to - just rolling the dice. I didn't investigate why. - - 2) Constraints coming from the same level (i.e. same implication) - - (a) If both are GivenSCOrigin, choose the one that is unblocked if possible - according to Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance. - - (b) Prefer constraints that are not superclass selections. Example: - - f :: (Eq a, Ord a) => a -> Bool - f x = x == x - - Eager superclass expansion gives us two [G] Eq a constraints. We - want to keep the one from the user-written Eq a, not the superclass - selection. This means we report the Ord a as redundant with - -Wredundant-constraints, not the Eq a. - - Getting this wrong was #20602. See also - Note [Tracking redundant constraints] in GHC.Tc.Solver. - - (c) If both are GivenSCOrigin, chooose the one with the shallower - superclass-selection depth, in the hope of identifying more correct - redundant constraints. This is really a generalization of point (b), - because the superclass depth of a non-superclass constraint is 0. - - (If the levels differ, we definitely won't have both with GivenSCOrigin.) - - (d) Finally, when there is still a choice, use KeepInert rather than - KeepWork, for two reasons: - - to avoid unnecessary munging of the inert set. - - to cut off superclass loops; see Note [Superclass loops] in GHC.Tc.Solver.Canonical - -Doing the level-check for implicit parameters, rather than making the work item -always override, is important. Consider - data T a where { T1 :: (?x::Int) => T Int; T2 :: T a } - - f :: (?x::a) => T a -> Int - f T1 = ?x - f T2 = 3 - -We have a [G] (?x::a) in the inert set, and at the pattern match on T1 we add -two new givens in the work-list: [G] (?x::Int) - [G] (a ~ Int) -Now consider these steps - - process a~Int, kicking out (?x::a) - - process (?x::Int), the inner given, adding to inert set - - process (?x::a), the outer given, overriding the inner given -Wrong! The level-check ensures that the inner implicit parameter wins. -(Actually I think that the order in which the work-list is processed means -that this chain of events won't happen, but that's very fragile.) - -********************************************************************************* -* * - interactIrred -* * -********************************************************************************* - -Note [Multiple matching irreds] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -You might think that it's impossible to have multiple irreds all match the -work item; after all, interactIrred looks for matches and solves one from the -other. However, note that interacting insoluble, non-droppable irreds does not -do this matching. We thus might end up with several insoluble, non-droppable, -matching irreds in the inert set. When another irred comes along that we have -not yet labeled insoluble, we can find multiple matches. These multiple matches -cause no harm, but it would be wrong to ASSERT that they aren't there (as we -once had done). This problem can be tickled by typecheck/should_compile/holes. - --} - --- Two pieces of irreducible evidence: if their types are *exactly identical* --- we can rewrite them. We can never improve using this: --- if we want ty1 :: Constraint and have ty2 :: Constraint it clearly does not --- mean that (ty1 ~ ty2) -interactIrred :: InertCans -> IrredCt -> TcS (StopOrContinue Ct) - -interactIrred inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) - | isInsolubleReason reason - -- For insolubles, don't allow the constraint to be dropped - -- which can happen with solveOneFromTheOther, so that - -- we get distinct error messages with -fdefer-type-errors - = carry_on - - | let (matching_irreds, others) = findMatchingIrreds (inert_irreds inerts) ev_w - , ((irred_i, swap) : _rest) <- bagToList matching_irreds - -- See Note [Multiple matching irreds] - , let ev_i = irredCtEvidence irred_i - ct_i = CIrredCan irred_i - = do { traceTcS "iteractIrred" $ - vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) - , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] - ; case solveOneFromTheOther ct_i ct_w of - KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) - ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } - KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) - ; updInertIrreds (\_ -> others) - ; carry_on } } - - | otherwise - = carry_on - - where - ct_w = CIrredCan irred_w - carry_on = continueWith ct_w - - swap_me :: SwapFlag -> CtEvidence -> EvTerm - swap_me swap ev - = case swap of - NotSwapped -> ctEvTerm ev - IsSwapped -> evCoercion (mkSymCo (evTermCoercion (ctEvTerm ev))) - -{- -********************************************************************************* +{- ****************************************************************************** * * interactDict * * @@ -1192,42 +942,10 @@ topReactionsStage :: Ct -> SolverStage Ct -- so try interaction with top-level instances. topReactionsStage work_item = Stage $ - do { traceTcS "doTopReact" (ppr work_item) - ; case work_item of - - CDictCan {} -> - do { inerts <- getTcSInerts - ; doTopReactDict inerts work_item } - - CEqCan {} -> continueWith work_item -- "Canonicalisation" stage is - -- full solver for equalities - - CIrredCan {} -> - doTopReactOther work_item + do { case work_item of + CDictCan {} -> do { inerts <- getTcSInerts + ; doTopReactDict inerts work_item } -- Any other work item does not react with any top-level equations _ -> continueWith work_item } --------------------- -doTopReactOther :: Ct -> TcS (StopOrContinue Ct) --- Try local quantified constraints for --- CEqCan e.g. (lhs ~# ty) --- and CIrredCan e.g. (c a) --- --- Why equalities? See GHC.Tc.Solver.Canonical --- Note [Equality superclasses in quantified constraints] -doTopReactOther work_item - | isGiven ev - = continueWith work_item - - | otherwise - = do { res <- matchLocalInst pred loc - ; case res of - OneInst {} -> chooseInstance ev res - _ -> continueWith work_item } - - where - ev = ctEvidence work_item - loc = ctEvLoc ev - pred = ctEvPred ev - ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -0,0 +1,124 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} + +module GHC.Tc.Solver.Irred( + solveIrred, tryInertIrreds + ) where + +import GHC.Prelude + +import GHC.Tc.Types.Constraint +import GHC.Tc.Solver.InertSet +import GHC.Tc.Solver.Dict( matchLocalInst, chooseInstance ) +import GHC.Tc.Solver.Monad +import GHC.Tc.Types.Evidence + +import GHC.Core.Coercion +import GHC.Core.InstEnv ( Coherence(..) ) + +import GHC.Types.Basic( SwapFlag(..) ) + +import GHC.Utils.Outputable + + +import GHC.Data.Bag + + +{- ********************************************************************* +* * +* Irreducibles +* * +********************************************************************* -} + +solveIrred :: IrredCt -> SolverStage Ct +solveIrred irred + = do { tryInertIrreds irred + ; tryQCsIrredCt irred + ; return (CIrredCan irred) } + +{- ********************************************************************* +* * +* Inert Irreducibles +* * +********************************************************************* -} + +-- Two pieces of irreducible evidence: if their types are *exactly identical* +-- we can rewrite them. We can never improve using this: +-- if we want ty1 :: Constraint and have ty2 :: Constraint it clearly does not +-- mean that (ty1 ~ ty2) +tryInertIrreds :: IrredCt -> SolverStage () +tryInertIrreds irred + = Stage $ do { ics <- getInertCans + ; try_inert_irreds ics irred } + +try_inert_irreds :: InertCans -> IrredCt -> TcS (StopOrContinue ()) + +try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) + | isInsolubleReason reason + -- For insolubles, don't allow the constraint to be dropped + -- which can happen with solveOneFromTheOther, so that + -- we get distinct error messages with -fdefer-type-errors + = continueWith () + + | let (matching_irreds, others) = findMatchingIrreds (inert_irreds inerts) ev_w + , ((irred_i, swap) : _rest) <- bagToList matching_irreds + -- See Note [Multiple matching irreds] + , let ev_i = irredCtEvidence irred_i + ct_i = CIrredCan irred_i + = do { traceTcS "iteractIrred" $ + vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) + , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] + ; case solveOneFromTheOther ct_i ct_w of + KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) + ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } + KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) + ; updInertIrreds (\_ -> others) + ; continueWith () } } + + | otherwise + = continueWith () + + where + ct_w = CIrredCan irred_w + + swap_me :: SwapFlag -> CtEvidence -> EvTerm + swap_me swap ev + = case swap of + NotSwapped -> ctEvTerm ev + IsSwapped -> evCoercion (mkSymCo (evTermCoercion (ctEvTerm ev))) + + +{- Note [Multiple matching irreds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +You might think that it's impossible to have multiple irreds all match the +work item; after all, interactIrred looks for matches and solves one from the +other. However, note that interacting insoluble, non-droppable irreds does not +do this matching. We thus might end up with several insoluble, non-droppable, +matching irreds in the inert set. When another irred comes along that we have +not yet labeled insoluble, we can find multiple matches. These multiple matches +cause no harm, but it would be wrong to ASSERT that they aren't there (as we +once had done). This problem can be tickled by typecheck/should_compile/holes. +-} + +{- ********************************************************************* +* * +* Quantified constraints +* * +********************************************************************* -} + +tryQCsIrredCt :: IrredCt -> SolverStage () +-- Try local quantified constraints for +-- and CIrredCan e.g. (c a) +tryQCsIrredCt (IrredCt { ir_ev = ev }) + | isGiven ev + = Stage $ continueWith () + + | otherwise + = Stage $ do { res <- matchLocalInst pred loc + ; case res of + OneInst {} -> chooseInstance ev res + _ -> continueWith () } + where + loc = ctEvLoc ev + pred = ctEvPred ev ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -354,7 +354,7 @@ addInertCan ct = do { traceTcS "addInertCan {" $ text "Trying to insert new inert item:" <+> ppr ct ; mkTcS (\TcSEnv{tcs_abort_on_insoluble=abort_flag} -> - when (abort_flag && insolubleEqCt ct) TcM.failM) + when (abort_flag && insolubleCt ct) TcM.failM) ; ics <- getInertCans ; ics <- maybeKickOut ics ct ; tclvl <- getTcLevel ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -57,7 +57,7 @@ module GHC.Tc.Types.Constraint ( addInsols, dropMisleading, addSimples, addImplics, addHoles, addNotConcreteError, addDelayedErrors, tyCoVarsOfWC, tyCoVarsOfWCList, - insolubleWantedCt, insolubleEqCt, insolubleCt, insolubleIrredCt, + insolubleWantedCt, insolubleCt, insolubleIrredCt, insolubleImplic, nonDefaultableTyVarsOfWC, Implication(..), implicationPrototype, checkTelescopeSkol, @@ -1306,30 +1306,13 @@ insolubleWantedCt ct = insolubleCt ct && not (arisesFromGivens ct) && not (isWantedWantedFunDepOrigin (ctOrigin ct)) -insolubleEqCt :: Ct -> Bool --- Returns True of /equality/ constraints --- that are /definitely/ insoluble --- It won't detect some definite errors like --- F a ~ T (F a) --- where F is a type family, which actually has an occurs check --- --- The function is tuned for application /after/ constraint solving --- i.e. assuming canonicalisation has been done --- E.g. It'll reply True for a ~ [a] --- but False for [a] ~ a --- and --- True for Int ~ F a Int --- but False for Maybe Int ~ F a Int Int --- (where F is an arity-1 type function) -insolubleEqCt (CIrredCan ir_ct) = insolubleIrredCt ir_ct -insolubleEqCt _ = False - insolubleIrredCt :: IrredCt -> Bool +-- Returns True of Irred constraints that are /definitely/ insoluble insolubleIrredCt (IrredCt { ir_reason = reason }) = isInsolubleReason reason --- | Returns True of equality constraints that are definitely insoluble, --- as well as TypeError constraints. +-- | Returns True of constraints that are definitely insoluble, +-- as well as TypeError constraints. -- Can return 'True' for Given constraints, unlike 'insolubleWantedCt'. -- -- This function is critical for accurate pattern-match overlap warnings. @@ -1338,8 +1321,15 @@ insolubleIrredCt (IrredCt { ir_reason = reason }) -- Note that this does not traverse through the constraint to find -- nested custom type errors: it only detects @TypeError msg :: Constraint@, -- and not e.g. @Eq (TypeError msg)@. +-- +-- The function is tuned for application /after/ constraint solving +-- i.e. assuming canonicalisation has been done +-- That's why it looks only for IrredCt, with an insoluble IrredCtReason insolubleCt :: Ct -> Bool -insolubleCt ct = isTopLevelUserTypeError (ctPred ct) || insolubleEqCt ct +insolubleCt ct + | isTopLevelUserTypeError (ctPred ct) = True + | CIrredCan ir_ct <- ct = insolubleIrredCt ir_ct + | otherwise = False where -- NB: 'isTopLevelUserTypeError' detects constraints of the form "TypeError msg" -- and "Unsatisfiable msg". It deliberately does not detect TypeError ===================================== compiler/ghc.cabal.in ===================================== @@ -726,6 +726,7 @@ Library GHC.Tc.Solver.Rewrite GHC.Tc.Solver.InertSet GHC.Tc.Solver.Interact + GHC.Tc.Solver.Irred GHC.Tc.Solver.Equality GHC.Tc.Solver.Dict GHC.Tc.Solver.Monad View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/527a494351981a89b88af927ef144976556e7c7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/527a494351981a89b88af927ef144976556e7c7d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 02:58:31 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sun, 07 May 2023 22:58:31 -0400 Subject: [Git][ghc/ghc][wip/expand-do] something good in sight Message-ID: <645865576d8be_38ffda13269c20566ab@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 36c56e5c by Apoorv Ingle at 2023-05-07T21:57:54-05:00 something good in sight - - - - - 18 changed files: - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/Basic.hs Changes: ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -45,7 +45,7 @@ module GHC.Hs.Utils( mkSimpleMatch, unguardedGRHSs, unguardedRHS, mkMatchGroup, mkLamCaseMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf, mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo, - mkHsDictLet, mkHsLams, + mkHsDictLet, mkHsLams, mkHsLamDoExp, mkHsOpApp, mkHsDo, mkHsDoAnns, mkHsComp, mkHsCompAnns, mkHsWrapPat, mkHsWrapPatCo, mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap, mkHsCmdIf, mkConLikeTc, @@ -271,7 +271,17 @@ mkHsLam :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) -> LHsExpr (GhcPass p) mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches)) where - matches = mkMatchGroup Generated + matches = mkMatchGroup (Generated OtherExpansion) + (noLocA [mkSimpleMatch LambdaExpr pats' body]) + pats' = map (parenthesizePat appPrec) pats + +mkHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) + => [LPat (GhcPass p)] + -> LHsExpr (GhcPass p) + -> LHsExpr (GhcPass p) +mkHsLamDoExp pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches)) + where + matches = mkMatchGroup (Generated DoExpansion) (noLocA [mkSimpleMatch LambdaExpr pats' body]) pats' = map (parenthesizePat appPrec) pats @@ -599,7 +609,7 @@ nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs -- AZ:Is this used? -nlHsLam match = noLocA (HsLam noExtField (mkMatchGroup Generated (noLocA [match]))) +nlHsLam match = noLocA (HsLam noExtField (mkMatchGroup (Generated OtherExpansion) (noLocA [match]))) nlHsPar e = noLocA (gHsPar e) -- nlHsIf should generate if-expressions which are NOT subject to @@ -608,7 +618,7 @@ nlHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs nlHsIf cond true false = noLocA (HsIf noAnn cond true false) nlHsCase expr matches - = noLocA (HsCase noAnn expr (mkMatchGroup Generated (noLocA matches))) + = noLocA (HsCase noAnn expr (mkMatchGroup (Generated OtherExpansion) (noLocA matches))) nlList exprs = noLocA (ExplicitList noAnn exprs) nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) @@ -867,7 +877,7 @@ spanHsLocaLBinds (HsIPBinds _ (IPBinds _ bs)) mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> [LPat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs mkSimpleGeneratedFunBind loc fun pats expr - = L (noAnnSrcSpan loc) $ mkFunBind Generated (L (noAnnSrcSpan loc) fun) + = L (noAnnSrcSpan loc) $ mkFunBind (Generated OtherExpansion) (L (noAnnSrcSpan loc) fun) [mkMatch (mkPrefixFunRhs (L (noAnnSrcSpan loc) fun)) pats expr emptyLocalBinds] ===================================== compiler/GHC/HsToCore/Arrows.hs ===================================== @@ -811,7 +811,7 @@ dsCases ids local_vars stack_id stack_ty res_ty Nothing -> ([], void_ty,) . do_arr ids void_ty res_ty <$> dsExpr (HsLamCase EpAnnNotUsed LamCase (MG { mg_alts = noLocA [] - , mg_ext = MatchGroupTc [Scaled ManyTy void_ty] res_ty Generated + , mg_ext = MatchGroupTc [Scaled ManyTy void_ty] res_ty (Generated OtherExpansion) })) -- Replace the commands in the case with these tagged tuples, ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -346,10 +346,10 @@ subordinates env instMap decl = case decl of data_fams = do DataFamInstDecl { dfid_eqn = (FamEqn { feqn_tycon = L l _ - , feqn_rhs = defn } :: FamEqn GhcRn (HsDataDefn GhcRn))} <- unLoc <$> cid_datafam_insts d + , feqn_rhs = defn })} <- unLoc <$> cid_datafam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn ty_fams = do - TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ } :: FamEqn GhcRn (LHsType GhcRn)) } <- unLoc <$> cid_tyfam_insts d + TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ }) } <- unLoc <$> cid_tyfam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] in data_fams ++ ty_fams ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -763,7 +763,7 @@ dsDo ctx stmts (MG { mg_alts = noLocA [mkSimpleMatch LambdaExpr [mfix_pat] body] - , mg_ext = MatchGroupTc [unrestricted tup_ty] body_ty Generated + , mg_ext = MatchGroupTc [unrestricted tup_ty] body_ty (Generated OtherExpansion) }) mfix_pat = noLocA $ LazyPat noExtField $ mkBigLHsPatTupId rec_tup_pats body = noLocA $ HsDo body_ty ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -831,10 +831,10 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' $ replicate (length (grhssGRHSs m)) initNablas is_pat_syn_match :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool - is_pat_syn_match Generated (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat + is_pat_syn_match (Generated _) (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat is_pat_syn_match _ _ = False non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool - non_wc Generated (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc (Generated _) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False non_wc _ _ = True matchEquations :: HsMatchContext GhcRn ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -20,7 +20,7 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( match ) import GHC.Hs import GHC.HsToCore.Binds import GHC.Core.ConLike -import GHC.Types.Basic ( Origin(..) ) +import GHC.Types.Basic ( Origin(..), GenReason (..) ) import GHC.Tc.Utils.TcType import GHC.Core.Multiplicity import GHC.HsToCore.Monad @@ -167,7 +167,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated + , eqn { eqn_orig = Generated OtherExpansion , eqn_pats = conArgPats val_arg_tys args ++ pats } ) shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -14,7 +14,7 @@ module GHC.HsToCore.Pmc.Utils ( import GHC.Prelude -import GHC.Types.Basic (Origin(..), isGenerated) +import GHC.Types.Basic (Origin(..), isGenerated, isDoExpansionGenerated) import GHC.Driver.Session import GHC.Hs import GHC.Core.Type @@ -109,7 +109,7 @@ arrowMatchContextExhaustiveWarningFlag = \ case -- exhaustiveness check). isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool isMatchContextPmChecked _ origin LambdaExpr -- It is likely that this is generated by expanding do stmts - = isGenerated origin + = isDoExpansionGenerated origin isMatchContextPmChecked dflags origin kind | isGenerated origin = False ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -906,7 +906,7 @@ instance ( HiePass p setOrigin :: Origin -> NodeOrigin -> NodeOrigin setOrigin FromSource _ = SourceInfo -setOrigin Generated _ = GeneratedInfo +setOrigin (Generated _) _ = GeneratedInfo instance HiePass p => ToHie (Located (PatSynBind (GhcPass p) (GhcPass p))) where toHie (L sp psb) = concatM $ case psb of ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Types.SourceText ( SourceText(..), IntegralLit ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc -import GHC.Types.Basic ( TopLevelFlag(..), Origin(Generated) ) +import GHC.Types.Basic ( TopLevelFlag(..), Origin(Generated), GenReason (OtherExpansion) ) import GHC.Data.List.SetOps ( removeDupsOn ) import GHC.Data.Maybe ( whenIsJust ) import GHC.Driver.Session @@ -715,6 +715,6 @@ genFunBind :: LocatedN Name -> [LMatch GhcRn (LHsExpr GhcRn)] -> HsBind GhcRn genFunBind fn ms = FunBind { fun_id = fn - , fun_matches = mkMatchGroup Generated (wrapGenSpan ms) + , fun_matches = mkMatchGroup (Generated OtherExpansion) (wrapGenSpan ms) , fun_ext = emptyNameSet } ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -2301,7 +2301,7 @@ mkFunBindSE arity loc fun pats_and_exprs mkRdrFunBind :: LocatedN RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs mkRdrFunBind fun@(L loc _fun_rdr) matches - = L (na2la loc) (mkFunBind Generated fun matches) + = L (na2la loc) (mkFunBind (Generated OtherExpansion) fun matches) -- | Make a function binding. If no equations are given, produce a function -- with the given arity that uses an empty case expression for the last @@ -2329,7 +2329,7 @@ mkRdrFunBindEC :: Arity -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs mkRdrFunBindEC arity catch_all fun@(L loc _fun_rdr) matches - = L (na2la loc) (mkFunBind Generated fun matches') + = L (na2la loc) (mkFunBind (Generated OtherExpansion) fun matches') where -- Catch-all eqn looks like -- fmap _ z = case z of {} @@ -2353,7 +2353,7 @@ mkRdrFunBindEC arity catch_all fun@(L loc _fun_rdr) matches mkRdrFunBindSE :: Arity -> LocatedN RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs mkRdrFunBindSE arity fun@(L loc fun_rdr) matches - = L (na2la loc) (mkFunBind Generated fun matches') + = L (na2la loc) (mkFunBind (Generated OtherExpansion) fun matches') where -- Catch-all eqn looks like -- compare _ _ = error "Void compare" ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1276,7 +1276,7 @@ desugarRecordUpd record_expr possible_parents rbnds res_ty ds_expr = HsLet noExtField noHsTok let_binds noHsTok (L gen case_expr) case_expr :: HsExpr GhcRn - case_expr = HsCase noExtField record_expr (mkMatchGroup Generated (wrapGenSpan matches)) + case_expr = HsCase noExtField record_expr (mkMatchGroup (Generated OtherExpansion) (wrapGenSpan matches)) matches :: [LMatch GhcRn (LHsExpr GhcRn)] matches = map make_pat relevant_cons ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -79,7 +79,7 @@ import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name import GHC.Types.Id import GHC.Types.SrcLoc -import GHC.Types.Basic (Origin (..)) +import GHC.Types.Basic (Origin (..), GenReason (..)) import qualified GHC.LanguageExtensions as LangExt import Control.Monad @@ -1256,7 +1256,7 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) expand_stmts <- expand_do_stmts do_or_lc lstmts return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ e - , mkHsLam [pat] (noLocA $ PopSrcSpan expand_stmts) -- (\ x -> stmts') + , mkHsLamDoExp [pat] (noLocA $ PopSrcSpan expand_stmts) -- (\ x -> stmts') ] expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = @@ -1298,7 +1298,7 @@ expand_do_stmts do_or_lc do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) - , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> + , mkHsLamDoExp [ mkBigLHsVarPatTup all_ids ] -- (\ x -> (noLocA $ PopSrcSpan expand_stmts) -- stmts') ] where @@ -1316,7 +1316,7 @@ expand_do_stmts do_or_lc do_block :: LHsExpr GhcRn do_block = wrapGenSpan $ HsDo noExtField (DoExpr Nothing) $ do_stmts mfix_expr :: LHsExpr GhcRn - mfix_expr = mkHsLam [ wrapGenSpan (LazyPat noExtField $ mkBigLHsVarPatTup all_ids) ] $ do_block + mfix_expr = mkHsLamDoExp [ wrapGenSpan (LazyPat noExtField $ mkBigLHsVarPatTup all_ids) ] $ do_block -- LazyPat becuase we do not want to eagerly evaluate the pattern -- and potentially loop forever @@ -1391,7 +1391,7 @@ mk_failable_lexpr_tcm pat lexpr fail_op = ; if b -- don't decorate with fail statement if -- 1) the pattern is irrefutable - then return $ mkHsLam [pat] (noLocA (PopSrcSpan lexpr)) + then return $ mkHsLamDoExp [pat] (noLocA (PopSrcSpan lexpr)) else mk_fail_lexpr pat lexpr fail_op } @@ -1401,7 +1401,7 @@ mk_failable_lexpr_tcm pat lexpr fail_op = mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ + return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ (noLocA [ mkHsCaseAlt pat (noLocA $ PopSrcSpan lexpr) -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1623,8 +1623,9 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs -- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on type checking +-- does depend on the type environment however isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> TcM Bool -isIrrefutableHsPatRn _ is_strict pat = +isIrrefutableHsPatRn tc_env is_strict pat = do traceTc "isIrrefutableHsPatRn" empty goL pat where @@ -1662,9 +1663,7 @@ isIrrefutableHsPatRn _ is_strict pat = ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon , ppr (isNewTyCon tycon) , ppr (tcHasFixedRuntimeRep tycon)]) - ; let b' = (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon - || tcHasFixedRuntimeRep tycon) + ; let b' = isJust (tyConSingleDataCon_maybe tycon) ; return (b && b') } id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) (AConLike cl) -> @@ -1676,9 +1675,7 @@ isIrrefutableHsPatRn _ is_strict pat = traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon , ppr (isNewTyCon tycon) , ppr (tcHasFixedRuntimeRep tycon)] ) - let b' = (isJust (tyConSingleDataCon_maybe tycon) - || isNewTyCon tycon - || tcHasFixedRuntimeRep tycon) + let b' = isJust (tyConSingleDataCon_maybe tycon) return (b && b') PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) return False -- conservative ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1961,7 +1961,7 @@ lookupName is_type_name s getThSpliceOrigin :: TcM Origin getThSpliceOrigin = do warn <- goptM Opt_EnableThSpliceWarnings - if warn then return FromSource else return Generated + if warn then return FromSource else return (Generated OtherExpansion) getThing :: TH.Name -> TcM TcTyThing ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -2166,7 +2166,7 @@ mkDefMethBind loc dfun_id clas sel_id dm_name , tyConBinderForAllTyFlag tcb /= Inferred ] rhs = foldl' mk_vta (nlHsVar dm_name) visible_inst_tys bind = L (noAnnSrcSpan loc) - $ mkTopFunBind Generated fn + $ mkTopFunBind (Generated OtherExpansion) fn [mkSimpleMatch (mkPrefixFunRhs fn) [] rhs] ; liftIO (putDumpFileMaybe logger Opt_D_dump_deriv "Filling in method body" @@ -2410,4 +2410,3 @@ instDeclCtxt2 dfun_ty inst_decl_ctxt :: SDoc -> SDoc inst_decl_ctxt doc = hang (text "In the instance declaration for") 2 (quotes doc) - ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -811,13 +811,13 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn L (getLoc lpat) $ HsCase noExtField (nlHsVar scrutinee) $ MG{ mg_alts = L (l2l $ getLoc lpat) cases - , mg_ext = MatchGroupTc [unrestricted pat_ty] res_ty Generated + , mg_ext = MatchGroupTc [unrestricted pat_ty] res_ty (Generated OtherExpansion) } body' = noLocA $ HsLam noExtField $ MG{ mg_alts = noLocA [mkSimpleMatch LambdaExpr args body] - , mg_ext = MatchGroupTc (map unrestricted [pat_ty, cont_ty, fail_ty]) res_ty Generated + , mg_ext = MatchGroupTc (map unrestricted [pat_ty, cont_ty, fail_ty]) res_ty (Generated OtherExpansion) } match = mkMatch (mkPrefixFunRhs (L loc (idName patsyn_id))) [] (mkHsLams (rr_tv:res_tv:univ_tvs) @@ -825,7 +825,7 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn (EmptyLocalBinds noExtField) mg :: MatchGroup GhcTc (LHsExpr GhcTc) mg = MG{ mg_alts = L (l2l $ getLoc match) [match] - , mg_ext = MatchGroupTc [] res_ty Generated + , mg_ext = MatchGroupTc [] res_ty (Generated OtherExpansion) } matcher_arity = length req_theta + 3 -- See Note [Pragmas for pattern synonyms] @@ -958,7 +958,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) Unidirectional -> panic "tcPatSynBuilderBind" mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) - mk_mg body = mkMatchGroup Generated (noLocA [builder_match]) + mk_mg body = mkMatchGroup (Generated OtherExpansion) (noLocA [builder_match]) where builder_args = [L (na2la loc) (VarPat noExtField (L loc n)) | L loc n <- args] ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -928,7 +928,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- make the binding: sel (C2 { fld = x }) = x -- sel (C7 { fld = x }) = x -- where cons_w_field = [C2,C7] - sel_bind = mkTopFunBind Generated sel_lname alts + sel_bind = mkTopFunBind (Generated OtherExpansion) sel_lname alts where alts | is_naughty = [mkSimpleMatch (mkPrefixFunRhs sel_lname) [] unit_rhs] ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -35,7 +35,8 @@ module GHC.Types.Basic ( FunctionOrData(..), RecFlag(..), isRec, isNonRec, boolToRecFlag, - Origin(..), isGenerated, + Origin(..), isGenerated, isDoExpansionGenerated, + GenReason(..), RuleName, pprRuleName, @@ -582,17 +583,29 @@ instance Binary RecFlag where ************************************************************************ -} +data GenReason = DoExpansion + | OtherExpansion + deriving (Eq, Data) + +instance Outputable GenReason where + ppr DoExpansion = text "DoExpansion" + ppr OtherExpansion = text "OtherExpansion" + data Origin = FromSource - | Generated + | Generated GenReason deriving( Eq, Data ) isGenerated :: Origin -> Bool -isGenerated Generated = True +isGenerated (Generated _) = True isGenerated FromSource = False +isDoExpansionGenerated :: Origin -> Bool +isDoExpansionGenerated (Generated DoExpansion) = True +isDoExpansionGenerated _ = False + instance Outputable Origin where ppr FromSource = text "FromSource" - ppr Generated = text "Generated" + ppr (Generated r) = text "Generated" <+> ppr r {- ************************************************************************ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36c56e5c25e0e95d1e155e96e324e109cadfcef0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36c56e5c25e0e95d1e155e96e324e109cadfcef0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 08:24:42 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 08 May 2023 04:24:42 -0400 Subject: [Git][ghc/ghc][wip/T23307] 9 commits: Add structured error messages for GHC.Rename.Utils Message-ID: <6458b1ca3ea5_38ffda2c8eaf54195596@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23307 at Glasgow Haskell Compiler / GHC Commits: 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 00330bbc by Simon Peyton Jones at 2023-05-08T09:26:37+01:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Id/Make.hs - docs/users_guide/exts/ffi.rst - docs/users_guide/using-warnings.rst - ghc/Main.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/deSugar/should_compile/ds053.stderr - testsuite/tests/deriving/should_compile/T13919.stderr - testsuite/tests/driver/t22391/t22391.stderr - testsuite/tests/driver/t22391/t22391j.stderr - testsuite/tests/driver/werror.stderr - testsuite/tests/gadt/T12087.stderr - testsuite/tests/gadt/T14320.stderr - testsuite/tests/gadt/T16427.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2f015689111c7a321063ddce403ba8ddf35b76a...00330bbc4058187033c1f0d989c09b2c807e84da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2f015689111c7a321063ddce403ba8ddf35b76a...00330bbc4058187033c1f0d989c09b2c807e84da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 09:27:22 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 05:27:22 -0400 Subject: [Git][ghc/ghc][wip/T23146] 17 commits: Add structured error messages for GHC.Rename.Utils Message-ID: <6458c07a156c_38ffda30f8e79423021d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - cf76eca0 by Ben Gamari at 2023-05-08T10:27:00+01:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 96bdef3a by Ben Gamari at 2023-05-08T10:27:00+01:00 codeGen: Fix some Haddocks - - - - - 8adcf90e by Ben Gamari at 2023-05-08T10:27:00+01:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 3c6d972e by Rodrigo Mesquita at 2023-05-08T10:27:00+01:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 31a7c8ba by Rodrigo Mesquita at 2023-05-08T10:27:00+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 497895f2 by Rodrigo Mesquita at 2023-05-08T10:27:00+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - b263dd1b by Rodrigo Mesquita at 2023-05-08T10:27:00+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - 9cea6c86 by Rodrigo Mesquita at 2023-05-08T10:27:00+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - 43b82817 by Rodrigo Mesquita at 2023-05-08T10:27:00+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c77f81c87e43b1dd1d34d7c928b323b675cab8c5...43b828178afb8eea69db223181fe2cc70f72a642 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c77f81c87e43b1dd1d34d7c928b323b675cab8c5...43b828178afb8eea69db223181fe2cc70f72a642 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 09:28:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 05:28:49 -0400 Subject: [Git][ghc/ghc][wip/T23146] 4 commits: Update Note [Core letrec invariant] Message-ID: <6458c0d151cb0_38ffda31907190231885@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: c7160662 by Rodrigo Mesquita at 2023-05-08T10:28:33+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - ab848cfd by Rodrigo Mesquita at 2023-05-08T10:28:36+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - a4f4b294 by Rodrigo Mesquita at 2023-05-08T10:28:36+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - 14358f34 by Rodrigo Mesquita at 2023-05-08T10:28:36+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 10 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,37 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In Core, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist, after CorePrep + only. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConRep`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -209,7 +221,8 @@ Note [Data constructor workers and wrappers] * See Note [Data Constructor Naming] for how the worker and wrapper are named -* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments +* The workers don't take the dcStupidTheta dicts as arguments, while the + wrappers currently do * The wrapper (if it exists) takes dcOrigArgTys as its arguments. The worker takes dataConRepArgTys as its arguments @@ -528,7 +541,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -988,51 +1001,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (mkLFImported) +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -275,7 +275,7 @@ isTagged v = do False -> return $! -- Determine whether it is tagged from the LFInfo of the imported id. -- See Note [The LFInfo of Imported Ids] - case mkLFImported v of + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,52 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After the unarisation pass: +* In `StgConApp` and `StgRhsCon` and `StgAlt` we filter out the void arguments, + leaving only non-void ones. +* In `StgApp` and `StgOpApp` we retain void arguments. + +We can do this because we know that `StgConApp` and `StgRhsCon` are saturated applications, +so we lose no information by dropping those void args. In contrast, in `StgApp` we need the + void argument to compare the number of args in the call with the arity of the function. + +This is an open design choice. We could instead choose to treat all these applications +consistently (keeping the void args). But for some reason we don't, and this Note simply +documents that design choice. + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +291,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -422,7 +468,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] Type -- Type, for rewriting to an StgRhsClosure -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList $! reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -867,7 +869,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1660,9 +1662,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2117,7 +2118,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2125,13 +2126,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2189,8 +2190,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -256,10 +256,10 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- --- | Make a 'LambdaFormInfo' for an imported Id. +-- | The 'LambdaFormInfo' of an imported Id. -- See Note [The LFInfo of Imported Ids] -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of @@ -305,7 +305,7 @@ In particular, saturated data constructor applications *must* be unambiguously given `LFCon`, and if the LFInfo says LFCon, then it really is a static data constructor, and similar for LFReEntrant. -In `mkLFImported`, we construct a LambdaFormInfo for imported Ids as follows: +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: (1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is correct by construction (the invariant being that if it exists, it is correct): ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -149,7 +149,7 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43b828178afb8eea69db223181fe2cc70f72a642...14358f34c34c27d20cc5b676e0b62a069a45d40f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43b828178afb8eea69db223181fe2cc70f72a642...14358f34c34c27d20cc5b676e0b62a069a45d40f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 10:06:37 2023 From: gitlab at gitlab.haskell.org (Cheng Shao (@TerrorJack)) Date: Mon, 08 May 2023 06:06:37 -0400 Subject: [Git][ghc/ghc][wip/T22756] 384 commits: Refresh profiling docs Message-ID: <6458c9ada44e0_38ffda354f8d20264960@gitlab.mail> Cheng Shao pushed to branch wip/T22756 at Glasgow Haskell Compiler / GHC Commits: 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - ae696831 by Ben Gamari at 2023-05-08T10:06:23+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/534b46b51175aa06d7db199316bd866298159a32...ae696831d39a288c0f4849e4f93dfed117e2092b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/534b46b51175aa06d7db199316bd866298159a32...ae696831d39a288c0f4849e4f93dfed117e2092b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 10:45:49 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 08 May 2023 06:45:49 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <6458d2ddaad5_38ffda3919fb8428484d@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 47e635e7 by Josh Meredith at 2023-05-08T10:45:33+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 9 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,13 +6,15 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS , identsV , identsE -- * Saturation - , jsSaturate + , satJStat + , satJExpr -- * Generic traversal (via compos) , JMacro(..) , JMGadt(..) @@ -21,8 +23,6 @@ module GHC.JS.Transform , composOpM , composOpM_ , composOpFold - , satJExpr - , satJStat ) where @@ -33,11 +33,12 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) +import Data.List (sortBy) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique.Map +import GHC.Types.Unique.FM {-# INLINE identsS #-} @@ -200,66 +201,59 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) +satJStat :: Maybe FastString -> JStat -> Sat.JStat +satJStat str x = evalState (jsSaturateS x) (newIdentSupply str) + +satJExpr :: Maybe FastString -> JExpr -> Sat.JExpr +satJExpr str x = evalState (jsSaturateE x) (newIdentSupply str) + +jsSaturateS :: JStat -> State [Ident] Sat.JStat +jsSaturateS = \case + DeclStat i rhs -> Sat.DeclStat i <$> mapM jsSaturateE rhs + ReturnStat e -> Sat.ReturnStat <$> jsSaturateE e + IfStat c t e -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e + WhileStat is_do c e -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e + ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body + SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct + <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps + <*> jsSaturateS def + TryStat t i c f -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f + BlockStat bs -> fmap Sat.BlockStat $! mapM jsSaturateS bs + ApplStat rator rand -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand + UOpStat rator rand -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand + AssignStat lhs rhs -> Sat.AssignStat <$> jsSaturateE lhs <*> jsSaturateE rhs + LabelStat lbl stmt -> Sat.LabelStat lbl <$> jsSaturateS stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + UnsatBlock us -> jsSaturateS =<< runIdentSupply us + +jsSaturateE :: JExpr -> State [Ident] Sat.JExpr +jsSaturateE = \case + ValExpr v -> Sat.ValExpr <$> jsSaturateV v + SelExpr obj i -> Sat.SelExpr <$> jsSaturateE obj <*> pure i + IdxExpr o i -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i + InfixExpr op l r -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r + UOpExpr op r -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r + IfExpr c t e -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e + ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands + UnsatExpr us -> jsSaturateE =<< runIdentSupply us + +jsSaturateV :: JVal -> State [Ident] Sat.JVal +jsSaturateV = \case + JVar i -> return $ Sat.JVar i + JList xs -> Sat.JList <$> mapM jsSaturateE xs + JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) + JInt i -> return $ Sat.JInt i + JStr s -> return $ Sat.JStr s + JRegEx f -> return $ Sat.JRegEx f + JHash m -> Sat.JHash <$> mapUniqMapM satHash m where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v - - --------------------------------------------------------------------------------- --- Translation --- --- This will be moved after GHC.JS.Syntax is removed --------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - - -satJExpr :: JExpr -> Sat.JExpr -satJExpr = go - where - go (ValExpr v) = Sat.ValExpr (satJVal v) - go (SelExpr obj i) = Sat.SelExpr (satJExpr obj) i - go (IdxExpr o i) = Sat.IdxExpr (satJExpr o) (satJExpr i) - go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r) - go (UOpExpr op r) = Sat.UOpExpr (satJUOp op) (satJExpr r) - go (IfExpr c t e) = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e) - go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands) - go UnsatExpr{} = error "satJExpr: discovered an Unsat...impossibly" + satHash (i, x) = (i,) . (i,) <$> jsSaturateE x + compareHash (i,_) (j,_) = lexicalCompareFS i j + -- By lexically sorting the elements, the non-determinism introduced by nonDetEltsUFM is avoided + mapUniqMapM f (UniqMap m) = UniqMap . listToUFM <$> (mapM f . sortBy compareHash $ nonDetEltsUFM m) + JFunc args body -> Sat.JFunc args <$> jsSaturateS body + UnsatVal us -> jsSaturateV =<< runIdentSupply us satJOp :: JOp -> Sat.Op satJOp = go @@ -305,15 +299,3 @@ satJUOp = go go PreDecOp = Sat.PreDecOp go PostDecOp = Sat.PostDecOp -satJVal :: JVal -> Sat.JVal -satJVal = go - where - go (JVar i) = Sat.JVar i - go (JList xs) = Sat.JList (satJExpr <$> xs) - go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) - go (JInt i) = Sat.JInt i - go (JStr f) = Sat.JStr f - go (JRegEx f) = Sat.JRegEx f - go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) - go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,8 +134,7 @@ genUnits m ss spt_entries foreign_stubs = do staticInit <- initStaticPtrs spt_entries let stat = ( -- O.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m 1) + satJStat (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] let oi = ObjUnit @@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = satJStat (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -246,8 +245,7 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = -- Opt.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m n) + satJStat (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps let oi = ObjUnit @@ -336,7 +334,7 @@ genToplevelRhs i rhs = case rhs of eid@(TxtI eidt) <- identForEntryId i (TxtI idt) <- identForId i body <- genBody (initExprCtx i) R2 args body typ - global_occs <- globalOccs (jsSaturate (Just "ghcjs_tmp_sat_") body) + global_occs <- globalOccs (satJStat (Just "ghcjs_tmp_sat_") body) let lidents = map global_ident global_occs let lids = map global_id global_occs let lidents' = map identFS lidents ===================================== compiler/GHC/StgToJS/CoreUtils.hs ===================================== @@ -253,7 +253,7 @@ assocPrimReps (r:rs) vs = case (primRepSize r,vs) of (NoSlot, xs) -> (r,[]) : assocPrimReps rs xs (OneSlot, x:xs) -> (r,[x]) : assocPrimReps rs xs (TwoSlots, x:y:xs) -> (r,[x,y]) : assocPrimReps rs xs - err -> pprPanic "assocPrimReps" (ppr $ fmap (map satJExpr) $ err) + err -> pprPanic "assocPrimReps" (ppr $ map (satJExpr Nothing) <$> err) -- | Associate the given values to the Id's PrimReps, taking into account the -- number of slots per PrimRep ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -60,8 +60,8 @@ genCon ctx con args | xs <- concatMap typex_expr (ctxTarget ctx) = pprPanic "genCon: unhandled DataCon" (ppr (con - , fmap satJExpr args - , fmap satJExpr xs + , satJExpr Nothing <$> args + , satJExpr Nothing <$> xs )) -- | Allocate a data constructor. Allocate in this context means bind the data @@ -90,7 +90,7 @@ allocUnboxedCon con = \case | isBoolDataCon con && dataConTag con == 2 -> true_ [x] | isUnboxableCon con -> x - xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, fmap satJExpr xs)) + xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, satJExpr Nothing <$> xs)) -- | Allocate an entry function. See 'GHC.StgToJS.hs' for the object layout. allocDynamicE :: Bool -- ^ csInlineAlloc from StgToJSConfig ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -900,7 +900,7 @@ caseCond = \case DataAlt da -> return $ Just (toJExpr $ dataConTag da) LitAlt l -> genLit l >>= \case [e] -> pure (Just e) - es -> pprPanic "caseCond: expected single-variable literal" (ppr $ fmap satJExpr es) + es -> pprPanic "caseCond: expected single-variable literal" (ppr $ satJExpr Nothing <$> es) -- fixme use single tmp var for all branches -- | Load parameters from constructor ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,8 +177,8 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a -saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) +saturateFFI :: Int -> JStat -> Sat.JStat +saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack => ExprCtx ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (satJStat Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,8 +299,8 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat -rtsDecls = jsSaturate (Just "h$RTSD") $ +rtsDecls :: Sat.JStat +rtsDecls = satJStat (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -314,15 +315,15 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat -rts = jsSaturate (Just "h$RTS") . rts' +rts :: StgToJSConfig -> Sat.JStat +rts = satJStat (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47e635e7b1a24e359ddd914086757b6b6640cc7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47e635e7b1a24e359ddd914086757b6b6640cc7c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 10:53:24 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 08 May 2023 06:53:24 -0400 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] 69 commits: Convert interface file loading errors into proper diagnostics Message-ID: <6458d4a4913e_38ffda3a5a2078294781@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - a630796b by Josh Meredith at 2023-05-08T10:49:53+00:00 Replace the implementation of CodeBuffers with unboxed types - - - - - f0270a3e by Josh Meredith at 2023-05-08T10:49:53+00:00 Use unboxed codebuffers in base - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb1588f66317282deeaf3d3910c17b25b8ff6b0b...f0270a3eea9892bfa80757538ed9e332383366e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb1588f66317282deeaf3d3910c17b25b8ff6b0b...f0270a3eea9892bfa80757538ed9e332383366e0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 11:17:58 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 07:17:58 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ROMES: WIP Message-ID: <6458da66f1706_38ffda3cf94c50308720@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: e0c7fdc8 by Rodrigo Mesquita at 2023-05-08T12:17:50+01:00 ROMES: WIP - - - - - 20 changed files: - hadrian/cfg/system.config.in - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/RunTest.hs - m4/fp_settings.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Nm.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ranlib.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Readelf.hs Changes: ===================================== hadrian/cfg/system.config.in ===================================== @@ -131,6 +131,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] +gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ===================================== hadrian/src/Hadrian/Oracles/TextFile.hs ===================================== @@ -1,4 +1,6 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- Orphan instances for Toolchain.Target {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Hadrian.Oracles.TextFile @@ -13,7 +15,8 @@ module Hadrian.Oracles.TextFile ( lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupSystemConfig, lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, textFileOracle, - getHostTargetConfig, getTargetTargetConfig + getHostTargetConfig, getTargetTargetConfig, + queryHostTargetConfig, queryTargetTargetConfig ) where import Control.Monad @@ -97,6 +100,12 @@ getHostTargetConfig = getTargetConfig hostTargetFile getTargetTargetConfig :: Action Toolchain.Target getTargetTargetConfig = getTargetConfig targetTargetFile +queryHostTargetConfig :: (Toolchain.Target -> String) -> Action String +queryHostTargetConfig f = f <$> getHostTargetConfig + +queryTargetTargetConfig :: (Toolchain.Target -> String) -> Action String +queryTargetTargetConfig f = f <$> getTargetTargetConfig + newtype KeyValue = KeyValue (FilePath, String) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) type instance RuleResult KeyValue = Maybe String @@ -143,21 +152,16 @@ textFileOracle = do putVerbose $ "| TargetFile oracle: reading " ++ quote file ++ "..." target <- read <$> readFile' file return (target :: Toolchain.Target) - void $ addOracle $ \(TargetFile file) -> tf file + void $ addOracleCache $ \(TargetFile file) -> tf file --- ROMES:TODO: get back to this!!!!!! -instance Eq Toolchain.Target where - (==) _ _ = True +-- Orphan instances for (ShakeValue Toolchain.Target) +instance Binary Toolchain.Target where + put = put . show + get = read <$> get -instance Ord Toolchain.Target where - (<=) _ _ = False instance Hashable Toolchain.Target where - hashWithSalt _ _ = 0 -instance Binary Toolchain.Target where - put _ = undefined - get = undefined + hashWithSalt s = hashWithSalt s . show instance NFData Toolchain.Target where - rnf _ = () - + rnf = flip seq () -- ROMES:TODO: Is this a good enough instance? ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -55,6 +55,9 @@ data FlagKey = SystemConfigKey String -- fragile, but some flags do behave like this. flag :: Flag -> Action Bool flag f = do + -- ROMES:TODO: Use queryToolchainConfig directly, which perhaps allows us + -- to get rid of the Oracle for the whole toolchain, which requires weak + -- orphan instances. let flagkey :: FlagKey = case f of ArSupportsAtFile -> TargetTargetKey (Toolchain.arSupportsAtFile . tgtAr) ArSupportsDashL -> TargetTargetKey (Toolchain.arSupportsDashL . tgtAr) @@ -100,7 +103,7 @@ getFlag = expr . flag -- when appropriate). platformSupportsGhciObjects :: Action Bool platformSupportsGhciObjects = - not . null <$> settingsFileSetting SettingsFileSetting_MergeObjectsCommand + not . null <$> settingsFileSetting ToolchainSetting_MergeObjectsCommand arSupportsDashL :: Stage -> Action Bool arSupportsDashL (Stage0 {}) = flag SystemArSupportsDashL ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -3,7 +3,7 @@ module Oracles.Setting ( -- * Settings Setting (..), SettingList (..), setting, settingList, getSetting, getSettingList, - SettingsFileSetting (..), settingsFileSetting, + ToolchainSetting (..), settingsFileSetting, -- * Helpers ghcCanonVersion, cmdLineLengthLimit, hostSupportsRPaths, topDirectory, @@ -23,6 +23,9 @@ import Hadrian.Oracles.Path import Base +import GHC.Toolchain +import GHC.Toolchain.Program + -- | Each 'Setting' comes from the file @hadrian/cfg/system.config@, generated -- by the @configure@ script from the input file @hadrian/cfg/system.config.in at . -- For example, the line @@ -103,32 +106,32 @@ data SettingList = ConfCcArgs Stage -- from aclocal.m4 whenever they can be calculated from other variables -- already fed into Hadrian. --- | Each 'SettingsFileSetting' is defined by 'FP_SETTINGS' in aclocal.m4. --- Eventually much of that local can probably be computed just in Hadrian. -data SettingsFileSetting - = SettingsFileSetting_CCompilerCommand - | SettingsFileSetting_CxxCompilerCommand - | SettingsFileSetting_HaskellCPPCommand - | SettingsFileSetting_HaskellCPPFlags - | SettingsFileSetting_CCompilerFlags - | SettingsFileSetting_CxxCompilerFlags - | SettingsFileSetting_CCompilerLinkFlags - | SettingsFileSetting_CCompilerSupportsNoPie - | SettingsFileSetting_LdCommand - | SettingsFileSetting_LdFlags - | SettingsFileSetting_MergeObjectsCommand - | SettingsFileSetting_MergeObjectsFlags - | SettingsFileSetting_ArCommand - | SettingsFileSetting_RanlibCommand - | SettingsFileSetting_OtoolCommand - | SettingsFileSetting_InstallNameToolCommand - | SettingsFileSetting_DllWrapCommand - | SettingsFileSetting_WindresCommand - | SettingsFileSetting_TouchCommand - | SettingsFileSetting_ClangCommand - | SettingsFileSetting_LlcCommand - | SettingsFileSetting_OptCommand - | SettingsFileSetting_DistroMinGW +-- | All 'ToolchainSetting's are computed by the ghc-toolchain utility for configuring toolchains. +-- This used to be defined by 'FP_SETTINGS' in aclocal.m4. +data ToolchainSetting + = ToolchainSetting_CCompilerCommand + | ToolchainSetting_CxxCompilerCommand + | ToolchainSetting_HaskellCPPCommand + | ToolchainSetting_HaskellCPPFlags + | ToolchainSetting_CCompilerFlags + | ToolchainSetting_CxxCompilerFlags + | ToolchainSetting_CCompilerLinkFlags + | ToolchainSetting_CCompilerSupportsNoPie + | ToolchainSetting_LdCommand + | ToolchainSetting_LdFlags + | ToolchainSetting_MergeObjectsCommand + | ToolchainSetting_MergeObjectsFlags + | ToolchainSetting_ArCommand + | ToolchainSetting_RanlibCommand + | ToolchainSetting_OtoolCommand + | ToolchainSetting_InstallNameToolCommand + | ToolchainSetting_DllWrapCommand + | ToolchainSetting_WindresCommand + | ToolchainSetting_TouchCommand + | ToolchainSetting_ClangCommand + | ToolchainSetting_LlcCommand + | ToolchainSetting_OptCommand + | ToolchainSetting_DistroMinGW -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the -- result. @@ -202,31 +205,36 @@ settingList key = fmap words $ lookupSystemConfig $ case key of -- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the -- result. -- See Note [tooldir: How GHC finds mingw on Windows] -settingsFileSetting :: SettingsFileSetting -> Action String -settingsFileSetting key = lookupSystemConfig $ case key of - SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" - SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" - SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" - SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" - SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" - SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" - SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" - SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" - SettingsFileSetting_LdCommand -> "settings-ld-command" - SettingsFileSetting_LdFlags -> "settings-ld-flags" - SettingsFileSetting_MergeObjectsCommand -> "settings-merge-objects-command" - SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" - SettingsFileSetting_ArCommand -> "settings-ar-command" - SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" - SettingsFileSetting_OtoolCommand -> "settings-otool-command" - SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" - SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" - SettingsFileSetting_WindresCommand -> "settings-windres-command" - SettingsFileSetting_TouchCommand -> "settings-touch-command" - SettingsFileSetting_ClangCommand -> "settings-clang-command" - SettingsFileSetting_LlcCommand -> "settings-llc-command" - SettingsFileSetting_OptCommand -> "settings-opt-command" - SettingsFileSetting_DistroMinGW -> "settings-use-distro-mingw" +settingsFileSetting :: ToolchainSetting -> Action String +settingsFileSetting key = case key of + ToolchainSetting_CCompilerCommand -> queryHostTargetConfig (cmd . ccProgram . tgtCCompiler) + ToolchainSetting_CxxCompilerCommand -> queryHostTargetConfig (cmd . cxxProgram . tgtCxxCompiler) + ToolchainSetting_HaskellCPPCommand -> queryHostTargetConfig (cmd . cppProgram . tgtCPreprocessor) + ToolchainSetting_HaskellCPPFlags -> queryHostTargetConfig (flags . cppProgram . tgtCPreprocessor) + ToolchainSetting_CCompilerFlags -> queryHostTargetConfig (flags . ccProgram . tgtCCompiler) + ToolchainSetting_CxxCompilerFlags -> queryHostTargetConfig (flags . cxxProgram . tgtCxxCompiler) + ToolchainSetting_CCompilerLinkFlags -> queryHostTargetConfig (flags . ccLinkProgram . tgtCCompilerLink) + ToolchainSetting_CCompilerSupportsNoPie -> queryHostTargetConfig (yesNo . ccLinkSupportsNoPie . tgtCCompilerLink) + -- ROMES:TODO: What's the difference between the Ld and CCLink? + ToolchainSetting_LdCommand -> lookupSystemConfig "settings-ld-command" + ToolchainSetting_LdFlags -> lookupSystemConfig "settings-ld-flags" + ToolchainSetting_MergeObjectsCommand -> queryHostTargetConfig (maybe "" (cmd . mergeObjsProgram) . tgtMergeObjs) + ToolchainSetting_MergeObjectsFlags -> queryHostTargetConfig (maybe "" (flags . mergeObjsProgram) . tgtMergeObjs) + ToolchainSetting_ArCommand -> queryHostTargetConfig (cmd . arMkArchive . tgtAr) + ToolchainSetting_RanlibCommand -> queryHostTargetConfig (maybe "" (cmd . ranlibProgram) . tgtRanlib) + ToolchainSetting_OtoolCommand -> lookupSystemConfig "settings-otool-command" + ToolchainSetting_InstallNameToolCommand -> lookupSystemConfig "settings-install_name_tool-command" + ToolchainSetting_DllWrapCommand -> queryHostTargetConfig (maybe "" cmd . tgtDllwrap) + ToolchainSetting_WindresCommand -> queryHostTargetConfig (maybe "" cmd . tgtWindres) + ToolchainSetting_TouchCommand -> lookupSystemConfig "settings-touch-command" + ToolchainSetting_ClangCommand -> lookupSystemConfig "settings-clang-command" + ToolchainSetting_LlcCommand -> lookupSystemConfig "settings-llc-command" + ToolchainSetting_OptCommand -> lookupSystemConfig "settings-opt-command" + -- ROMES:TODO: affter handling DistroMinGW and aboves in ghc-toolchain, factor queryHostTargetConfig out + ToolchainSetting_DistroMinGW -> lookupSystemConfig "settings-use-distro-mingw" -- ROMES:TODO: This option doesn't seem to be in ghc-toolchain yet + where + flags = unwords . prgFlags + cmd = prgPath -- | An expression that looks up the value of a 'Setting' in @cfg/system.config@, -- tracking the result. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -9,7 +9,7 @@ import qualified Data.Set as Set import Base import qualified Context import Expression -import Hadrian.Oracles.TextFile (lookupSystemConfig) +import Hadrian.Oracles.TextFile (lookupSystemConfig, queryHostTargetConfig) import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting @@ -21,6 +21,9 @@ import Settings import Target import Utilities +import qualified GHC.Toolchain as Toolchain +import GHC.Toolchain.Program (prgFlags) + -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () trackGenerateHs = expr $ need [sourcePath -/- "Rules/Generate.hs"] @@ -411,32 +414,32 @@ generateSettings = do ctx <- getContext settings <- traverse sequence $ [ ("GCC extra via C opts", expr $ lookupSystemConfig "gcc-extra-via-c-opts") - , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) - , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) - , ("C++ compiler command", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerCommand) - , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) - , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) - , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) - , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) - , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) - , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) - , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) + , ("C compiler command", expr $ settingsFileSetting ToolchainSetting_CCompilerCommand) + , ("C compiler flags", expr $ settingsFileSetting ToolchainSetting_CCompilerFlags) + , ("C++ compiler command", expr $ settingsFileSetting ToolchainSetting_CxxCompilerCommand) + , ("C++ compiler flags", expr $ settingsFileSetting ToolchainSetting_CxxCompilerFlags) + , ("C compiler link flags", expr $ settingsFileSetting ToolchainSetting_CCompilerLinkFlags) + , ("C compiler supports -no-pie", expr $ settingsFileSetting ToolchainSetting_CCompilerSupportsNoPie) + , ("Haskell CPP command", expr $ settingsFileSetting ToolchainSetting_HaskellCPPCommand) + , ("Haskell CPP flags", expr $ settingsFileSetting ToolchainSetting_HaskellCPPFlags) + , ("ld command", expr $ settingsFileSetting ToolchainSetting_LdCommand) + , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") - , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) - , ("Merge objects flags", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsFlags) - , ("ar command", expr $ settingsFileSetting SettingsFileSetting_ArCommand) - , ("ar flags", expr $ lookupSystemConfig "ar-args") + , ("Merge objects command", expr $ settingsFileSetting ToolchainSetting_MergeObjectsCommand) + , ("Merge objects flags", expr $ settingsFileSetting ToolchainSetting_MergeObjectsFlags) + , ("ar command", expr $ settingsFileSetting ToolchainSetting_ArCommand) + , ("ar flags", expr $ queryHostTargetConfig (unwords . prgFlags . Toolchain.arMkArchive . Toolchain.tgtAr)) , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ar supports -L", expr $ yesNo <$> flag ArSupportsDashL) - , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) - , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) - , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) - , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) - , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) - , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) + , ("ranlib command", expr $ settingsFileSetting ToolchainSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting ToolchainSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting ToolchainSetting_InstallNameToolCommand) + , ("touch command", expr $ settingsFileSetting ToolchainSetting_TouchCommand) + , ("dllwrap command", expr $ settingsFileSetting ToolchainSetting_DllWrapCommand) + , ("windres command", expr $ settingsFileSetting ToolchainSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) , ("target platform string", getSetting TargetPlatform) @@ -451,10 +454,10 @@ generateSettings = do , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) - , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand) - , ("LLVM opt command", expr $ settingsFileSetting SettingsFileSetting_OptCommand) - , ("LLVM clang command", expr $ settingsFileSetting SettingsFileSetting_ClangCommand) - , ("Use inplace MinGW toolchain", expr $ settingsFileSetting SettingsFileSetting_DistroMinGW) + , ("LLVM llc command", expr $ settingsFileSetting ToolchainSetting_LlcCommand) + , ("LLVM opt command", expr $ settingsFileSetting ToolchainSetting_OptCommand) + , ("LLVM clang command", expr $ settingsFileSetting ToolchainSetting_ClangCommand) + , ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) , ("Support SMP", expr $ yesNo <$> targetSupportsSMP) ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -229,8 +229,8 @@ testRules = do [ "--interactive", "-v0", "-ignore-dot-ghci" , "-fno-ghci-history" ] - ccPath <- settingsFileSetting SettingsFileSetting_CCompilerCommand - ccFlags <- settingsFileSetting SettingsFileSetting_CCompilerFlags + ccPath <- settingsFileSetting ToolchainSetting_CCompilerCommand + ccFlags <- settingsFileSetting ToolchainSetting_CCompilerFlags pythonPath <- builderPath Python ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -124,7 +124,7 @@ inTreeCompilerArgs stg = do platform <- setting TargetPlatform wordsize <- (show @Int . (*8) . read) <$> setting TargetWordSize - llc_cmd <- settingsFileSetting SettingsFileSetting_LlcCommand + llc_cmd <- settingsFileSetting ToolchainSetting_LlcCommand have_llvm <- liftIO (isJust <$> findExecutable llc_cmd) top <- topDirectory ===================================== m4/fp_settings.m4 ===================================== @@ -1,6 +1,7 @@ # FP_SETTINGS # ---------------------------------- # Set the variables used in the settings file +# ROMES:TODO: Make this file obsolete AC_DEFUN([FP_SETTINGS], [ SettingsUseDistroMINGW="$EnableDistroToolchain" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -14,7 +14,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ - Main -o acghc-toolchain + utils/ghc-toolchain/Main.hs -o acghc-toolchain rm -f acargs echo "--triple=$target" >> acargs ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Toolchain.Utils data Program = Program { prgPath :: FilePath , prgFlags :: [String] } - deriving (Show, Read) + deriving (Show, Read, Eq, Ord) _prgPath :: Lens Program FilePath _prgPath = Lens prgPath (\x o -> o {prgPath = x}) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -15,10 +15,10 @@ import GHC.Toolchain.Tools.Nm import GHC.Toolchain.Tools.MergeObjs data WordSize = WS4 | WS8 - deriving (Show, Read) + deriving (Show, Read, Eq, Ord) data Endianness = LittleEndian | BigEndian - deriving (Show, Read) + deriving (Show, Read, Eq, Ord) -- | A 'Target' consists of: -- @@ -63,4 +63,5 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Show, Read) + deriving (Show, Read, Eq, Ord) + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -17,7 +17,7 @@ data Ar = Ar { arMkArchive :: Program , arSupportsDashL :: Bool , arNeedsRanlib :: Bool } - deriving (Show, Read) + deriving (Show, Read, Eq, Ord) findAr :: ProgOpt -> M Ar findAr progOpt = checking "for 'ar'" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -19,9 +19,9 @@ import GHC.Toolchain.Prelude import GHC.Toolchain.Utils import GHC.Toolchain.Program -data Cc = Cc { ccProgram :: Program - } - deriving (Show, Read) +newtype Cc = Cc { ccProgram :: Program + } + deriving (Show, Read, Eq, Ord) _ccProgram :: Lens Cc Program _ccProgram = Lens ccProgram (\x o -> o{ccProgram=x}) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -9,9 +9,9 @@ import GHC.Toolchain.Program import GHC.Toolchain.Tools.Cc -data Cpp = Cpp { cppProgram :: Program - } - deriving (Show, Read) +newtype Cpp = Cpp { cppProgram :: Program + } + deriving (Show, Read, Eq, Ord) findCpp :: ProgOpt -> Cc -> M Cpp findCpp progOpt cc ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs ===================================== @@ -8,9 +8,9 @@ module GHC.Toolchain.Tools.Cxx import GHC.Toolchain.Prelude import GHC.Toolchain.Program -data Cxx = Cxx { cxxProgram :: Program - } - deriving (Show, Read) +newtype Cxx = Cxx { cxxProgram :: Program + } + deriving (Show, Read, Eq, Ord) findCxx :: ProgOpt -> M Cxx findCxx progOpt = checking "for C++ compiler" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -20,7 +20,7 @@ import GHC.Toolchain.Tools.Readelf data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsNoPie :: Bool } - deriving (Show, Read) + deriving (Show, Read, Eq, Ord) findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -17,9 +17,9 @@ import GHC.Toolchain.Tools.Link import GHC.Toolchain.Tools.Nm -- | Configuration on how the C compiler can be used to link -data MergeObjs = MergeObjs { mergeObjsProgram :: Program - } - deriving (Show, Read) +newtype MergeObjs = MergeObjs { mergeObjsProgram :: Program + } + deriving (Show, Read, Eq, Ord) findMergeObjs :: ProgOpt -> Cc -> CcLink -> Nm -> M MergeObjs findMergeObjs progOpt cc ccLink nm = checking "for linker for merging objects" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Nm.hs ===================================== @@ -8,9 +8,9 @@ import Control.Monad import GHC.Toolchain.Prelude import GHC.Toolchain.Program -data Nm = Nm { nmProgram :: Program - } - deriving (Show, Read) +newtype Nm = Nm { nmProgram :: Program + } + deriving (Show, Read, Eq, Ord) findNm :: ProgOpt -> M Nm findNm progOpt = checking "for 'nm'" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ranlib.hs ===================================== @@ -8,9 +8,9 @@ module GHC.Toolchain.Tools.Ranlib import GHC.Toolchain.Prelude import GHC.Toolchain.Program -data Ranlib = Ranlib { ranlibProgram :: Program - } - deriving (Show, Read) +newtype Ranlib = Ranlib { ranlibProgram :: Program + } + deriving (Show, Read, Eq, Ord) findRanlib :: ProgOpt -> M Ranlib findRanlib progOpt = checking "for 'ranlib'" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Readelf.hs ===================================== @@ -8,8 +8,8 @@ import Control.Monad import GHC.Toolchain.Prelude import GHC.Toolchain.Program -data Readelf = Readelf { readelfProgram :: Program - } +newtype Readelf = Readelf { readelfProgram :: Program + } deriving (Show, Read) -- | Readelf is only needed by 'GHC.Toolchain.Tools.Link.checkBfdCopyBug'. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0c7fdc84f685dd884d0133b4290636136606f02 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0c7fdc84f685dd884d0133b4290636136606f02 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 12:15:37 2023 From: gitlab at gitlab.haskell.org (Cheng Shao (@TerrorJack)) Date: Mon, 08 May 2023 08:15:37 -0400 Subject: [Git][ghc/ghc][wip/T22756] rts: Fix data-race in hs_init_ghc Message-ID: <6458e7e9ae403_38ffda42b8ab7c34332e@gitlab.mail> Cheng Shao pushed to branch wip/T22756 at Glasgow Haskell Compiler / GHC Commits: 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 1 changed file: - rts/RtsStartup.c Changes: ===================================== rts/RtsStartup.c ===================================== @@ -68,7 +68,7 @@ #endif // Count of how many outstanding hs_init()s there have been. -static int hs_init_count = 0; +static StgWord hs_init_count = 0; static bool rts_shutdown = false; #if defined(mingw32_HOST_OS) @@ -242,8 +242,9 @@ hs_init_with_rtsopts(int *argc, char **argv[]) void hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) { - hs_init_count++; - if (hs_init_count > 1) { + // N.B. atomic_inc returns the new value. + StgWord init_count = atomic_inc(&hs_init_count, 1); + if (init_count > 1) { // second and subsequent inits are ignored return; } @@ -452,15 +453,17 @@ hs_exit_(bool wait_foreign) { uint32_t g, i; - if (hs_init_count <= 0) { - errorBelch("warning: too many hs_exit()s"); + // N.B. atomic_dec returns the new value. + StgInt init_count = (StgInt)atomic_dec(&hs_init_count); + if (init_count > 0) { + // ignore until it's the last one return; } - hs_init_count--; - if (hs_init_count > 0) { - // ignore until it's the last one + if (init_count < 0) { + errorBelch("warning: too many hs_exit()s"); return; } + rts_shutdown = true; /* start timing the shutdown */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e3a6be4023189b2d637beda240e23fa9e856810 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e3a6be4023189b2d637beda240e23fa9e856810 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 12:59:35 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 08:59:35 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Re-introduce flags in hadrian config Message-ID: <6458f237b4432_38ffda474950883723c8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: db50d45e by Rodrigo Mesquita at 2023-05-08T13:31:08+01:00 Re-introduce flags in hadrian config - - - - - c8a95b77 by Rodrigo Mesquita at 2023-05-08T13:59:30+01:00 ROMES WIP - - - - - 4 changed files: - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== hadrian/bindist/config.mk.in ===================================== @@ -234,16 +234,28 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] +GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ LdHasFilelist = @LdHasFilelist@ LdIsGNULd = @LdIsGNULd@ LdHasNoCompactUnwind = @LdHasNoCompactUnwind@ +ArArgs = @ArArgs@ +ArSupportsAtFile = @ArSupportsAtFile@ +ArSupportsDashL = @ArSupportsDashL@ HaskellHostOs = @HaskellHostOs@ HaskellHostArch = @HaskellHostArch@ +HaskellTargetOs = @HaskellTargetOs@ +HaskellTargetArch = @HaskellTargetArch@ +TargetWordSize = @TargetWordSize@ +TargetWordBigEndian = @TargetWordBigEndian@ +TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ +TargetHasIdentDirective = @TargetHasIdentDirective@ +TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ +TablesNextToCode = @TablesNextToCode@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsCxxCompilerCommand = @SettingsCxxCompilerCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -39,7 +39,9 @@ python = @PythonCmd@ # Information about builders: #============================ +ar-supports-at-file = @ArSupportsAtFile@ system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@ +ar-supports-dash-l = @ArSupportsDashL@ system-ar-supports-dash-l = @ArSupportsDashL_STAGE0@ cc-llvm-backend = @CcLlvmBackend@ hs-cpp-args = @HaskellCPPArgs@ @@ -47,8 +49,11 @@ hs-cpp-args = @HaskellCPPArgs@ # Build options: #=============== +ghc-unregisterised = @Unregisterised@ +tables-next-to-code = @TablesNextToCode@ use-libffi-for-adjustors = @UseLibffiForAdjustors@ ghc-source-path = @hardtop@ +leading-underscore = @LeadingUnderscore@ # Information about build, host and target systems: #================================================== @@ -136,6 +141,7 @@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ld-is-gnu-ld = @LdIsGNULd@ +ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ ===================================== hadrian/src/Builder.hs ===================================== @@ -43,6 +43,10 @@ import qualified Data.ByteString as BS import qualified GHC.Foreign as GHC import GHC.ResponseFile +import GHC.Toolchain (Target(..)) +import qualified GHC.Toolchain as Toolchain +import GHC.Toolchain.Program + -- | C compiler can be used in two different modes: -- * Compile or preprocess a source file. -- * Extract source dependencies by passing @-MM@ command line argument. @@ -415,18 +419,18 @@ isOptional = \case systemBuilderPath :: Builder -> Action FilePath systemBuilderPath builder = case builder of Alex -> fromKey "alex" - Ar _ (Stage0 {})-> fromKey "system-ar" - Ar _ _ -> fromKey "ar" + Ar _ (Stage0 {})-> fromHostTC "system-ar" (Toolchain.arMkArchive . tgtAr) + Ar _ _ -> fromTargetTC "ar" (Toolchain.arMkArchive . tgtAr) Autoreconf _ -> stripExe =<< fromKey "autoreconf" - Cc _ (Stage0 {}) -> fromKey "system-cc" - Cc _ _ -> fromKey "cc" + Cc _ (Stage0 {}) -> fromHostTC "system-cc" (Toolchain.ccProgram . tgtCCompiler) + Cc _ _ -> fromTargetTC "cc" (Toolchain.ccProgram . tgtCCompiler) -- We can't ask configure for the path to configure! Configure _ -> return "configure" Ghc _ (Stage0 {}) -> fromKey "system-ghc" GhcPkg _ (Stage0 {}) -> fromKey "system-ghc-pkg" Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" - Ld _ -> fromKey "ld" + Ld _ -> fromTargetTC "ld" (Toolchain.ccLinkProgram . tgtCCompilerLink) -- ROMES:TODO ld vs cLink -- MergeObjects Stage0 is a special case in case of -- cross-compiling. We're building stage1, e.g. code which will be -- executed on the host and hence we need to use host's merge @@ -435,15 +439,15 @@ systemBuilderPath builder = case builder of -- parameters. E.g. building a cross-compiler on and for x86_64 -- which will target ppc64 means that MergeObjects Stage0 will use -- x86_64 linker and MergeObject _ will use ppc64 linker. - MergeObjects (Stage0 {}) -> fromKey "system-merge-objects" - MergeObjects _ -> fromKey "merge-objects" + MergeObjects (Stage0 {}) -> fromHostTC "system-merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs) + MergeObjects _ -> fromTargetTC "merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs) Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" - Nm -> fromKey "nm" + Nm -> fromTargetTC "nm" (Toolchain.nmProgram . tgtNm) Objdump -> fromKey "objdump" Patch -> fromKey "patch" Python -> fromKey "python" - Ranlib -> fromKey "ranlib" + Ranlib -> fromTargetTC "ranlib" (maybeProg Toolchain.ranlibProgram . tgtRanlib) Testsuite _ -> fromKey "python" Sphinx _ -> fromKey "sphinx-build" Tar _ -> fromKey "tar" @@ -459,10 +463,23 @@ systemBuilderPath builder = case builder of let unpack = fromMaybe . error $ "Cannot find path to builder " ++ quote key ++ inCfg ++ " Did you skip configure?" path <- unpack <$> lookupValue configFile key + validate key path + + -- Get program from the host's target configuration + fromHostTC keyname key = do + path <- queryHostTargetConfig (prgPath . key) + validate keyname path + + -- Get program from the target's target configuration + fromTargetTC keyname key = do + path <- queryTargetTargetConfig (prgPath . key) + validate keyname path + + validate keyname path = do if null path then do unless (isOptional builder) . error $ "Non optional builder " - ++ quote key ++ " is not specified" ++ inCfg + ++ quote keyname ++ " is not specified" ++ inCfg return "" -- TODO: Use a safe interface. else do -- angerman: I find this lookupInPath rather questionable. @@ -488,6 +505,8 @@ systemBuilderPath builder = case builder of exists <- doesFileExist s if exists then return s else return sNoExt + maybeProg = maybe (Program "" []) + -- | Was the path to a given system 'Builder' specified in configuration files? isSpecified :: Builder -> Action Bool ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -48,14 +48,14 @@ data Target = Target -- C toolchain , tgtCCompiler :: Cc , tgtCxxCompiler :: Cxx - , tgtCPreprocessor :: Cpp + , tgtCPreprocessor :: Cpp -- ROMES:TODO: Is this hs-cpp or cpp? Do I need both? , tgtCCompilerLink :: CcLink -- , tgtLd :: Program -- needed? -- , tgtLdSupportsCompactUnwind :: Bool -- , tgtLdSupportsFilelist :: Bool -- , tgtLdIsGnuLd :: Bool -- needed? , tgtAr :: Ar - , tgtRanlib :: Maybe Ranlib + , tgtRanlib :: Maybe Ranlib -- why is this marked as maybe? , tgtNm :: Nm , tgtMergeObjs :: Maybe MergeObjs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0c7fdc84f685dd884d0133b4290636136606f02...c8a95b770fa4b1f4eba4ff4c3479f62a1168a4e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0c7fdc84f685dd884d0133b4290636136606f02...c8a95b770fa4b1f4eba4ff4c3479f62a1168a4e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 14:56:21 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 08 May 2023 10:56:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-clock_gettime Message-ID: <64590d9547c1_38ffda4fd3625c4252d@gitlab.mail> Josh Meredith pushed new branch wip/js-clock_gettime at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-clock_gettime You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 14:59:03 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 08 May 2023 10:59:03 -0400 Subject: [Git][ghc/ghc][wip/js-clock_gettime] JS: Implement h$clock_gettime in the JavaScript RTS (#23360) Message-ID: <64590e37b2942_38ffda50a2d8704280d6@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Josh Meredith pushed to branch wip/js-clock_gettime at Glasgow Haskell Compiler / GHC Commits: 8e52b799 by Josh Meredith at 2023-05-08T14:58:42+00:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) [...] Content analysis details: (6.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 BAYES_50 BODY: Bayes spam probability is 40 to 60% [score: 0.4278] 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: "Josh Meredith (@JoshMeredith)" Subject: [Git][ghc/ghc][wip/js-clock_gettime] JS: Implement h$clock_gettime in the JavaScript RTS (#23360) Date: Mon, 08 May 2023 10:59:03 -0400 Size: 54919 URL: From gitlab at gitlab.haskell.org Mon May 8 15:21:00 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 11:21:00 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/target-has-rts-linker Message-ID: <6459135c57660_38ffda51bb8f404408f8@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/target-has-rts-linker You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 15:34:47 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 11:34:47 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] Move "target has RTS linker" out of settings Message-ID: <645916973ed2e_38ffda520e197c445289@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: b4b1644a by Rodrigo Mesquita at 2023-05-08T16:34:37+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Closes #23361 - - - - - 9 changed files: - compiler/GHC/Driver/Session.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -222,6 +222,7 @@ import GHC.Prelude import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile +import GHC.Platform.ArchOS import GHC.UniqueSubdir (uniqueSubdir) import GHC.Unit.Types @@ -4727,8 +4728,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . @@ -4769,6 +4771,23 @@ compilerInfo dflags expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd +-- | Does this target have an RTS linker? +-- Romes: Perhaps not the best place for the function +platformHasRTSLinker :: Platform -> Bool +platformHasRTSLinker p = case platformArchOS p of + -- NO for powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) + ArchPPC -> False -- What about powerpc other than powerpc-ibm-aix*? + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False -- What about s390x other than s390x-ibm-linux? + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + + -- | Get target profile targetProfile :: DynFlags -> Profile targetProfile dflags = Profile (targetPlatform dflags) (ways dflags) ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -451,7 +451,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -126,7 +126,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- romes: Dear reviewer, I'm not sure if it's OK to do this here, but we no + -- longer "know" the information, we can only query either ghc --info, or + -- the test settings (which indirectly queried the ghc --info) + rtsLinker <- getBooleanSetting TestGhcWithRtsLinker return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4b1644ab5081aea5e170740c8ba7f73a71620be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4b1644ab5081aea5e170740c8ba7f73a71620be You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 15:55:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 11:55:49 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] Move "target has RTS linker" out of settings Message-ID: <64591b858e9ed_38ffda538849d04546e3@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: dd67008c by Rodrigo Mesquita at 2023-05-08T16:55:36+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Closes #23361 - - - - - 9 changed files: - compiler/GHC/Driver/Session.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -222,6 +222,7 @@ import GHC.Prelude import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile +import GHC.Platform.ArchOS import GHC.UniqueSubdir (uniqueSubdir) import GHC.Unit.Types @@ -4727,8 +4728,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . @@ -4769,6 +4771,23 @@ compilerInfo dflags expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd +-- | Does this target have an RTS linker? +-- Romes: Perhaps not the best place for the function +platformHasRTSLinker :: Platform -> Bool +-- NO for powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- What about powerpc other than powerpc-ibm-aix*? + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False -- What about s390x other than s390x-ibm-linux? + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + + -- | Get target profile targetProfile :: DynFlags -> Profile targetProfile dflags = Profile (targetPlatform dflags) (ways dflags) ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -451,7 +451,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -126,7 +126,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- romes: Dear reviewer, I'm not sure if it's OK to do this here, but we no + -- longer "know" the information, we can only query either ghc --info, or + -- the test settings (which indirectly queried the ghc --info) + rtsLinker <- getBooleanSetting TestGhcWithRtsLinker return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd67008c610bfc57b8796c8fda9bda5408f83e7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd67008c610bfc57b8796c8fda9bda5408f83e7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 16:21:37 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 12:21:37 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 151 commits: Move "target has RTS linker" out of settings Message-ID: <64592191e1638_38ffda5482991c4633e6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: dd67008c by Rodrigo Mesquita at 2023-05-08T16:55:36+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Closes #23361 - - - - - 142775c8 by Adam Gundry at 2023-05-08T17:15:38+01:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 7bf71fe0 by Adam Gundry at 2023-05-08T17:15:38+01:00 Move mention of warning groups change to 9.8.1 release notes - - - - - cb496562 by Ben Gamari at 2023-05-08T17:15:39+01:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - fab737d9 by Joachim Breitner at 2023-05-08T17:15:39+01:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - b1c8aeb3 by Ben Gamari at 2023-05-08T17:15:39+01:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 45a7d267 by Li-yao Xia at 2023-05-08T17:15:39+01:00 base: Document GHC versions associated with past base versions in the changelog - - - - - a6dc746c by Teo Camarasu at 2023-05-08T17:15:39+01:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - 634562c2 by Teo Camarasu at 2023-05-08T17:15:39+01:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - cd4e2bac by David Feuer at 2023-05-08T17:15:39+01:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - bbcef12d by Ben Gamari at 2023-05-08T17:15:39+01:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 1b36f3f5 by Bodigrim at 2023-05-08T17:15:39+01:00 Improve documentation of atomicModifyMutVar2# - - - - - 1a534de5 by Cheng Shao at 2023-05-08T17:15:39+01:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - a641341e by Cheng Shao at 2023-05-08T17:15:39+01:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 08283d15 by Bodigrim at 2023-05-08T17:15:39+01:00 Improve documentation for resizing of byte arrays - - - - - b508c084 by Ben Gamari at 2023-05-08T17:15:39+01:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - b6ec46f3 by Ben Gamari at 2023-05-08T17:15:39+01:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 47288afe by Ryan Scott at 2023-05-08T17:15:39+01:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - a1c88104 by David Feuer at 2023-05-08T17:15:39+01:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - 41f9a05a by David Feuer at 2023-05-08T17:15:39+01:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - a403d629 by Simon Peyton Jones at 2023-05-08T17:15:39+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 22cf433c by Ryan Scott at 2023-05-08T17:15:39+01:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 8f201d82 by sheaf at 2023-05-08T17:15:39+01:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 567c7a21 by sheaf at 2023-05-08T17:15:39+01:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - 116aa21f by sheaf at 2023-05-08T17:15:39+01:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - ed70b189 by Matthew Pickering at 2023-05-08T17:15:39+01:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - 427efe30 by doyougnu at 2023-05-08T17:15:39+01:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - 4021abd1 by Sylvain Henry at 2023-05-08T17:15:40+01:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - 39e2ba55 by Ben Gamari at 2023-05-08T17:15:40+01:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - e647cdaa by Matthew Pickering at 2023-05-08T17:15:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 68c6b85a by Bodigrim at 2023-05-08T17:15:40+01:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 6a051a86 by Bodigrim at 2023-05-08T17:15:40+01:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7d0b07b5 by Bodigrim at 2023-05-08T17:15:40+01:00 Bump submodules - - - - - 15b6843a by Bodigrim at 2023-05-08T17:15:40+01:00 Fix tests - - - - - 17e080ab by sheaf at 2023-05-08T17:15:40+01:00 Proxies for head and tail: review suggestions - - - - - 5617981e by sheaf at 2023-05-08T17:15:40+01:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - b7cb8226 by sheaf at 2023-05-08T17:15:40+01:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 67a13bb0 by Cheng Shao at 2023-05-08T17:15:40+01:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - 9591669c by Cheng Shao at 2023-05-08T17:15:40+01:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 60a6a47e by Cheng Shao at 2023-05-08T17:15:40+01:00 ci: unset CROSS_EMULATOR for js job - - - - - 7f0d43d9 by Cheng Shao at 2023-05-08T17:15:40+01:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - c0e71664 by Cheng Shao at 2023-05-08T17:15:40+01:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - bdc97430 by Ben Gamari at 2023-05-08T17:15:40+01:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - 30c75532 by Ben Gamari at 2023-05-08T17:15:40+01:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - 913acf78 by Ben Gamari at 2023-05-08T17:15:40+01:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - d97b871b by Cheng Shao at 2023-05-08T17:15:40+01:00 testsuite: don't add optllvm way for wasm32 - - - - - 279a55e8 by Cheng Shao at 2023-05-08T17:15:40+01:00 testsuite: normalize the .wasm extension - - - - - 1da3dddc by Cheng Shao at 2023-05-08T17:15:40+01:00 testsuite: strip the cross ghc prefix in output and error message - - - - - d02150e3 by Cheng Shao at 2023-05-08T17:15:40+01:00 testsuite: handle target executable extension - - - - - 06260a02 by Cheng Shao at 2023-05-08T17:15:40+01:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 1c8f24ca by Cheng Shao at 2023-05-08T17:15:40+01:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - eceb22e7 by Cheng Shao at 2023-05-08T17:15:40+01:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - ba06e222 by Matthew Pickering at 2023-05-08T17:15:40+01:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 2de4e679 by mangoiv at 2023-05-08T17:15:40+01:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 8eff2227 by Artem Pelenitsyn at 2023-05-08T17:15:40+01:00 User Guide: update copyright year: 2020->2023 - - - - - d968392e by doyougnu at 2023-05-08T17:15:40+01:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - 87bb7ef5 by Torsten Schmits at 2023-05-08T17:15:40+01:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - ebe616e5 by doyougnu at 2023-05-08T17:15:40+01:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 9d19f237 by sheaf at 2023-05-08T17:15:40+01:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 812c316f by sheaf at 2023-05-08T17:15:40+01:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - 8f5f4c36 by Bodigrim at 2023-05-08T17:15:40+01:00 Rework documentation for data Char - - - - - 8dffda1b by Bodigrim at 2023-05-08T17:15:40+01:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - 30a99449 by Sylvain Henry at 2023-05-08T17:15:41+01:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 3121b78f by Matthew Pickering at 2023-05-08T17:15:41+01:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - 6e4cd95a by Matthew Pickering at 2023-05-08T17:15:41+01:00 ci: Add job to test 9.6 bootstrapping - - - - - 515cc9c3 by Krzysztof Gogolewski at 2023-05-08T17:15:41+01:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - 84db1c60 by Sylvain Henry at 2023-05-08T17:15:41+01:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 17bfeb66 by Haskell-mouse at 2023-05-08T17:15:41+01:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 9f0017de by Krzysztof Gogolewski at 2023-05-08T17:15:41+01:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 5e571c37 by Matthew Craven at 2023-05-08T17:15:41+01:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - 75f22535 by Matthew Craven at 2023-05-08T17:15:41+01:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - 68410f98 by sheaf at 2023-05-08T17:15:41+01:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - 07e8254f by Sylvain Henry at 2023-05-08T17:15:41+01:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 4842d530 by Ryan Scott at 2023-05-08T17:15:41+01:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 0959474d by Krzysztof Gogolewski at 2023-05-08T17:15:41+01:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - 301b2568 by sheaf at 2023-05-08T17:15:41+01:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - 70f1554c by Ben Gamari at 2023-05-08T17:15:41+01:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 9d9a88b0 by Brandon Chinn at 2023-05-08T17:15:41+01:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - e6d5a420 by Pierre Le Marre at 2023-05-08T17:15:41+01:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - 38c39b1a by Alex Dixon at 2023-05-08T17:15:41+01:00 Improve documentation for ($) (#22963) - - - - - 5b8247dc by Alex Dixon at 2023-05-08T17:15:41+01:00 Remove trailing whitespace from ($) commentary - - - - - 7523dc5b by Sebastian Graf at 2023-05-08T17:15:41+01:00 Adjust wording wrt representation polymorphism of ($) - - - - - 64c010a3 by Torsten Schmits at 2023-05-08T17:15:41+01:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 92a02dd8 by sheaf at 2023-05-08T17:15:41+01:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - b771e833 by Krzysztof Gogolewski at 2023-05-08T17:15:41+01:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - d9627926 by Krzysztof Gogolewski at 2023-05-08T17:15:41+01:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 002a194a by Cheng Shao at 2023-05-08T17:15:41+01:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 8b68fc0a by Cheng Shao at 2023-05-08T17:15:41+01:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - 4b2673c1 by Bodigrim at 2023-05-08T17:15:41+01:00 Set base 'maintainer' field to CLC - - - - - 48731e24 by Simon Peyton Jones at 2023-05-08T17:15:41+01:00 Clarify a couple of Notes about 'nospec' - - - - - e4f13a4d by Oleg Grenrus at 2023-05-08T17:15:42+01:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 07d65932 by Rodrigo Mesquita at 2023-05-08T17:15:42+01:00 Add regression test for #23229 - - - - - 47f507c5 by Sylvain Henry at 2023-05-08T17:15:42+01:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - bb81ec3f by Sylvain Henry at 2023-05-08T17:15:42+01:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - f34e1cfa by Sylvain Henry at 2023-05-08T17:15:42+01:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8875d6fa by Sylvain Henry at 2023-05-08T17:15:42+01:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 5e9eccd8 by Josh Meredith at 2023-05-08T17:15:42+01:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - 5a7b8f8b by Adam Sandberg Ericsson at 2023-05-08T17:15:42+01:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - 22672235 by Matthew Pickering at 2023-05-08T17:15:42+01:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - 86fc0301 by Simon Peyton Jones at 2023-05-08T17:15:42+01:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - e0c4cdc7 by Simon Peyton Jones at 2023-05-08T17:15:42+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 314800a7 by Simon Peyton Jones at 2023-05-08T17:15:42+01:00 Add some documentation about redundant constraints - - - - - c11d35bc by Simon Peyton Jones at 2023-05-08T17:15:42+01:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - ff8d72e5 by Simon Peyton Jones at 2023-05-08T17:15:42+01:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 209fd4a9 by Matthew Pickering at 2023-05-08T17:15:42+01:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - f5acf0b1 by Krzysztof Gogolewski at 2023-05-08T17:15:42+01:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - 3c06b21c by sheaf at 2023-05-08T17:15:42+01:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 359cecaf by Simon Peyton Jones at 2023-05-08T17:15:42+01:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - f3a0bdce by Oleg Grenrus at 2023-05-08T17:15:42+01:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 241a6687 by Matthew Pickering at 2023-05-08T17:15:42+01:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 33de9a76 by Simon Peyton Jones at 2023-05-08T17:15:42+01:00 Add regression test for #23199 - - - - - 885b084c by Ryan Scott at 2023-05-08T17:15:42+01:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 4c8d5b51 by Krzysztof Gogolewski at 2023-05-08T17:15:42+01:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5745479f by Matthew Pickering at 2023-05-08T17:15:42+01:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - 7ede948a by sheaf at 2023-05-08T17:15:43+01:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - 20d9b734 by Sylvain Henry at 2023-05-08T17:15:43+01:00 JS: fix thread-related primops - - - - - 0196f4da by Bryan Richter at 2023-05-08T17:15:43+01:00 CI: Disable abi-test-nightly See #23269 - - - - - da6a1706 by Sylvain Henry at 2023-05-08T17:15:43+01:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - 800ddade by Matthew Pickering at 2023-05-08T17:15:43+01:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 8ea74107 by tocic at 2023-05-08T17:15:43+01:00 Fix doc typo in GHC.Read.readList - - - - - a3c11082 by sheaf at 2023-05-08T17:15:43+01:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - c24b4bbd by Ben Gamari at 2023-05-08T17:15:43+01:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - b3eef6b4 by Ben Gamari at 2023-05-08T17:15:43+01:00 testsuite: Add test for #23071 - - - - - cbe8b444 by tocic at 2023-05-08T17:15:43+01:00 Fix doc typos in libraries/base/GHC - - - - - 1fa73d78 by Sylvain Henry at 2023-05-08T17:15:43+01:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - af39d132 by Krzysztof Gogolewski at 2023-05-08T17:15:43+01:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - 7afd4bb1 by amesgen at 2023-05-08T17:15:43+01:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - aae76738 by PHO at 2023-05-08T17:15:43+01:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 8866a60e by tocic at 2023-05-08T17:15:43+01:00 Fix doc typos in libraries/base - - - - - 1e3e21fa by Ben Gamari at 2023-05-08T17:15:43+01:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 73ffd6c3 by Cheng Shao at 2023-05-08T17:15:43+01:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - b856ddcf by Cheng Shao at 2023-05-08T17:15:43+01:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 78853fc6 by Cheng Shao at 2023-05-08T17:15:43+01:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 97545a7f by Bodigrim at 2023-05-08T17:15:43+01:00 Add since pragma to Data.Functor.unzip - - - - - 7e051fd0 by Soham Chowdhury at 2023-05-08T17:15:43+01:00 More informative errors for bad imports (#21826) - - - - - c8cc116e by Josh Meredith at 2023-05-08T17:15:43+01:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - c30ed397 by Josh Meredith at 2023-05-08T17:15:43+01:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 9e314f96 by Andrei Borzenkov at 2023-05-08T17:15:43+01:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - 0264500d by Ben Gamari at 2023-05-08T17:15:43+01:00 ghc-toolchain: Initial commit - - - - - 71e7e410 by Ben Gamari at 2023-05-08T17:15:43+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - ace2b427 by Ben Gamari at 2023-05-08T17:15:43+01:00 Move via-C flags into GHC - - - - - afce352f by Ben Gamari at 2023-05-08T17:15:44+01:00 Rip out runtime linker/compiler checks - - - - - 44f3e1fd by Ben Gamari at 2023-05-08T17:18:44+01:00 configure: Rip out toolchain selection logic - - - - - 199d5bd3 by Ben Gamari at 2023-05-08T17:18:46+01:00 Fixes - - - - - c12c0877 by Rodrigo Mesquita at 2023-05-08T17:18:46+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 58aab98e by Rodrigo Mesquita at 2023-05-08T17:18:46+01:00 Re-introduce ld-override option - - - - - c4f5f4e7 by Rodrigo Mesquita at 2023-05-08T17:19:34+01:00 ROMES:WIP - - - - - 592edddc by Rodrigo Mesquita at 2023-05-08T17:19:35+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 3237a7c5 by Rodrigo Mesquita at 2023-05-08T17:19:35+01:00 ROMES: WIP - - - - - cb0b101f by Rodrigo Mesquita at 2023-05-08T17:20:01+01:00 Re-introduce flags in hadrian config - - - - - f82e5efe by Rodrigo Mesquita at 2023-05-08T17:20:02+01:00 ROMES WIP - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8a95b770fa4b1f4eba4ff4c3479f62a1168a4e1...f82e5efec2451ff02b71d3bba6c86d85ff1269cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8a95b770fa4b1f4eba4ff4c3479f62a1168a4e1...f82e5efec2451ff02b71d3bba6c86d85ff1269cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 16:44:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 12:44:34 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] Move "target has RTS linker" out of settings Message-ID: <645926f229ba3_38ffda56a36c9447441@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: 56471f9a by Rodrigo Mesquita at 2023-05-08T17:44:25+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Closes #23361 - - - - - 9 changed files: - compiler/GHC/Driver/Session.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4727,8 +4727,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . @@ -4769,6 +4770,23 @@ compilerInfo dflags expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd +-- | Does this target have an RTS linker? +-- Romes: Perhaps not the best place for the function +platformHasRTSLinker :: Platform -> Bool +-- NO for powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- What about powerpc other than powerpc-ibm-aix*? + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False -- What about s390x other than s390x-ibm-linux? + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + + -- | Get target profile targetProfile :: DynFlags -> Profile targetProfile dflags = Profile (targetPlatform dflags) (ways dflags) ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -451,7 +451,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -126,7 +126,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- romes: Dear reviewer, I'm not sure if it's OK to do this here, but we no + -- longer "know" the information, we can only query either ghc --info, or + -- the test settings (which indirectly queried the ghc --info) + rtsLinker <- getBooleanSetting TestGhcWithRtsLinker return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56471f9a4630890c2d545e2102ee19c5d7465da8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56471f9a4630890c2d545e2102ee19c5d7465da8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 17:00:31 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 08 May 2023 13:00:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17284 Message-ID: <64592aafc9be3_38ffda55c6ade04801d@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T17284 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17284 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 17:58:35 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Mon, 08 May 2023 13:58:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/decode-cloned-stack-save Message-ID: <6459384bec81_38ffda59d3624849726@gitlab.mail> Sven Tennie pushed new branch wip/decode-cloned-stack-save at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/decode-cloned-stack-save You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 17:59:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 13:59:30 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList Message-ID: <645938825234c_38ffda59f3f968498442@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 370defde by Rodrigo Mesquita at 2023-05-08T18:59:00+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 7 changed files: - configure.ac - − m4/ghc_adjustors_method.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Prelude.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -979,14 +979,14 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap], [Use mmap in the runtime linker]) -# TODO: Unregisterised, TablesNextToCode -TablesNextToCode=YES -AC_SUBST([TablesNextToCode]) -Unregisterised=YES -AC_SUBST([Unregisterised]) - +AC_ARG_ENABLE(libffi-adjustors, + [AS_HELP_STRING( + [--enable-libffi-adjustors], + [Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors.])], + UseLibffiForAdjustors=$enableval, + dnl do nothing +) -GHC_ADJUSTORS_METHOD([Target]) AC_SUBST([UseLibffiForAdjustors]) dnl ** Other RTS features ===================================== m4/ghc_adjustors_method.m4 deleted ===================================== @@ -1,49 +0,0 @@ -dnl GHC_ADJUSTORS_METHOD(Platform) -dnl -------------------------------------------------------------- -dnl Use libffi for adjustors? -AC_DEFUN([GHC_ADJUSTORS_METHOD], -[ - case [$]{$1[Arch]} in - i386|x86_64) - # We have native adjustor support on these platforms - HaveNativeAdjustor=yes - ;; - *) - HaveNativeAdjustor=no - ;; - esac - - AC_ARG_ENABLE(libffi-adjustors, - [AS_HELP_STRING( - [--enable-libffi-adjustors], - [Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors.])], - UseLibffiForAdjustors=$enableval, - dnl do nothing - ) - - AC_MSG_CHECKING([whether to use libffi for adjustors]) - if test "$UseLibffiForAdjustors" = "yes" ; then - # Use libffi is the user explicitly requested it - AdjustorType="libffi" - elif test "$HaveNativeAdjustor" = "yes"; then - # Otherwise if we have a native adjustor implementation use that - AdjustorType="native" - else - # If we don't have a native adjustor implementation then default to libffi - AdjustorType="libffi" - fi - - case "$AdjustorType" in - libffi) - UseLibffiForAdjustors=YES - AC_MSG_RESULT([yes]) - ;; - native) - UseLibffiForAdjustors=NO - AC_MSG_RESULT([no]) - ;; - *) - AC_MSG_ERROR([Internal error: Invalid AdjustorType]) - exit 1 - esac -]) ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -44,6 +44,7 @@ data Opts = Opts , optDllwrap :: ProgOpt , optUnregisterised :: Maybe Bool , optTablesNextToCode :: Maybe Bool + , optUseLibFFIForAjdustors :: Maybe Bool , optLdOverride :: Maybe Bool , optVerbosity :: Int , optKeepTemp :: Bool @@ -100,6 +101,9 @@ _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) _optTablesNextToCode :: Lens Opts (Maybe Bool) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) +_optUseLibffiForAdjustors :: Lens Opts (Maybe Bool) +_optUseLibffiForAdjustors = Lens optUseLibffiForAdjustors (\x o -> o {optUseLibffiForAdjustors=x}) + _optLdOvveride :: Lens Opts (Maybe Bool) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) @@ -119,6 +123,7 @@ options = concat [ enableDisable "unregisterised" "unregisterised backend" _optUnregisterised , enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode + , enableDisable "libffi-adjustors" "Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors." _optTablesNextToCode , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride ] ++ concat @@ -250,6 +255,26 @@ determineTablesNextToCode archOs unreg userReq = where tntcSupported = tablesNextToCodeSupported archOs +determineUseLibFFIForAdjustors :: ArchOS + -> Maybe Bool -- ^ Enable/disable option --libffi-adjustors + -> M Bool +determineUseLibFFIForAdjustors archOs mb = checking "whether to use libffi for adjustors" $ + case mb of + True -> + -- The user explicitly requested it + pure True + + _ -> + -- If don't have a native adjustor implementation we use libffi + pure (not . archHasNativeAdjustors $ archOS_arch archOs) -- If we + +archHasNativeAdjustors :: Arch -> Bool +archHasNativeAdjustors = \case + ArchX86 -> True + ArchX86_64 -> True + _ -> False + + mkTarget :: Opts -> M Target mkTarget opts = do cc0 <- findCc (optCc opts) @@ -290,6 +315,7 @@ mkTarget opts = do tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) tgtTablesNextToCode <- determineTablesNextToCode archOs tgtUnregisterised (optTablesNextToCode opts) + tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAjdustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these let prog = "int main(int argc, char** argv) { return 0; }I" @@ -314,6 +340,7 @@ mkTarget opts = do , tgtEndianness , tgtUnregisterised , tgtTablesNextToCode + , tgtUseLibffi , tgtSymbolsHaveLeadingUnderscore , tgtSupportsSubsectionsViaSymbols , tgtSupportsIdentDirective ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -12,6 +12,7 @@ module GHC.Toolchain.Monad -- * File I/O , readFile , writeFile + , appendFile , createFile -- * Logging @@ -21,7 +22,7 @@ module GHC.Toolchain.Monad , withLogContext ) where -import Prelude hiding (readFile, writeFile) +import Prelude hiding (readFile, writeFile, appendFile) import qualified Prelude import Control.Applicative @@ -31,7 +32,9 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.Except as Except -import System.IO hiding (readFile, writeFile) +import System.IO hiding (readFile, writeFile, appendFile) +-- import qualified System.Directory + data Env = Env { verbosity :: Int , targetPrefix :: Maybe String @@ -98,6 +101,14 @@ readFile path = liftIO $ Prelude.readFile path writeFile :: FilePath -> String -> M () writeFile path s = liftIO $ Prelude.writeFile path s +appendFile :: FilePath -> String -> M () +appendFile path s = liftIO $ Prelude.appendFile path s + +-- copyFile :: FilePath -- ^ Source file +-- -> FilePath -- ^ Destination file +-- -> M () +-- copyFile src dst = liftIO $ System.Directory.copyFile src dst + -- | Create an empty file. createFile :: FilePath -> M () createFile path = writeFile path "" ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Prelude.hs ===================================== @@ -8,4 +8,4 @@ module GHC.Toolchain.Prelude import GHC.Toolchain.Monad import GHC.Toolchain.Lens import Control.Applicative -import Prelude hiding (writeFile, readFile) +import Prelude hiding (writeFile, readFile, appendFile) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -42,15 +42,15 @@ data Target = Target , tgtUnregisterised :: Bool , tgtTablesNextToCode :: Bool -- , tgtHasRtsLinker :: Bool -- NO NEED! Rebase on MR removing it. - -- , tgtHasThreadedRts :: Bool - , tgtUseLibffi :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it + -- , tgtHasThreadedRts :: Bool -- Do we need this for each target? Or just when bootstrapping? + , tgtUseLibffiForAdjustors :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it -- C toolchain , tgtCCompiler :: Cc , tgtCxxCompiler :: Cxx , tgtCPreprocessor :: Cpp -- if hadrian depends on Cpp (not HsCpp flags) then this isn't sufficient , tgtCCompilerLink :: CcLink - -- , tgtLd :: Program -- needed? probably not + -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed) , tgtAr :: Ar , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -34,10 +34,12 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l -- If not then try to find a decent linker on our own rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc] findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink - ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram + ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram + ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram + ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram - return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie} + return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist} -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program @@ -79,8 +81,9 @@ doLinkerSearch = False #endif checkSupportsNoPie :: Program -> M Bool -checkSupportsNoPie ccLink = withTempDir $ \dir -> do - let test_c = dir "test.o" +checkSupportsNoPie ccLink = checking "whether CC supports -no-pie" $ + withTempDir $ \dir -> do + let test_c = dir "test.c" writeFile test_c "int main() { return 0; }" let test = dir "test" @@ -91,6 +94,41 @@ checkSupportsNoPie ccLink = withTempDir $ \dir -> do then return False else return True +checkSupportsCompactUnwind :: Cc -> Program -> M Bool +checkSupportsCompactUnwind cc ccLink = checking "whether ld understands -no_compact_unwind" $ + withTempDir $ \dir -> do + let test_c = dir "test.c" + test_o = dir "test.o" + test2_o = dir "test2.o" + writeFile test_c "int foo() { return 0; }" + callProgram (ccProgram cc) ["-c", test_c] + exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] + pure $ isSuccess exitCode + + +checkSupportsFilelist :: Cc -> Program -> M Bool +checkSupportsFilelist cc ccLink = checking "whether ld understands -filelist" $ + withTempDir $ \dir -> do + let test_o = dir "test.o" + test1_c = dir "test1.c" + test2_c = dir "test2.c" + test1_o = dir "test1.o" + test2_o = dir "test2.o" + test_ofiles = dir "test.o-files" + + writeFile test1_c "int foo() { return 0; }" + writeFile test2_c "int bar() { return 0; }" + + callProgram (ccProgram cc) ["-c", test1_c] + callProgram (ccProgram cc) ["-c", test2_c] + + writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file + appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + + exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] + + pure $ isSuccess exitCode + -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () checkLinkWorks cc ccLink = withTempDir $ \dir -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/370defde2972c1e5e83005eac2d9a53ca13a4f66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/370defde2972c1e5e83005eac2d9a53ca13a4f66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 18:05:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 14:05:42 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList Message-ID: <645939f6a02c0_38ffda5a64cef4501975@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: d1387b26 by Rodrigo Mesquita at 2023-05-08T19:05:32+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 7 changed files: - configure.ac - − m4/ghc_adjustors_method.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Prelude.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -979,14 +979,14 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap], [Use mmap in the runtime linker]) -# TODO: Unregisterised, TablesNextToCode -TablesNextToCode=YES -AC_SUBST([TablesNextToCode]) -Unregisterised=YES -AC_SUBST([Unregisterised]) - +AC_ARG_ENABLE(libffi-adjustors, + [AS_HELP_STRING( + [--enable-libffi-adjustors], + [Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors.])], + UseLibffiForAdjustors=$enableval, + dnl do nothing +) -GHC_ADJUSTORS_METHOD([Target]) AC_SUBST([UseLibffiForAdjustors]) dnl ** Other RTS features ===================================== m4/ghc_adjustors_method.m4 deleted ===================================== @@ -1,49 +0,0 @@ -dnl GHC_ADJUSTORS_METHOD(Platform) -dnl -------------------------------------------------------------- -dnl Use libffi for adjustors? -AC_DEFUN([GHC_ADJUSTORS_METHOD], -[ - case [$]{$1[Arch]} in - i386|x86_64) - # We have native adjustor support on these platforms - HaveNativeAdjustor=yes - ;; - *) - HaveNativeAdjustor=no - ;; - esac - - AC_ARG_ENABLE(libffi-adjustors, - [AS_HELP_STRING( - [--enable-libffi-adjustors], - [Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors.])], - UseLibffiForAdjustors=$enableval, - dnl do nothing - ) - - AC_MSG_CHECKING([whether to use libffi for adjustors]) - if test "$UseLibffiForAdjustors" = "yes" ; then - # Use libffi is the user explicitly requested it - AdjustorType="libffi" - elif test "$HaveNativeAdjustor" = "yes"; then - # Otherwise if we have a native adjustor implementation use that - AdjustorType="native" - else - # If we don't have a native adjustor implementation then default to libffi - AdjustorType="libffi" - fi - - case "$AdjustorType" in - libffi) - UseLibffiForAdjustors=YES - AC_MSG_RESULT([yes]) - ;; - native) - UseLibffiForAdjustors=NO - AC_MSG_RESULT([no]) - ;; - *) - AC_MSG_ERROR([Internal error: Invalid AdjustorType]) - exit 1 - esac -]) ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE LambdaCase #-} module Main where @@ -44,6 +45,7 @@ data Opts = Opts , optDllwrap :: ProgOpt , optUnregisterised :: Maybe Bool , optTablesNextToCode :: Maybe Bool + , optUseLibFFIForAdjustors :: Maybe Bool , optLdOverride :: Maybe Bool , optVerbosity :: Int , optKeepTemp :: Bool @@ -66,6 +68,7 @@ emptyOpts = Opts , optWindres = po0 , optUnregisterised = Nothing , optTablesNextToCode = Nothing + , optUseLibFFIForAdjustors = Nothing , optLdOverride = Nothing -- See comment in Link on 'enableOverride'. Shouldn't we set the default here? , optVerbosity = 0 , optKeepTemp = False @@ -100,6 +103,9 @@ _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) _optTablesNextToCode :: Lens Opts (Maybe Bool) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) +_optUseLibFFIForAdjustors :: Lens Opts (Maybe Bool) +_optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) + _optLdOvveride :: Lens Opts (Maybe Bool) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) @@ -119,6 +125,7 @@ options = concat [ enableDisable "unregisterised" "unregisterised backend" _optUnregisterised , enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode + , enableDisable "libffi-adjustors" "Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride ] ++ concat @@ -250,6 +257,26 @@ determineTablesNextToCode archOs unreg userReq = where tntcSupported = tablesNextToCodeSupported archOs +determineUseLibFFIForAdjustors :: ArchOS + -> Maybe Bool -- ^ Enable/disable option --libffi-adjustors + -> M Bool +determineUseLibFFIForAdjustors archOs mb = checking "whether to use libffi for adjustors" $ + case mb of + Just True -> + -- The user explicitly requested it + pure True + + _ -> + -- If don't have a native adjustor implementation we use libffi + pure (not . archHasNativeAdjustors $ archOS_arch archOs) -- If we + +archHasNativeAdjustors :: Arch -> Bool +archHasNativeAdjustors = \case + ArchX86 -> True + ArchX86_64 -> True + _ -> False + + mkTarget :: Opts -> M Target mkTarget opts = do cc0 <- findCc (optCc opts) @@ -290,6 +317,7 @@ mkTarget opts = do tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) tgtTablesNextToCode <- determineTablesNextToCode archOs tgtUnregisterised (optTablesNextToCode opts) + tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these let prog = "int main(int argc, char** argv) { return 0; }I" @@ -314,6 +342,7 @@ mkTarget opts = do , tgtEndianness , tgtUnregisterised , tgtTablesNextToCode + , tgtUseLibffiForAdjustors = tgtUseLibffi , tgtSymbolsHaveLeadingUnderscore , tgtSupportsSubsectionsViaSymbols , tgtSupportsIdentDirective ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -12,6 +12,7 @@ module GHC.Toolchain.Monad -- * File I/O , readFile , writeFile + , appendFile , createFile -- * Logging @@ -21,7 +22,7 @@ module GHC.Toolchain.Monad , withLogContext ) where -import Prelude hiding (readFile, writeFile) +import Prelude hiding (readFile, writeFile, appendFile) import qualified Prelude import Control.Applicative @@ -31,7 +32,9 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.Except as Except -import System.IO hiding (readFile, writeFile) +import System.IO hiding (readFile, writeFile, appendFile) +-- import qualified System.Directory + data Env = Env { verbosity :: Int , targetPrefix :: Maybe String @@ -98,6 +101,14 @@ readFile path = liftIO $ Prelude.readFile path writeFile :: FilePath -> String -> M () writeFile path s = liftIO $ Prelude.writeFile path s +appendFile :: FilePath -> String -> M () +appendFile path s = liftIO $ Prelude.appendFile path s + +-- copyFile :: FilePath -- ^ Source file +-- -> FilePath -- ^ Destination file +-- -> M () +-- copyFile src dst = liftIO $ System.Directory.copyFile src dst + -- | Create an empty file. createFile :: FilePath -> M () createFile path = writeFile path "" ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Prelude.hs ===================================== @@ -8,4 +8,4 @@ module GHC.Toolchain.Prelude import GHC.Toolchain.Monad import GHC.Toolchain.Lens import Control.Applicative -import Prelude hiding (writeFile, readFile) +import Prelude hiding (writeFile, readFile, appendFile) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -42,15 +42,15 @@ data Target = Target , tgtUnregisterised :: Bool , tgtTablesNextToCode :: Bool -- , tgtHasRtsLinker :: Bool -- NO NEED! Rebase on MR removing it. - -- , tgtHasThreadedRts :: Bool - , tgtUseLibffi :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it + -- , tgtHasThreadedRts :: Bool -- Do we need this for each target? Or just when bootstrapping? + , tgtUseLibffiForAdjustors :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it -- C toolchain , tgtCCompiler :: Cc , tgtCxxCompiler :: Cxx , tgtCPreprocessor :: Cpp -- if hadrian depends on Cpp (not HsCpp flags) then this isn't sufficient , tgtCCompilerLink :: CcLink - -- , tgtLd :: Program -- needed? probably not + -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed) , tgtAr :: Ar , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -34,10 +34,12 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l -- If not then try to find a decent linker on our own rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc] findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink - ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram + ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram + ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram + ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram - return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie} + return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist} -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program @@ -79,8 +81,9 @@ doLinkerSearch = False #endif checkSupportsNoPie :: Program -> M Bool -checkSupportsNoPie ccLink = withTempDir $ \dir -> do - let test_c = dir "test.o" +checkSupportsNoPie ccLink = checking "whether CC supports -no-pie" $ + withTempDir $ \dir -> do + let test_c = dir "test.c" writeFile test_c "int main() { return 0; }" let test = dir "test" @@ -91,6 +94,41 @@ checkSupportsNoPie ccLink = withTempDir $ \dir -> do then return False else return True +checkSupportsCompactUnwind :: Cc -> Program -> M Bool +checkSupportsCompactUnwind cc ccLink = checking "whether ld understands -no_compact_unwind" $ + withTempDir $ \dir -> do + let test_c = dir "test.c" + test_o = dir "test.o" + test2_o = dir "test2.o" + writeFile test_c "int foo() { return 0; }" + callProgram (ccProgram cc) ["-c", test_c] + exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] + pure $ isSuccess exitCode + + +checkSupportsFilelist :: Cc -> Program -> M Bool +checkSupportsFilelist cc ccLink = checking "whether ld understands -filelist" $ + withTempDir $ \dir -> do + let test_o = dir "test.o" + test1_c = dir "test1.c" + test2_c = dir "test2.c" + test1_o = dir "test1.o" + test2_o = dir "test2.o" + test_ofiles = dir "test.o-files" + + writeFile test1_c "int foo() { return 0; }" + writeFile test2_c "int bar() { return 0; }" + + callProgram (ccProgram cc) ["-c", test1_c] + callProgram (ccProgram cc) ["-c", test2_c] + + writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file + appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + + exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] + + pure $ isSuccess exitCode + -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () checkLinkWorks cc ccLink = withTempDir $ \dir -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1387b26399d0fa2dce2e6948afbab3ba80dfb0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1387b26399d0fa2dce2e6948afbab3ba80dfb0a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 18:31:43 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Mon, 08 May 2023 14:31:43 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 6 commits: Serialize CmmRetInfo in .rodata Message-ID: <6459400f166f4_38ffda5c83e65c5163c1@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 208f181d by Sven Tennie at 2023-05-08T18:10:03+00:00 Serialize CmmRetInfo in .rodata The handling of case was missing. - - - - - 715eebf6 by Sven Tennie at 2023-05-08T18:12:35+00:00 Reference StgRetFun payload by its struct field address This is easier to grasp than relative pointer offsets. - - - - - b529e7cf by Sven Tennie at 2023-05-08T18:21:14+00:00 Better variable name: u -> frame The 'u' was likely introduced by copy'n'paste. - - - - - eefa9f12 by Sven Tennie at 2023-05-08T18:22:59+00:00 Make checkSTACK() public Such that it can also be used in tests. - - - - - 2c9f1a36 by Sven Tennie at 2023-05-08T18:26:07+00:00 Publish stack related fields in DerivedConstants.h These will be used in ghc-heap to decode these parts of the stack. - - - - - e778d832 by Sven Tennie at 2023-05-08T18:29:32+00:00 ghc-heap: Decode StgStack and its stack frames Previously, ghc-heap could only decode heap closures. The approach is explained in detail in note [Decoding the stack]. - - - - - 22 changed files: - compiler/GHC/Cmm/CLabel.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc - + libraries/ghc-heap/GHC/Exts/Stack.hs - + libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc - + libraries/ghc-heap/GHC/Exts/Stack/Decode.hs - + libraries/ghc-heap/cbits/Stack.c - + libraries/ghc-heap/cbits/Stack.cmm - libraries/ghc-heap/ghc-heap.cabal.in - libraries/ghc-heap/tests/TestUtils.hs - libraries/ghc-heap/tests/all.T - + libraries/ghc-heap/tests/stack_big_ret.hs - + libraries/ghc-heap/tests/stack_misc_closures.hs - + libraries/ghc-heap/tests/stack_misc_closures_c.c - + libraries/ghc-heap/tests/stack_misc_closures_prim.cmm - + libraries/ghc-heap/tests/stack_stm_frames.hs - + libraries/ghc-heap/tests/stack_underflow.hs - rts/Printer.c - rts/include/rts/storage/InfoTables.h - rts/sm/Sanity.c - rts/sm/Sanity.h - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -797,6 +797,7 @@ isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True -- info table defined in cmm (.cmm) isSomeRODataLabel (CmmLabel _ _ _ CmmInfo) = True +isSomeRODataLabel (CmmLabel _ _ _ CmmRetInfo) = True isSomeRODataLabel _lbl = False -- | Whether label is points to some kind of info table ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -15,9 +15,18 @@ module GHC.Exts.Heap.Closures ( , WhatNext(..) , WhyBlocked(..) , TsoFlags(..) + , RetFunType(..) , allClosures , closureSize + -- * Stack + , StgStackClosure + , GenStgStackClosure(..) + , StackFrame + , GenStackFrame(..) + , StackField + , GenStackField(..) + -- * Boxes , Box(..) , areBoxesEqual @@ -95,7 +104,6 @@ areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of ------------------------------------------------------------------------ -- Closures - type Closure = GenClosure Box -- | This is the representation of a Haskell value on the heap. It reflects @@ -354,8 +362,148 @@ data GenClosure b | UnsupportedClosure { info :: !StgInfoTable } + + -- | A primitive word from a bitmap encoded stack frame payload + -- + -- The type itself cannot be restored (i.e. it might represent a Word8# + -- or an Int#). + | UnknownTypeWordSizedPrimitive + { wordVal :: !Word } deriving (Show, Generic, Functor, Foldable, Traversable) +type StgStackClosure = GenStgStackClosure Box + +-- | A decoded @StgStack@ with `StackFrame`s +-- +-- Stack related data structures (`GenStgStackClosure`, `GenStackField`, +-- `GenStackFrame`) are defined separately from `GenClosure` as their related +-- functions are very different. Though, both are closures in the sense of RTS +-- structures, their decoding logic differs: While it's safe to keep a reference +-- to a heap closure, the garbage collector does not update references to stack +-- located closures. +-- +-- Additionally, stack frames don't appear outside of the stack. Thus, keeping +-- `GenStackFrame` and `GenClosure` separated, makes these types more precise +-- (in the sense what values to expect.) +data GenStgStackClosure b = GenStgStackClosure + { ssc_info :: !StgInfoTable + , ssc_stack_size :: !Word32 -- ^ stack size in *words* + , ssc_stack_dirty :: !Word8 -- ^ non-zero => dirty + , ssc_stack_marking :: !Word8 + , ssc_stack :: ![GenStackFrame b] + } + deriving (Foldable, Functor, Generic, Show, Traversable) + +type StackField = GenStackField Box + +-- | Bitmap-encoded payload on the stack +data GenStackField b + -- | A non-pointer field + = StackWord !Word + -- | A pointer field + | StackBox !b + deriving (Foldable, Functor, Generic, Show, Traversable) + +type StackFrame = GenStackFrame Box + +-- | A single stack frame +data GenStackFrame b = + UpdateFrame + { info_tbl :: !StgInfoTable + , updatee :: !b + } + + | CatchFrame + { info_tbl :: !StgInfoTable + , exceptions_blocked :: !Word + , handler :: !b + } + + | CatchStmFrame + { info_tbl :: !StgInfoTable + , catchFrameCode :: !b + , handler :: !b + } + + | CatchRetryFrame + { info_tbl :: !StgInfoTable + , running_alt_code :: !Word + , first_code :: !b + , alt_code :: !b + } + + | AtomicallyFrame + { info_tbl :: !StgInfoTable + , atomicallyFrameCode :: !b + , result :: !b + } + + | UnderflowFrame + { info_tbl :: !StgInfoTable + , nextChunk :: !(GenStgStackClosure b) + } + + | StopFrame + { info_tbl :: !StgInfoTable } + + | RetSmall + { info_tbl :: !StgInfoTable + , stack_payload :: ![GenStackField b] + } + + | RetBig + { info_tbl :: !StgInfoTable + , stack_payload :: ![GenStackField b] + } + + | RetFun + { info_tbl :: !StgInfoTable + , retFunType :: !RetFunType + , retFunSize :: !Word + , retFunFun :: !b + , retFunPayload :: ![GenStackField b] + } + + | RetBCO + { info_tbl :: !StgInfoTable + , bco :: !b -- ^ always a BCOClosure + , bcoArgs :: ![GenStackField b] + } + deriving (Foldable, Functor, Generic, Show, Traversable) + +-- | Fun types according to @FunTypes.h@ +-- This `Enum` must be aligned with the values in @FunTypes.h at . +data RetFunType = + ARG_GEN | + ARG_GEN_BIG | + ARG_BCO | + ARG_NONE | + ARG_N | + ARG_P | + ARG_F | + ARG_D | + ARG_L | + ARG_V16 | + ARG_V32 | + ARG_V64 | + ARG_NN | + ARG_NP | + ARG_PN | + ARG_PP | + ARG_NNN | + ARG_NNP | + ARG_NPN | + ARG_NPP | + ARG_PNN | + ARG_PNP | + ARG_PPN | + ARG_PPP | + ARG_PPPP | + ARG_PPPPP | + ARG_PPPPPP | + ARG_PPPPPPP | + ARG_PPPPPPPP + deriving (Show, Eq, Enum, Generic) data PrimType = PInt ===================================== libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc ===================================== @@ -37,4 +37,4 @@ data StgInfoTable = StgInfoTable { tipe :: ClosureType, srtlen :: HalfWord, code :: Maybe ItblCodes -- Just <=> TABLES_NEXT_TO_CODE - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) ===================================== libraries/ghc-heap/GHC/Exts/Stack.hs ===================================== @@ -0,0 +1,37 @@ +{-# LANGUAGE CPP #-} +#if MIN_TOOL_VERSION_ghc(9,7,0) +{-# LANGUAGE RecordWildCards #-} + +module GHC.Exts.Stack + ( -- * Stack inspection + decodeStack, + stackFrameSize, + ) +where + +import GHC.Exts.Heap.Closures +import GHC.Exts.Stack.Constants +import GHC.Exts.Stack.Decode +import Prelude + +-- | Get the size of the `StackFrame` in words. +-- +-- Includes header and payload. Does not follow pointers. +stackFrameSize :: StackFrame -> Int +stackFrameSize (UpdateFrame {}) = sizeStgUpdateFrame +stackFrameSize (CatchFrame {}) = sizeStgCatchFrame +stackFrameSize (CatchStmFrame {}) = sizeStgCatchSTMFrame +stackFrameSize (CatchRetryFrame {}) = sizeStgCatchRetryFrame +stackFrameSize (AtomicallyFrame {}) = sizeStgAtomicallyFrame +stackFrameSize (RetSmall {..}) = sizeStgClosure + length stack_payload +stackFrameSize (RetBig {..}) = sizeStgClosure + length stack_payload +stackFrameSize (RetFun {..}) = sizeStgRetFunFrame + length retFunPayload +-- The one additional word is a pointer to the StgBCO in the closure's payload +stackFrameSize (RetBCO {..}) = sizeStgClosure + 1 + length bcoArgs +-- The one additional word is a pointer to the next stack chunk +stackFrameSize (UnderflowFrame {}) = sizeStgClosure + 1 +stackFrameSize _ = error "Unexpected stack frame type" + +#else +module GHC.Exts.Stack where +#endif ===================================== libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc ===================================== @@ -0,0 +1,130 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module GHC.Exts.Stack.Constants where + +#if MIN_TOOL_VERSION_ghc(9,7,0) + +import Prelude + +#include "Rts.h" +#undef BLOCK_SIZE +#undef MBLOCK_SIZE +#undef BLOCKS_PER_MBLOCK +#include "DerivedConstants.h" + +newtype ByteOffset = ByteOffset { offsetInBytes :: Int } + deriving newtype (Eq, Show, Integral, Real, Num, Enum, Ord) + +newtype WordOffset = WordOffset { offsetInWords :: Int } + deriving newtype (Eq, Show, Integral, Real, Num, Enum, Ord) + +offsetStgCatchFrameHandler :: WordOffset +offsetStgCatchFrameHandler = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchFrame_handler) + (#size StgHeader) + +offsetStgCatchFrameExceptionsBlocked :: WordOffset +offsetStgCatchFrameExceptionsBlocked = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchFrame_exceptions_blocked) + (#size StgHeader) + +sizeStgCatchFrame :: Int +sizeStgCatchFrame = bytesToWords $ + (#const SIZEOF_StgCatchFrame_NoHdr) + (#size StgHeader) + +offsetStgCatchSTMFrameCode :: WordOffset +offsetStgCatchSTMFrameCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchSTMFrame_code) + (#size StgHeader) + +offsetStgCatchSTMFrameHandler :: WordOffset +offsetStgCatchSTMFrameHandler = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchSTMFrame_handler) + (#size StgHeader) + +sizeStgCatchSTMFrame :: Int +sizeStgCatchSTMFrame = bytesToWords $ + (#const SIZEOF_StgCatchSTMFrame_NoHdr) + (#size StgHeader) + +offsetStgUpdateFrameUpdatee :: WordOffset +offsetStgUpdateFrameUpdatee = byteOffsetToWordOffset $ + (#const OFFSET_StgUpdateFrame_updatee) + (#size StgHeader) + +sizeStgUpdateFrame :: Int +sizeStgUpdateFrame = bytesToWords $ + (#const SIZEOF_StgUpdateFrame_NoHdr) + (#size StgHeader) + +offsetStgAtomicallyFrameCode :: WordOffset +offsetStgAtomicallyFrameCode = byteOffsetToWordOffset $ + (#const OFFSET_StgAtomicallyFrame_code) + (#size StgHeader) + +offsetStgAtomicallyFrameResult :: WordOffset +offsetStgAtomicallyFrameResult = byteOffsetToWordOffset $ + (#const OFFSET_StgAtomicallyFrame_result) + (#size StgHeader) + +sizeStgAtomicallyFrame :: Int +sizeStgAtomicallyFrame = bytesToWords $ + (#const SIZEOF_StgAtomicallyFrame_NoHdr) + (#size StgHeader) + +offsetStgCatchRetryFrameRunningAltCode :: WordOffset +offsetStgCatchRetryFrameRunningAltCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_running_alt_code) + (#size StgHeader) + +offsetStgCatchRetryFrameRunningFirstCode :: WordOffset +offsetStgCatchRetryFrameRunningFirstCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_first_code) + (#size StgHeader) + +offsetStgCatchRetryFrameAltCode :: WordOffset +offsetStgCatchRetryFrameAltCode = byteOffsetToWordOffset $ + (#const OFFSET_StgCatchRetryFrame_alt_code) + (#size StgHeader) + +sizeStgCatchRetryFrame :: Int +sizeStgCatchRetryFrame = bytesToWords $ + (#const SIZEOF_StgCatchRetryFrame_NoHdr) + (#size StgHeader) + +offsetStgRetFunFrameSize :: WordOffset +-- StgRetFun has no header, but only a pointer to the info table at the beginning. +offsetStgRetFunFrameSize = byteOffsetToWordOffset (#const OFFSET_StgRetFun_size) + +offsetStgRetFunFrameFun :: WordOffset +offsetStgRetFunFrameFun = byteOffsetToWordOffset (#const OFFSET_StgRetFun_fun) + +offsetStgRetFunFramePayload :: WordOffset +offsetStgRetFunFramePayload = byteOffsetToWordOffset (#const OFFSET_StgRetFun_payload) + +sizeStgRetFunFrame :: Int +sizeStgRetFunFrame = bytesToWords (#const SIZEOF_StgRetFun) + +offsetStgBCOFrameInstrs :: ByteOffset +offsetStgBCOFrameInstrs = (#const OFFSET_StgBCO_instrs) + (#size StgHeader) + +offsetStgBCOFrameLiterals :: ByteOffset +offsetStgBCOFrameLiterals = (#const OFFSET_StgBCO_literals) + (#size StgHeader) + +offsetStgBCOFramePtrs :: ByteOffset +offsetStgBCOFramePtrs = (#const OFFSET_StgBCO_ptrs) + (#size StgHeader) + +offsetStgBCOFrameArity :: ByteOffset +offsetStgBCOFrameArity = (#const OFFSET_StgBCO_arity) + (#size StgHeader) + +offsetStgBCOFrameSize :: ByteOffset +offsetStgBCOFrameSize = (#const OFFSET_StgBCO_size) + (#size StgHeader) + +offsetStgClosurePayload :: WordOffset +offsetStgClosurePayload = byteOffsetToWordOffset $ + (#const OFFSET_StgClosure_payload) + (#size StgHeader) + +sizeStgClosure :: Int +sizeStgClosure = bytesToWords (#size StgHeader) + +byteOffsetToWordOffset :: ByteOffset -> WordOffset +byteOffsetToWordOffset = WordOffset . bytesToWords . fromInteger . toInteger + +bytesToWords :: Int -> Int +bytesToWords b = + if b `mod` bytesInWord == 0 then + fromIntegral $ b `div` bytesInWord + else + error "Unexpected struct alignment!" + +bytesInWord :: Int +bytesInWord = (#const SIZEOF_VOID_P) + +#endif ===================================== libraries/ghc-heap/GHC/Exts/Stack/Decode.hs ===================================== @@ -0,0 +1,444 @@ +{-# LANGUAGE CPP #-} +#if MIN_TOOL_VERSION_ghc(9,7,0) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module GHC.Exts.Stack.Decode + ( decodeStack, + ) +where + +import Control.Monad +import Data.Bits +import Data.Maybe +import Foreign +import GHC.Exts +import GHC.Exts.Heap (Box (..)) +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Closures + ( RetFunType (..), + StackFrame, + GenStackFrame (..), + StgStackClosure, + GenStgStackClosure (..), + StackField, + GenStackField(..) + ) +import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS) +import GHC.Exts.Heap.InfoTable +import GHC.Exts.Stack.Constants +import GHC.IO (IO (..)) +import GHC.Stack.CloneStack +import GHC.Word +import Prelude + +{- Note [Decoding the stack] + ~~~~~~~~~~~~~~~~~~~~~~~~~ + +The stack is represented by a chain of StgStack closures. Each of these closures +is subject to garbage collection. I.e. they can be moved in memory (in a +simplified perspective) at any time. + +The array of closures inside an StgStack (that makeup the execution stack; the +stack frames) is moved as bare memory by the garbage collector. References +(pointers) to stack frames are not updated by the garbage collector. + +As the StgStack closure is moved as whole, the relative offsets inside it stay +the same. (Though, the absolute addresses change!) + +Decoding +======== + +Stack frames are defined by their `StackSnapshot#` (`StgStack*` in RTS) and +their relative offset. This tuple is described by `StackFrameLocation`. + +`StackFrame` is an ADT for decoded stack frames. Regarding payload and fields we +have to deal with three cases: + +- If the payload can only be a closure, we put it in a `Box` for later decoding + by the heap closure functions. + +- If the payload can either be a closure or a word-sized value (this happens for + bitmap-encoded payloads), we use a `StackField` which is a sum type to + represent either a `Word` or a `Box`. + +- Fields that are just simple (i.e. non-closure) values are decoded as such. + +The decoding happens in two phases: + +1. The whole stack is decoded into `StackFrameLocation`s. + +2. All `StackFrameLocation`s are decoded into `StackFrame`s. + +`StackSnapshot#` parameters are updated by the garbage collector and thus safe +to hand around. + +The head of the stack frame array has offset (index) 0. To traverse the stack +frames the latest stack frame's offset is incremented by the closure size. The +unit of the offset is machine words (32bit or 64bit.) + +IO +== + +Unfortunately, ghc-heap decodes `Closure`s in `IO`. This leads to `StackFrames` +also being decoded in `IO`, due to references to `Closure`s. + +Technical details +================= + +- All access to StgStack/StackSnapshot# closures is made through Cmm code. This + keeps the closure from being moved by the garbage collector during the + operation. + +- As StgStacks are mainly used in Cmm and C code, much of the decoding logic is + implemented in Cmm and C. It's just easier to reuse existing helper macros and + functions, than reinventing them in Haskell. + +- Offsets and sizes of closures are imported from DerivedConstants.h via HSC. + This keeps the code very portable. +-} + +foreign import prim "getUnderflowFrameNextChunkzh" + getUnderflowFrameNextChunk# :: + StackSnapshot# -> Word# -> StackSnapshot# + +getUnderflowFrameNextChunk :: StackSnapshot# -> WordOffset -> StackSnapshot +getUnderflowFrameNextChunk stackSnapshot# index = + StackSnapshot (getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index)) + +foreign import prim "getWordzh" + getWord# :: + StackSnapshot# -> Word# -> Word# + +getWord :: StackSnapshot# -> WordOffset -> Word +getWord stackSnapshot# index = + W# (getWord# stackSnapshot# (wordOffsetToWord# index)) + +foreign import prim "getRetFunTypezh" getRetFunType# :: StackSnapshot# -> Word# -> Word# + +getRetFunType :: StackSnapshot# -> WordOffset -> RetFunType +getRetFunType stackSnapshot# index = + toEnum . fromInteger . toInteger $ + W# (getRetFunType# stackSnapshot# (wordOffsetToWord# index)) + +-- | Gets contents of a `LargeBitmap` (@StgLargeBitmap@) +-- +-- The first two arguments identify the location of the frame on the stack. +-- Returned is the `Addr#` of the @StgWord[]@ (bitmap) and it's size. +type LargeBitmapGetter = StackSnapshot# -> Word# -> (# Addr#, Word# #) + +foreign import prim "getLargeBitmapzh" getLargeBitmap# :: LargeBitmapGetter + +foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: LargeBitmapGetter + +foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: LargeBitmapGetter + +-- | Gets contents of a small bitmap (fitting in one @StgWord@) +-- +-- The first two arguments identify the location of the frame on the stack. +-- Returned is the bitmap and it's size. +type SmallBitmapGetter = StackSnapshot# -> Word# -> (# Word#, Word# #) + +foreign import prim "getSmallBitmapzh" getSmallBitmap# :: SmallBitmapGetter + +foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: SmallBitmapGetter + +foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr# + +foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# + +getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO StgInfoTable +getInfoTableOnStack stackSnapshot# index = + let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) + in peekItbl infoTablePtr + +getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable +getInfoTableForStack stackSnapshot# = + peekItbl $ + Ptr (getStackInfoTableAddr# stackSnapshot#) + +foreign import prim "getStackClosurezh" + getStackClosure# :: + StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #) + +foreign import prim "getStackFieldszh" + getStackFields# :: + StackSnapshot# -> (# Word32#, Word8#, Word8# #) + +getStackFields :: StackSnapshot# -> (Word32, Word8, Word8) +getStackFields stackSnapshot# = + case getStackFields# stackSnapshot# of + (# sSize#, sDirty#, sMarking# #) -> + (W32# sSize#, W8# sDirty#, W8# sMarking#) + +-- | `StackFrameLocation` of the top-most stack frame +stackHead :: StackSnapshot# -> StackFrameLocation +stackHead s# = (StackSnapshot s#, 0) -- GHC stacks are never empty + +-- | Advance to the next stack frame (if any) +-- +-- The last `Int#` in the result tuple is meant to be treated as bool +-- (has_next). +foreign import prim "advanceStackFrameLocationzh" + advanceStackFrameLocation# :: + StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #) + +-- | Advance to the next stack frame (if any) +advanceStackFrameLocation :: StackFrameLocation -> Maybe StackFrameLocation +advanceStackFrameLocation ((StackSnapshot stackSnapshot#), index) = + let !(# s', i', hasNext #) = advanceStackFrameLocation# stackSnapshot# (wordOffsetToWord# index) + in if I# hasNext > 0 + then Just (StackSnapshot s', primWordToWordOffset i') + else Nothing + where + primWordToWordOffset :: Word# -> WordOffset + primWordToWordOffset w# = fromIntegral (W# w#) + +getClosureBox :: StackSnapshot# -> WordOffset -> IO Box +getClosureBox stackSnapshot# index = + -- Beware! We have to put ptr into a Box immediately. Otherwise, the garbage + -- collector might move the referenced closure, without updating our reference + -- (pointer) to it. + IO $ \s -> + case getStackClosure# + stackSnapshot# + (wordOffsetToWord# index) + s of + (# s1, ptr #) -> + (# s1, Box ptr #) + +-- | Representation of @StgLargeBitmap@ (RTS) +data LargeBitmap = LargeBitmap + { largeBitmapSize :: Word, + largebitmapWords :: Ptr Word + } + +-- | Is a bitmap entry a closure pointer or a primitive non-pointer? +data Pointerness = Pointer | NonPointer + deriving (Show) + +decodeLargeBitmap :: LargeBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField] +decodeLargeBitmap getterFun# stackSnapshot# index relativePayloadOffset = do + let largeBitmap = case getterFun# stackSnapshot# (wordOffsetToWord# index) of + (# wordsAddr#, size# #) -> LargeBitmap (W# size#) (Ptr wordsAddr#) + bitmapWords <- largeBitmapToList largeBitmap + decodeBitmaps + stackSnapshot# + (index + relativePayloadOffset) + (bitmapWordsPointerness (largeBitmapSize largeBitmap) bitmapWords) + where + largeBitmapToList :: LargeBitmap -> IO [Word] + largeBitmapToList LargeBitmap {..} = + cWordArrayToList largebitmapWords $ + (usedBitmapWords . fromIntegral) largeBitmapSize + + cWordArrayToList :: Ptr Word -> Int -> IO [Word] + cWordArrayToList ptr size = mapM (peekElemOff ptr) [0 .. (size - 1)] + + usedBitmapWords :: Int -> Int + usedBitmapWords 0 = error "Invalid large bitmap size 0." + usedBitmapWords size = (size `div` fromIntegral wORD_SIZE_IN_BITS) + 1 + + bitmapWordsPointerness :: Word -> [Word] -> [Pointerness] + bitmapWordsPointerness size _ | size <= 0 = [] + bitmapWordsPointerness _ [] = [] + bitmapWordsPointerness size (w : wds) = + bitmapWordPointerness (min size (fromIntegral wORD_SIZE_IN_BITS)) w + ++ bitmapWordsPointerness (size - fromIntegral wORD_SIZE_IN_BITS) wds + +bitmapWordPointerness :: Word -> Word -> [Pointerness] +bitmapWordPointerness 0 _ = [] +bitmapWordPointerness bSize bitmapWord = + ( if (bitmapWord .&. 1) /= 0 + then NonPointer + else Pointer + ) + : bitmapWordPointerness + (bSize - 1) + (bitmapWord `shiftR` 1) + +decodeBitmaps :: StackSnapshot# -> WordOffset -> [Pointerness] -> IO [StackField] +decodeBitmaps stack# index ps = + zipWithM toPayload ps [index ..] + where + toPayload :: Pointerness -> WordOffset -> IO StackField + toPayload p i = case p of + NonPointer -> + pure $ StackWord (getWord stack# i) + Pointer -> StackBox <$> getClosureBox stack# i + +decodeSmallBitmap :: SmallBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField] +decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset = + let (bitmap, size) = case getterFun# stackSnapshot# (wordOffsetToWord# index) of + (# b#, s# #) -> (W# b#, W# s#) + in decodeBitmaps + stackSnapshot# + (index + relativePayloadOffset) + (bitmapWordPointerness size bitmap) + +unpackStackFrame :: StackFrameLocation -> IO StackFrame +unpackStackFrame (StackSnapshot stackSnapshot#, index) = do + info <- getInfoTableOnStack stackSnapshot# index + unpackStackFrame' info + where + unpackStackFrame' :: StgInfoTable -> IO StackFrame + unpackStackFrame' info = + case tipe info of + RET_BCO -> do + bco' <- getClosureBox stackSnapshot# (index + offsetStgClosurePayload) + -- The arguments begin directly after the payload's one element + bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# stackSnapshot# index (offsetStgClosurePayload + 1) + pure + RetBCO + { info_tbl = info, + bco = bco', + bcoArgs = bcoArgs' + } + RET_SMALL -> do + payload' <- decodeSmallBitmap getSmallBitmap# stackSnapshot# index offsetStgClosurePayload + pure $ + RetSmall + { info_tbl = info, + stack_payload = payload' + } + RET_BIG -> do + payload' <- decodeLargeBitmap getLargeBitmap# stackSnapshot# index offsetStgClosurePayload + pure $ + RetBig + { info_tbl = info, + stack_payload = payload' + } + RET_FUN -> do + let retFunType' = getRetFunType stackSnapshot# index + retFunSize' = getWord stackSnapshot# (index + offsetStgRetFunFrameSize) + retFunFun' <- getClosureBox stackSnapshot# (index + offsetStgRetFunFrameFun) + retFunPayload' <- + if retFunType' == ARG_GEN_BIG + then decodeLargeBitmap getRetFunLargeBitmap# stackSnapshot# index offsetStgRetFunFramePayload + else decodeSmallBitmap getRetFunSmallBitmap# stackSnapshot# index offsetStgRetFunFramePayload + pure $ + RetFun + { info_tbl = info, + retFunType = retFunType', + retFunSize = retFunSize', + retFunFun = retFunFun', + retFunPayload = retFunPayload' + } + UPDATE_FRAME -> do + updatee' <- getClosureBox stackSnapshot# (index + offsetStgUpdateFrameUpdatee) + pure $ + UpdateFrame + { info_tbl = info, + updatee = updatee' + } + CATCH_FRAME -> do + let exceptions_blocked' = getWord stackSnapshot# (index + offsetStgCatchFrameExceptionsBlocked) + handler' <- getClosureBox stackSnapshot# (index + offsetStgCatchFrameHandler) + pure $ + CatchFrame + { info_tbl = info, + exceptions_blocked = exceptions_blocked', + handler = handler' + } + UNDERFLOW_FRAME -> do + let nextChunk' = getUnderflowFrameNextChunk stackSnapshot# index + stackClosure <- decodeStack nextChunk' + pure $ + UnderflowFrame + { info_tbl = info, + nextChunk = stackClosure + } + STOP_FRAME -> pure $ StopFrame {info_tbl = info} + ATOMICALLY_FRAME -> do + atomicallyFrameCode' <- getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameCode) + result' <- getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameResult) + pure $ + AtomicallyFrame + { info_tbl = info, + atomicallyFrameCode = atomicallyFrameCode', + result = result' + } + CATCH_RETRY_FRAME -> do + let running_alt_code' = getWord stackSnapshot# (index + offsetStgCatchRetryFrameRunningAltCode) + first_code' <- getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameRunningFirstCode) + alt_code' <- getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameAltCode) + pure $ + CatchRetryFrame + { info_tbl = info, + running_alt_code = running_alt_code', + first_code = first_code', + alt_code = alt_code' + } + CATCH_STM_FRAME -> do + catchFrameCode' <- getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameCode) + handler' <- getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameHandler) + pure $ + CatchStmFrame + { info_tbl = info, + catchFrameCode = catchFrameCode', + handler = handler' + } + x -> error $ "Unexpected closure type on stack: " ++ show x + +-- | Unbox 'Int#' from 'Int' +toInt# :: Int -> Int# +toInt# (I# i) = i + +-- | Convert `Int` to `Word#` +intToWord# :: Int -> Word# +intToWord# i = int2Word# (toInt# i) + +wordOffsetToWord# :: WordOffset -> Word# +wordOffsetToWord# wo = intToWord# (fromIntegral wo) + +-- | Location of a stackframe on the stack +-- +-- It's defined by the `StackSnapshot` (@StgStack@) and the offset to the bottom +-- of the stack. +type StackFrameLocation = (StackSnapshot, WordOffset) + +-- | Decode `StackSnapshot` to a `StgStackClosure` +-- +-- The return value is the representation of the @StgStack@ itself. +-- +-- See /Note [Decoding the stack]/. +decodeStack :: StackSnapshot -> IO StgStackClosure +decodeStack (StackSnapshot stack#) = do + info <- getInfoTableForStack stack# + case tipe info of + STACK -> do + let (stack_size', stack_dirty', stack_marking') = getStackFields stack# + sfls = stackFrameLocations stack# + stack' <- mapM unpackStackFrame sfls + pure $ + GenStgStackClosure + { ssc_info = info, + ssc_stack_size = stack_size', + ssc_stack_dirty = stack_dirty', + ssc_stack_marking = stack_marking', + ssc_stack = stack' + } + _ -> error $ "Expected STACK closure, got " ++ show info + where + stackFrameLocations :: StackSnapshot# -> [StackFrameLocation] + stackFrameLocations s# = + stackHead s# + : go (advanceStackFrameLocation (stackHead s#)) + where + go :: Maybe StackFrameLocation -> [StackFrameLocation] + go Nothing = [] + go (Just r) = r : go (advanceStackFrameLocation r) + +#else +module GHC.Exts.Stack.Decode where +#endif ===================================== libraries/ghc-heap/cbits/Stack.c ===================================== @@ -0,0 +1,150 @@ +#include "MachDeps.h" +#include "Rts.h" +#include "RtsAPI.h" +#include "rts/Messages.h" +#include "rts/Types.h" +#include "rts/storage/ClosureTypes.h" +#include "rts/storage/Closures.h" +#include "rts/storage/InfoTables.h" + +StgWord stackFrameSize(StgStack *stack, StgWord index) { + StgClosure *c = (StgClosure *)stack->sp + index; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + return stack_frame_sizeW(c); +} + +StgStack *getUnderflowFrameStack(StgStack *stack, StgWord index) { + StgClosure *frame = (StgClosure *)stack->sp + index; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(frame)); + const StgRetInfoTable *info = get_ret_itbl((StgClosure *)frame); + + if (info->i.type == UNDERFLOW_FRAME) { + return ((StgUnderflowFrame *)frame)->next_chunk; + } else { + return NULL; + } +} + +// Only exists to make the get_itbl macro available in Haskell code (via FFI). +const StgInfoTable *getItbl(StgClosure *closure) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure)); + return get_itbl(closure); +}; + +StgWord getBitmapSize(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + const StgInfoTable *info = get_itbl(c); + StgWord bitmap = info->layout.bitmap; + return BITMAP_SIZE(bitmap); +} + +StgWord getRetFunBitmapSize(StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + switch (fun_info->f.fun_type) { + case ARG_GEN: + return BITMAP_SIZE(fun_info->f.b.bitmap); + case ARG_GEN_BIG: + return GET_FUN_LARGE_BITMAP(fun_info)->size; + default: + return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); + } +} + +StgWord getBitmapWord(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + const StgInfoTable *info = get_itbl(c); + StgWord bitmap = info->layout.bitmap; + StgWord bitmapWord = BITMAP_BITS(bitmap); + return bitmapWord; +} + +StgWord getRetFunBitmapWord(StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + switch (fun_info->f.fun_type) { + case ARG_GEN: + return BITMAP_BITS(fun_info->f.b.bitmap); + case ARG_GEN_BIG: + // Cannot do more than warn and exit. + errorBelch("Unexpected ARG_GEN_BIG StgRetFun closure %p", ret_fun); + stg_exit(EXIT_INTERNAL_ERROR); + default: + return BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); + } +} + +StgWord getLargeBitmapSize(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + const StgInfoTable *info = get_itbl(c); + StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info); + return bitmap->size; +} + +StgWord getRetFunSize(StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + switch (fun_info->f.fun_type) { + case ARG_GEN: + return BITMAP_SIZE(fun_info->f.b.bitmap); + case ARG_GEN_BIG: + return GET_FUN_LARGE_BITMAP(fun_info)->size; + default: + return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); + } +} + +StgWord getBCOLargeBitmapSize(StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + StgBCO *bco = (StgBCO *)*c->payload; + + return BCO_BITMAP_SIZE(bco); +} + +StgWord *getLargeBitmap(Capability *cap, StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + const StgInfoTable *info = get_itbl(c); + StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info); + + return bitmap->bitmap; +} + +StgWord *getRetFunLargeBitmap(Capability *cap, StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + StgLargeBitmap *bitmap = GET_FUN_LARGE_BITMAP(fun_info); + + return bitmap->bitmap; +} + +StgWord *getBCOLargeBitmap(Capability *cap, StgClosure *c) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + StgBCO *bco = (StgBCO *)*c->payload; + StgLargeBitmap *bitmap = BCO_BITMAP(bco); + + return bitmap->bitmap; +} + +StgStack *getUnderflowFrameNextChunk(StgUnderflowFrame *frame) { + return frame->next_chunk; +} + +StgWord getRetFunType(StgRetFun *ret_fun) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun)); + + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun)); + return fun_info->f.fun_type; +} + +StgClosure *getStackClosure(StgClosure **c) { return *c; } ===================================== libraries/ghc-heap/cbits/Stack.cmm ===================================== @@ -0,0 +1,187 @@ +// Uncomment to enable assertions during development +// #define DEBUG 1 + +#include "Cmm.h" + +// StgStack_marking was not available in the Stage0 compiler at the time of +// writing. Because, it has been added to derivedConstants when Stack.cmm was +// developed. +#if defined(StgStack_marking) + +// Returns the next stackframe's StgStack* and offset in it. And, an indicator +// if this frame is the last one (`hasNext` bit.) +// (StgStack*, StgWord, StgWord) advanceStackFrameLocationzh(StgStack* stack, StgWord offsetWords) +advanceStackFrameLocationzh (P_ stack, W_ offsetWords) { + W_ frameSize; + (frameSize) = ccall stackFrameSize(stack, offsetWords); + + P_ nextClosurePtr; + nextClosurePtr = (StgStack_sp(stack) + WDS(offsetWords) + WDS(frameSize)); + + P_ stackArrayPtr; + stackArrayPtr = stack + SIZEOF_StgHeader + OFFSET_StgStack_stack; + + P_ stackBottom; + W_ stackSize, stackSizeInBytes; + stackSize = TO_W_(StgStack_stack_size(stack)); + stackSizeInBytes = WDS(stackSize); + stackBottom = stackSizeInBytes + stackArrayPtr; + + P_ newStack; + W_ newOffsetWords, hasNext; + if(nextClosurePtr < stackBottom) (likely: True) { + newStack = stack; + newOffsetWords = offsetWords + frameSize; + hasNext = 1; + } else { + P_ underflowFrameStack; + (underflowFrameStack) = ccall getUnderflowFrameStack(stack, offsetWords); + if (underflowFrameStack == NULL) (likely: True) { + newStack = NULL; + newOffsetWords = NULL; + hasNext = NULL; + } else { + newStack = underflowFrameStack; + newOffsetWords = NULL; + hasNext = 1; + } + } + + return (newStack, newOffsetWords, hasNext); +} + +// (StgWord, StgWord) getSmallBitmapzh(StgStack* stack, StgWord offsetWords) +getSmallBitmapzh(P_ stack, W_ offsetWords) { + P_ c; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + W_ bitmap, size; + (bitmap) = ccall getBitmapWord(c); + (size) = ccall getBitmapSize(c); + + return (bitmap, size); +} + + +// (StgWord, StgWord) getRetFunSmallBitmapzh(StgStack* stack, StgWord offsetWords) +getRetFunSmallBitmapzh(P_ stack, W_ offsetWords) { + P_ c; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + W_ bitmap, size, specialType; + (bitmap) = ccall getRetFunBitmapWord(c); + (size) = ccall getRetFunBitmapSize(c); + + return (bitmap, size); +} + +// (StgWord*, StgWord) getLargeBitmapzh(StgStack* stack, StgWord offsetWords) +getLargeBitmapzh(P_ stack, W_ offsetWords) { + P_ c, words; + W_ size; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + (words) = ccall getLargeBitmap(MyCapability(), c); + (size) = ccall getLargeBitmapSize(c); + + return (words, size); +} + +// (StgWord*, StgWord) getBCOLargeBitmapzh(StgStack* stack, StgWord offsetWords) +getBCOLargeBitmapzh(P_ stack, W_ offsetWords) { + P_ c, words; + W_ size; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + (words) = ccall getBCOLargeBitmap(MyCapability(), c); + (size) = ccall getBCOLargeBitmapSize(c); + + return (words, size); +} + +// (StgWord*, StgWord) getRetFunLargeBitmapzh(StgStack* stack, StgWord offsetWords) +getRetFunLargeBitmapzh(P_ stack, W_ offsetWords) { + P_ c, words; + W_ size; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + (words) = ccall getRetFunLargeBitmap(MyCapability(), c); + (size) = ccall getRetFunSize(c); + + return (words, size); +} + +// (StgWord) getWordzh(StgStack* stack, StgWord offsetWords) +getWordzh(P_ stack, W_ offsetWords) { + P_ wordAddr; + wordAddr = (StgStack_sp(stack) + WDS(offsetWords)); + return (W_[wordAddr]); +} + +// (StgStack*) getUnderflowFrameNextChunkzh(StgStack* stack, StgWord offsetWords) +getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords) { + P_ closurePtr; + closurePtr = (StgStack_sp(stack) + WDS(offsetWords)); + ASSERT(LOOKS_LIKE_CLOURE_PTR(closurePtr)); + + P_ next_chunk; + (next_chunk) = ccall getUnderflowFrameNextChunk(closurePtr); + ASSERT(LOOKS_LIKE_CLOURE_PTR(next_chunk)); + return (next_chunk); +} + +// (StgWord) getRetFunTypezh(StgStack* stack, StgWord offsetWords) +getRetFunTypezh(P_ stack, W_ offsetWords) { + P_ c; + c = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(c)); + + W_ type; + (type) = ccall getRetFunType(c); + return (type); +} + +// (StgInfoTable*) getInfoTableAddrzh(StgStack* stack, StgWord offsetWords) +getInfoTableAddrzh(P_ stack, W_ offsetWords) { + P_ p, info; + p = StgStack_sp(stack) + WDS(offsetWords); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + info = %GET_STD_INFO(UNTAG(p)); + + return (info); +} + +// (StgInfoTable*) getStackInfoTableAddrzh(StgStack* stack) +getStackInfoTableAddrzh(P_ stack) { + P_ info; + info = %GET_STD_INFO(UNTAG(stack)); + return (info); +} + +// (StgClosure*) getStackClosurezh(StgStack* stack, StgWord offsetWords) +getStackClosurezh(P_ stack, W_ offsetWords) { + P_ ptr; + ptr = StgStack_sp(stack) + WDS(offsetWords); + + P_ closure; + (closure) = ccall getStackClosure(ptr); + return (closure); +} + +// (bits32, bits8, bits8) getStackFieldszh(StgStack* stack) +getStackFieldszh(P_ stack){ + bits32 size; + bits8 dirty, marking; + + size = StgStack_stack_size(stack); + dirty = StgStack_dirty(stack); + marking = StgStack_marking(stack); + + return (size, dirty, marking); +} +#endif ===================================== libraries/ghc-heap/ghc-heap.cabal.in ===================================== @@ -30,6 +30,8 @@ library ghc-options: -Wall if !os(ghcjs) cmm-sources: cbits/HeapPrim.cmm + cbits/Stack.cmm + c-sources: cbits/Stack.c default-extensions: NoImplicitPrelude @@ -48,3 +50,6 @@ library GHC.Exts.Heap.ProfInfo.PeekProfInfo GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled + GHC.Exts.Stack.Constants + GHC.Exts.Stack + GHC.Exts.Stack.Decode ===================================== libraries/ghc-heap/tests/TestUtils.hs ===================================== @@ -1,7 +1,54 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} -module TestUtils where +{-# LANGUAGE UnliftedFFITypes #-} -assertEqual :: (Show a, Eq a) => a -> a -> IO () +module TestUtils + ( assertEqual, + assertThat, + assertStackInvariants, + getDecodedStack, + unbox, + ) +where + +import Control.Monad.IO.Class +import Data.Array.Byte +import Data.Foldable +import Debug.Trace +import GHC.Exts +import GHC.Exts.Heap +import GHC.Exts.Heap.Closures +import GHC.Exts.Stack.Decode +import GHC.Records +import GHC.Stack (HasCallStack) +import GHC.Stack.CloneStack +import Unsafe.Coerce (unsafeCoerce) + +getDecodedStack :: IO (StackSnapshot, [StackFrame]) +getDecodedStack = do + stack <- cloneMyStack + stackClosure <- decodeStack stack + + pure (stack, ssc_stack stackClosure) + +assertEqual :: (HasCallStack, Monad m, Show a, Eq a) => a -> a -> m () assertEqual a b | a /= b = error (show a ++ " /= " ++ show b) - | otherwise = return () + | otherwise = pure () + +assertThat :: (HasCallStack, Monad m) => String -> (a -> Bool) -> a -> m () +assertThat s f a = if f a then pure () else error s + +assertStackInvariants :: (HasCallStack, MonadIO m) => [StackFrame] -> m () +assertStackInvariants decodedStack = + assertThat + "Last frame is stop frame" + ( \case + StopFrame info -> tipe info == STOP_FRAME + _ -> False + ) + (last decodedStack) + +unbox :: Box -> IO Closure +unbox = getBoxedClosureData ===================================== libraries/ghc-heap/tests/all.T ===================================== @@ -57,3 +57,48 @@ test('parse_tso_flags', test('T21622', only_ways(['normal']), compile_and_run, ['']) + +test('stack_big_ret', + [ + extra_files(['TestUtils.hs']), + ignore_stdout, + ignore_stderr + ], + compile_and_run, + ['']) + +# Options: +# - `-kc512B -kb64B`: Make stack chunk size small to provoke underflow +# stack frames. +test('stack_underflow', + [ + extra_files(['TestUtils.hs']), + extra_run_opts('+RTS -kc512B -kb64B -RTS'), + ignore_stdout, + ignore_stderr + ], + compile_and_run, + ['']) + +test('stack_stm_frames', + [ + extra_files(['TestUtils.hs']), + ignore_stdout, + ignore_stderr + ], + compile_and_run, + ['']) + +test('stack_misc_closures', + [ + extra_files(['stack_misc_closures_c.c', 'stack_misc_closures_prim.cmm', 'TestUtils.hs']), + ignore_stdout, + ignore_stderr + ], + multi_compile_and_run, + ['stack_misc_closures', + [ ('stack_misc_closures_c.c', '') + ,('stack_misc_closures_prim.cmm', '') + ] + , '-debug' # Debug RTS to use checkSTACK() (Sanity.c) + ]) ===================================== libraries/ghc-heap/tests/stack_big_ret.hs ===================================== @@ -0,0 +1,142 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import Control.Concurrent +import Data.IORef +import Data.Maybe +import GHC.Exts (StackSnapshot#) +import GHC.Exts.Heap +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.InfoTable.Types +import GHC.Exts.Stack.Decode +import GHC.IO.Unsafe +import GHC.Stack (HasCallStack) +import GHC.Stack.CloneStack +import System.IO (hPutStrLn, stderr) +import System.Mem +import TestUtils + +cloneStackReturnInt :: IORef (Maybe StackSnapshot) -> Int +cloneStackReturnInt ioRef = unsafePerformIO $ do + stackSnapshot <- cloneMyStack + + writeIORef ioRef (Just stackSnapshot) + + pure 42 + +-- | Clone a stack with a RET_BIG closure and decode it. +main :: HasCallStack => IO () +main = do + stackRef <- newIORef Nothing + + bigFun (cloneStackReturnInt stackRef) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 + + mbStackSnapshot <- readIORef stackRef + let stackSnapshot = fromJust mbStackSnapshot + stackClosure <- decodeStack stackSnapshot + let stackFrames = ssc_stack stackClosure + + assertStackInvariants stackFrames + assertThat + "Stack contains one big return frame" + (== 1) + (length $ filter isBigReturnFrame stackFrames) + let cs = (stack_payload . head) $ filter isBigReturnFrame stackFrames + let xs = zip [1 ..] cs + mapM_ (uncurry checkArg) xs + +checkArg :: Word -> StackField -> IO () +checkArg w sf = + case sf of + StackWord _ -> error "Unexpected payload type from bitmap." + StackBox b -> do + c <- getBoxedClosureData b + assertEqual CONSTR_0_1 $ (tipe . info) c + assertEqual "I#" (name c) + assertEqual "ghc-prim" (pkg c) + assertEqual "GHC.Types" (modl c) + assertEqual True $ (null . ptrArgs) c + assertEqual [w] (dataArgs c) + pure () + +isBigReturnFrame :: StackFrame -> Bool +isBigReturnFrame (RetBig info _) = tipe info == RET_BIG +isBigReturnFrame _ = False + +{-# NOINLINE bigFun #-} +bigFun :: + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + Int -> + IO () +bigFun !a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63 a64 a65 = + do + print $ a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59 + a60 + a61 + a62 + a63 + a64 + a65 + + pure () ===================================== libraries/ghc-heap/tests/stack_misc_closures.hs ===================================== @@ -0,0 +1,526 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedDatatypes #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import Data.Functor +import Debug.Trace +import GHC.Exts +import GHC.Exts.Heap +import GHC.Exts.Heap (getBoxedClosureData) +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.Closures (GenStackFrame (retFunFun), StackField) +import GHC.Exts.Stack +import GHC.Exts.Stack.Decode +import GHC.IO (IO (..)) +import GHC.Stack (HasCallStack) +import GHC.Stack.CloneStack (StackSnapshot (..)) +import System.Info +import System.Mem +import TestUtils +import Unsafe.Coerce (unsafeCoerce) + +foreign import prim "any_update_framezh" any_update_frame# :: SetupFunction + +foreign import prim "any_catch_framezh" any_catch_frame# :: SetupFunction + +foreign import prim "any_catch_stm_framezh" any_catch_stm_frame# :: SetupFunction + +foreign import prim "any_catch_retry_framezh" any_catch_retry_frame# :: SetupFunction + +foreign import prim "any_atomically_framezh" any_atomically_frame# :: SetupFunction + +foreign import prim "any_ret_small_prim_framezh" any_ret_small_prim_frame# :: SetupFunction + +foreign import prim "any_ret_small_prims_framezh" any_ret_small_prims_frame# :: SetupFunction + +foreign import prim "any_ret_small_closure_framezh" any_ret_small_closure_frame# :: SetupFunction + +foreign import prim "any_ret_small_closures_framezh" any_ret_small_closures_frame# :: SetupFunction + +foreign import prim "any_ret_big_prims_min_framezh" any_ret_big_prims_min_frame# :: SetupFunction + +foreign import prim "any_ret_big_closures_min_framezh" any_ret_big_closures_min_frame# :: SetupFunction + +foreign import prim "any_ret_big_closures_two_words_framezh" any_ret_big_closures_two_words_frame# :: SetupFunction + +foreign import prim "any_ret_fun_arg_n_prim_framezh" any_ret_fun_arg_n_prim_frame# :: SetupFunction + +foreign import prim "any_ret_fun_arg_gen_framezh" any_ret_fun_arg_gen_frame# :: SetupFunction + +foreign import prim "any_ret_fun_arg_gen_big_framezh" any_ret_fun_arg_gen_big_frame# :: SetupFunction + +foreign import prim "any_bco_framezh" any_bco_frame# :: SetupFunction + +foreign import prim "any_underflow_framezh" any_underflow_frame# :: SetupFunction + +foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word + +foreign import ccall "bitsInWord" bitsInWord :: Word + +{- Test stategy + ~~~~~~~~~~~~ + +- Create @StgStack at s in C that contain two frames: A stop frame and the frame +which's decoding should be tested. + +- Cmm primops are used to get `StackSnapshot#` values. (This detour ensures that +the closures are referenced by `StackSnapshot#` and not garbage collected right +away.) + +- These can then be decoded and checked. + +This strategy may look pretty complex for a test. But, it can provide very +specific corner cases that would be hard to (reliably!) produce in Haskell. + +N.B. `StackSnapshots` are managed by the garbage collector. It's important to +know that the GC may rewrite parts of the stack and that the stack must be sound +(otherwise, the GC may fail badly.) To find subtle garbage collection related +bugs, the GC is triggered several times. + +The decission to make `StackSnapshots`s (and their closures) being managed by the +GC isn't accidential. It's closer to the reality of decoding stacks. + +N.B. the test data stack are only meant be de decoded. They are not executable +(the result would likely be a crash or non-sense.) + +- Due to the implementation details of the test framework, the Debug.Trace calls +are only shown when the test fails. They are used as markers to see where the +test fails on e.g. a segfault (where the HasCallStack constraint isn't helpful.) +-} +main :: HasCallStack => IO () +main = do + traceM "Test 1" + test any_update_frame# $ + \case + UpdateFrame {..} -> do + assertEqual (tipe info_tbl) UPDATE_FRAME + assertEqual 1 =<< getWordFromBlackhole updatee + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 2" + testSize any_update_frame# 2 + traceM "Test 3" + test any_catch_frame# $ + \case + CatchFrame {..} -> do + assertEqual (tipe info_tbl) CATCH_FRAME + assertEqual exceptions_blocked 1 + assertConstrClosure 1 handler + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 4" + testSize any_catch_frame# 3 + traceM "Test 5" + test any_catch_stm_frame# $ + \case + CatchStmFrame {..} -> do + assertEqual (tipe info_tbl) CATCH_STM_FRAME + assertConstrClosure 1 catchFrameCode + assertConstrClosure 2 handler + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 6" + testSize any_catch_stm_frame# 3 + traceM "Test 7" + test any_catch_retry_frame# $ + \case + CatchRetryFrame {..} -> do + assertEqual (tipe info_tbl) CATCH_RETRY_FRAME + assertEqual running_alt_code 1 + assertConstrClosure 2 first_code + assertConstrClosure 3 alt_code + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 8" + testSize any_catch_retry_frame# 4 + traceM "Test 9" + test any_atomically_frame# $ + \case + AtomicallyFrame {..} -> do + assertEqual (tipe info_tbl) ATOMICALLY_FRAME + assertConstrClosure 1 atomicallyFrameCode + assertConstrClosure 2 result + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 10" + testSize any_atomically_frame# 3 + traceM "Test 11" + test any_ret_small_prim_frame# $ + \case + RetSmall {..} -> do + assertEqual (tipe info_tbl) RET_SMALL + assertEqual (length stack_payload) 1 + assertUnknownTypeWordSizedPrimitive 1 (head stack_payload) + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 12" + testSize any_ret_small_prim_frame# 2 + traceM "Test 13" + test any_ret_small_closure_frame# $ + \case + RetSmall {..} -> do + assertEqual (tipe info_tbl) RET_SMALL + assertEqual (length stack_payload) 1 + assertConstrClosure 1 $ (stackFieldClosure . head) stack_payload + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 14" + testSize any_ret_small_closure_frame# 2 + traceM "Test 15" + test any_ret_small_closures_frame# $ + \case + RetSmall {..} -> do + assertEqual (tipe info_tbl) RET_SMALL + assertEqual (length stack_payload) maxSmallBitmapBits + wds <- mapM (getWordFromConstr01 . stackFieldClosure) stack_payload + assertEqual wds [1 .. maxSmallBitmapBits] + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 16" + testSize any_ret_small_closures_frame# (1 + fromIntegral maxSmallBitmapBits_c) + traceM "Test 17" + test any_ret_small_prims_frame# $ + \case + RetSmall {..} -> do + assertEqual (tipe info_tbl) RET_SMALL + assertEqual (length stack_payload) maxSmallBitmapBits + let wds = map stackFieldWord stack_payload + assertEqual wds [1 .. maxSmallBitmapBits] + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 18" + testSize any_ret_small_prims_frame# (1 + fromIntegral maxSmallBitmapBits_c) + traceM "Test 19" + test any_ret_big_prims_min_frame# $ + \case + RetBig {..} -> do + assertEqual (tipe info_tbl) RET_BIG + assertEqual (length stack_payload) minBigBitmapBits + let wds = map stackFieldWord stack_payload + assertEqual wds [1 .. minBigBitmapBits] + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 20" + testSize any_ret_big_prims_min_frame# (minBigBitmapBits + 1) + traceM "Test 21" + test any_ret_big_closures_min_frame# $ + \case + RetBig {..} -> do + assertEqual (tipe info_tbl) RET_BIG + assertEqual (length stack_payload) minBigBitmapBits + wds <- mapM (getWordFromConstr01 . stackFieldClosure) stack_payload + assertEqual wds [1 .. minBigBitmapBits] + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 22" + testSize any_ret_big_closures_min_frame# (minBigBitmapBits + 1) + traceM "Test 23" + test any_ret_big_closures_two_words_frame# $ + \case + RetBig {..} -> do + assertEqual (tipe info_tbl) RET_BIG + let closureCount = fromIntegral $ bitsInWord + 1 + assertEqual (length stack_payload) closureCount + wds <- mapM (getWordFromConstr01 . stackFieldClosure) stack_payload + assertEqual wds [1 .. (fromIntegral closureCount)] + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 24" + testSize any_ret_big_closures_two_words_frame# (fromIntegral bitsInWord + 1 + 1) + traceM "Test 25" + test any_ret_fun_arg_n_prim_frame# $ + \case + RetFun {..} -> do + assertEqual (tipe info_tbl) RET_FUN + assertEqual retFunType ARG_N + assertEqual retFunSize 1 + assertFun01Closure 1 retFunFun + assertEqual (length retFunPayload) 1 + let wds = map stackFieldWord retFunPayload + assertEqual wds [1] + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 26" + test any_ret_fun_arg_gen_frame# $ + \case + RetFun {..} -> do + assertEqual (tipe info_tbl) RET_FUN + assertEqual retFunType ARG_GEN + assertEqual retFunSize 9 + retFunFun' <- getBoxedClosureData retFunFun + case retFunFun' of + FunClosure {..} -> do + assertEqual (tipe info) FUN_STATIC + assertEqual (null dataArgs) True + -- Darwin seems to have a slightly different layout regarding + -- function `argGenFun` + assertEqual (null ptrArgs) (os /= "darwin") + e -> error $ "Wrong closure type: " ++ show e + assertEqual (length retFunPayload) 9 + wds <- mapM (getWordFromConstr01 . stackFieldClosure) retFunPayload + assertEqual wds [1 .. 9] + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 27" + testSize any_ret_fun_arg_gen_frame# (3 + 9) + traceM "Test 28" + test any_ret_fun_arg_gen_big_frame# $ + \case + RetFun {..} -> do + assertEqual (tipe info_tbl) RET_FUN + assertEqual retFunType ARG_GEN_BIG + assertEqual retFunSize 59 + retFunFun' <- getBoxedClosureData retFunFun + case retFunFun' of + FunClosure {..} -> do + assertEqual (tipe info) FUN_STATIC + assertEqual (null dataArgs) True + assertEqual (null ptrArgs) True + e -> error $ "Wrong closure type: " ++ show e + assertEqual (length retFunPayload) 59 + wds <- mapM (getWordFromConstr01 . stackFieldClosure) retFunPayload + assertEqual wds [1 .. 59] + traceM "Test 29" + testSize any_ret_fun_arg_gen_big_frame# (3 + 59) + traceM "Test 30" + test any_bco_frame# $ + \case + RetBCO {..} -> do + assertEqual (tipe info_tbl) RET_BCO + assertEqual (length bcoArgs) 1 + wds <- mapM (getWordFromConstr01 . stackFieldClosure) bcoArgs + assertEqual wds [3] + bco' <- getBoxedClosureData bco + case bco' of + BCOClosure {..} -> do + assertEqual (tipe info) BCO + assertEqual arity 3 + assertEqual size 7 + assertArrWordsClosure [1] instrs + assertArrWordsClosure [2] literals + assertMutArrClosure [3] bcoptrs + assertEqual + [ 1, -- StgLargeBitmap size in words + 0 -- StgLargeBitmap first words + ] + bitmap + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + traceM "Test 31" + testSize any_bco_frame# 3 + traceM "Test 32" + test any_underflow_frame# $ + \case + UnderflowFrame {..} -> do + assertEqual (tipe info_tbl) UNDERFLOW_FRAME + assertEqual (tipe (ssc_info nextChunk)) STACK + assertEqual (ssc_stack_size nextChunk) 27 + assertEqual (ssc_stack_dirty nextChunk) 0 + assertEqual (ssc_stack_marking nextChunk) 0 + assertEqual (length (ssc_stack nextChunk)) 2 + case head (ssc_stack nextChunk) of + RetSmall {..} -> + assertEqual (tipe info_tbl) RET_SMALL + e -> error $ "Wrong closure type: " ++ show e + case last (ssc_stack nextChunk) of + StopFrame {..} -> + assertEqual (tipe info_tbl) STOP_FRAME + e -> error $ "Wrong closure type: " ++ show e + e -> error $ "Wrong closure type: " ++ show e + testSize any_underflow_frame# 2 + +type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #) + +test :: HasCallStack => SetupFunction -> (StackFrame -> IO ()) -> IO () +test setup assertion = do + stackSnapshot <- getStackSnapshot setup + performGC + traceM $ "entertainGC - " ++ entertainGC 100 + -- Run garbage collection now, to prevent later surprises: It's hard to debug + -- when the GC suddenly does it's work and there were bad closures or pointers. + -- Better fail early, here. + performGC + stackClosure <- decodeStack stackSnapshot + performGC + let stack = ssc_stack stackClosure + performGC + assert stack + where + assert :: [StackFrame] -> IO () + assert stack = do + assertStackInvariants stack + assertEqual (length stack) 2 + assertion $ head stack + +entertainGC :: Int -> String +entertainGC 0 = "0" +entertainGC x = show x ++ entertainGC (x - 1) + +testSize :: HasCallStack => SetupFunction -> Int -> IO () +testSize setup expectedSize = do + stackSnapshot <- getStackSnapshot setup + stackClosure <- decodeStack stackSnapshot + assertEqual expectedSize $ (stackFrameSize . head . ssc_stack) stackClosure + +-- | Get a `StackSnapshot` from test setup +-- +-- This function mostly resembles `cloneStack`. Though, it doesn't clone, but +-- just pulls a @StgStack@ from RTS to Haskell land. +getStackSnapshot :: SetupFunction -> IO StackSnapshot +getStackSnapshot action# = IO $ \s -> + case action# s of (# s1, stack #) -> (# s1, StackSnapshot stack #) + +assertConstrClosure :: HasCallStack => Word -> Box -> IO () +assertConstrClosure w c = + getBoxedClosureData c >>= \case + ConstrClosure {..} -> do + assertEqual (tipe info) CONSTR_0_1 + assertEqual dataArgs [w] + assertEqual (null ptrArgs) True + e -> error $ "Wrong closure type: " ++ show e + +assertArrWordsClosure :: HasCallStack => [Word] -> Box -> IO () +assertArrWordsClosure wds c = + getBoxedClosureData c >>= \case + ArrWordsClosure {..} -> do + assertEqual (tipe info) ARR_WORDS + assertEqual arrWords wds + e -> error $ "Wrong closure type: " ++ show e + +assertMutArrClosure :: HasCallStack => [Word] -> Box -> IO () +assertMutArrClosure wds c = + getBoxedClosureData c >>= \case + MutArrClosure {..} -> do + assertEqual (tipe info) MUT_ARR_PTRS_FROZEN_CLEAN + assertEqual wds =<< mapM getWordFromConstr01 mccPayload + e -> error $ "Wrong closure type: " ++ show e + +assertFun01Closure :: HasCallStack => Word -> Box -> IO () +assertFun01Closure w c = + getBoxedClosureData c >>= \case + FunClosure {..} -> do + assertEqual (tipe info) FUN_0_1 + assertEqual dataArgs [w] + assertEqual (null ptrArgs) True + e -> error $ "Wrong closure type: " ++ show e + +getWordFromConstr01 :: HasCallStack => Box -> IO Word +getWordFromConstr01 c = + getBoxedClosureData c >>= \case + ConstrClosure {..} -> pure $ head dataArgs + e -> error $ "Wrong closure type: " ++ show e + +getWordFromBlackhole :: HasCallStack => Box -> IO Word +getWordFromBlackhole c = + getBoxedClosureData c >>= \case + BlackholeClosure {..} -> getWordFromConstr01 indirectee + -- For test stability reasons: Expect that the blackhole might have been + -- resolved. + ConstrClosure {..} -> pure $ head dataArgs + e -> error $ "Wrong closure type: " ++ show e + +assertUnknownTypeWordSizedPrimitive :: HasCallStack => Word -> StackField -> IO () +assertUnknownTypeWordSizedPrimitive w stackField = + assertEqual (stackFieldWord stackField) w + +unboxSingletonTuple :: (# StackSnapshot# #) -> StackSnapshot# +unboxSingletonTuple (# s# #) = s# + +minBigBitmapBits :: Num a => a +minBigBitmapBits = 1 + maxSmallBitmapBits + +maxSmallBitmapBits :: Num a => a +maxSmallBitmapBits = fromIntegral maxSmallBitmapBits_c + +stackFieldClosure :: HasCallStack => StackField -> Box +stackFieldClosure (StackBox b) = b +stackFieldClosure w = error $ "Expected closure in a Box, got: " ++ show w + +stackFieldWord :: HasCallStack => StackField -> Word +stackFieldWord (StackWord w) = w +stackFieldWord c = error $ "Expected word, got: " ++ show c + +-- | A function with 59 arguments +-- +-- A small bitmap has @64 - 6 = 58@ entries on 64bit machines. On 32bit machines +-- it's less (for obvious reasons.) I.e. this function's bitmap a large one; +-- function type is @ARG_GEN_BIG at . +{-# NOINLINE argGenBigFun #-} +argGenBigFun :: + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word +argGenBigFun a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 = + a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59 + +-- | A function with more arguments than the pre-generated (@ARG_PPPPPPPP -> 8@) ones +-- have +-- +-- This results in a @ARG_GEN@ function (the number of arguments still fits in a +-- small bitmap). +{-# NOINLINE argGenFun #-} +argGenFun :: + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word -> + Word +argGenFun a1 a2 a3 a4 a5 a6 a7 a8 a9 = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 ===================================== libraries/ghc-heap/tests/stack_misc_closures_c.c ===================================== @@ -0,0 +1,357 @@ +#include "Rts.h" + +// See rts/Threads.c +#define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 3) + +// Copied from Cmm.h +#define SIZEOF_W SIZEOF_VOID_P +#define WDS(n) ((n)*SIZEOF_W) + +// Update frames are interpreted by the garbage collector. We play it some +// tricks here with a fake blackhole. +RTS_RET(test_fake_blackhole); +void create_any_update_frame(Capability *cap, StgStack *stack, StgWord w) { + StgUpdateFrame *updF = (StgUpdateFrame *)stack->sp; + SET_HDR(updF, &stg_upd_frame_info, CCS_SYSTEM); + // StgInd and a BLACKHOLE have the same structure + StgInd *blackhole = (StgInd *)allocate(cap, sizeofW(StgInd)); + SET_HDR(blackhole, &test_fake_blackhole_info, CCS_SYSTEM); + StgClosure *payload = rts_mkWord(cap, w); + blackhole->indirectee = payload; + updF->updatee = (StgClosure *)blackhole; +} + +void create_any_catch_frame(Capability *cap, StgStack *stack, StgWord w) { + StgCatchFrame *catchF = (StgCatchFrame *)stack->sp; + SET_HDR(catchF, &stg_catch_frame_info, CCS_SYSTEM); + StgClosure *payload = rts_mkWord(cap, w); + catchF->exceptions_blocked = 1; + catchF->handler = payload; +} + +void create_any_catch_stm_frame(Capability *cap, StgStack *stack, StgWord w) { + StgCatchSTMFrame *catchF = (StgCatchSTMFrame *)stack->sp; + SET_HDR(catchF, &stg_catch_stm_frame_info, CCS_SYSTEM); + StgClosure *payload1 = rts_mkWord(cap, w); + catchF->code = payload1; + StgClosure *payload2 = rts_mkWord(cap, w + 1); + catchF->handler = payload2; +} + +void create_any_catch_retry_frame(Capability *cap, StgStack *stack, StgWord w) { + StgCatchRetryFrame *catchRF = (StgCatchRetryFrame *)stack->sp; + SET_HDR(catchRF, &stg_catch_retry_frame_info, CCS_SYSTEM); + catchRF->running_alt_code = w++; + StgClosure *payload1 = rts_mkWord(cap, w++); + catchRF->first_code = payload1; + StgClosure *payload2 = rts_mkWord(cap, w); + catchRF->alt_code = payload2; +} + +void create_any_atomically_frame(Capability *cap, StgStack *stack, StgWord w) { + StgAtomicallyFrame *aF = (StgAtomicallyFrame *)stack->sp; + SET_HDR(aF, &stg_atomically_frame_info, CCS_SYSTEM); + StgClosure *payload1 = rts_mkWord(cap, w); + aF->code = payload1; + StgClosure *payload2 = rts_mkWord(cap, w + 1); + aF->result = payload2; +} + +void create_any_ret_small_prim_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &stg_ret_n_info, CCS_SYSTEM); + // The cast is a lie (w is interpreted as plain Word, not as pointer), but the + // memory layout fits. + c->payload[0] = (StgClosure *)w; +} + +void create_any_ret_small_closure_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &stg_ret_p_info, CCS_SYSTEM); + StgClosure *payload = rts_mkWord(cap, w); + c->payload[0] = payload; +} + +#define MAX_SMALL_BITMAP_BITS (BITS_IN(W_) - BITMAP_BITS_SHIFT) + +StgWord maxSmallBitmapBits() { return MAX_SMALL_BITMAP_BITS; } + +StgWord bitsInWord() { return BITS_IN(W_); } + +RTS_RET(test_small_ret_full_p); +void create_any_ret_small_closures_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_small_ret_full_p_info, CCS_SYSTEM); + for (int i = 0; i < MAX_SMALL_BITMAP_BITS; i++) { + StgClosure *payload1 = UNTAG_CLOSURE(rts_mkWord(cap, w)); + w++; + c->payload[i] = payload1; + } +} + +RTS_RET(test_small_ret_full_n); +void create_any_ret_small_prims_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_small_ret_full_n_info, CCS_SYSTEM); + for (int i = 0; i < MAX_SMALL_BITMAP_BITS; i++) { + c->payload[i] = (StgClosure *)w; + w++; + } +} + +#define MIN_LARGE_BITMAP_BITS (MAX_SMALL_BITMAP_BITS + 1) + +RTS_RET(test_big_ret_min_n); +void create_any_ret_big_prims_min_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_big_ret_min_n_info, CCS_SYSTEM); + + for (int i = 0; i < MIN_LARGE_BITMAP_BITS; i++) { + c->payload[i] = (StgClosure *)w; + w++; + } +} + +RTS_RET(test_big_ret_min_p); +void create_any_ret_big_closures_min_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_big_ret_min_p_info, CCS_SYSTEM); + + for (int i = 0; i < MIN_LARGE_BITMAP_BITS; i++) { + c->payload[i] = UNTAG_CLOSURE(rts_mkWord(cap, w)); + w++; + } +} + +#define TWO_WORDS_LARGE_BITMAP_BITS (BITS_IN(W_) + 1) + +RTS_RET(test_big_ret_two_words_p); +void create_any_ret_big_closures_two_words_frame(Capability *cap, + StgStack *stack, StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_big_ret_two_words_p_info, CCS_SYSTEM); + + for (int i = 0; i < TWO_WORDS_LARGE_BITMAP_BITS; i++) { + c->payload[i] = UNTAG_CLOSURE(rts_mkWord(cap, w)); + w++; + } +} + +RTS_RET(test_ret_fun); +RTS_RET(test_arg_n_fun_0_1); +void create_any_ret_fun_arg_n_prim_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgRetFun *c = (StgRetFun *)stack->sp; + c->info = &test_ret_fun_info; + StgClosure *f = + (StgClosure *)allocate(cap, sizeofW(StgClosure) + sizeofW(StgWord)); + SET_HDR(f, &test_arg_n_fun_0_1_info, ccs) + c->fun = f; + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(c->fun)); + c->size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]); + // The cast is a lie (w is interpreted as plain Word, not as pointer), but the + // memory layout fits. + c->payload[0] = (StgClosure *)w; + f->payload[0] = (StgClosure *)w; +} + +RTS_CLOSURE(Main_argGenFun_closure); +void create_any_ret_fun_arg_gen_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgRetFun *c = (StgRetFun *)stack->sp; + c->info = &test_ret_fun_info; + c->fun = &Main_argGenFun_closure; + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(c->fun)); + c->size = BITMAP_SIZE(fun_info->f.b.bitmap); + for (int i = 0; i < c->size; i++) { + c->payload[i] = rts_mkWord(cap, w++); + } +} + +RTS_CLOSURE(Main_argGenBigFun_closure); +void create_any_ret_fun_arg_gen_big_frame(Capability *cap, StgStack *stack, + StgWord w) { + StgRetFun *c = (StgRetFun *)stack->sp; + c->info = &test_ret_fun_info; + c->fun = &Main_argGenBigFun_closure; + const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(c->fun)); + c->size = GET_FUN_LARGE_BITMAP(fun_info)->size; + for (int i = 0; i < c->size; i++) { + c->payload[i] = rts_mkWord(cap, w++); + } +} + +RTS_RET(test_ret_bco); +void create_any_bco_frame(Capability *cap, StgStack *stack, StgWord w) { + StgClosure *c = (StgClosure *)stack->sp; + SET_HDR(c, &test_ret_bco_info, CCS_SYSTEM); + StgWord bcoSizeWords = + sizeofW(StgBCO) + sizeofW(StgLargeBitmap) + sizeofW(StgWord); + StgBCO *bco = (StgBCO *)allocate(cap, bcoSizeWords); + SET_HDR(bco, &stg_BCO_info, CCS_MAIN); + c->payload[0] = (StgClosure *)bco; + + bco->size = bcoSizeWords; + bco->arity = 3; + + StgArrBytes *instrs = + (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + sizeofW(StgWord)); + SET_HDR(instrs, &stg_ARR_WORDS_info, CCCS); + instrs->bytes = WDS(1); + instrs->payload[0] = w++; + bco->instrs = instrs; + + StgArrBytes *literals = + (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + sizeofW(StgWord)); + SET_HDR(literals, &stg_ARR_WORDS_info, CCCS); + bco->literals = literals; + literals->bytes = WDS(1); + literals->payload[0] = w++; + bco->literals = literals; + + StgWord ptrsSize = 1 + mutArrPtrsCardTableSize(1); + StgMutArrPtrs *ptrs = + (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + ptrsSize); + SET_HDR(ptrs, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, ccs); + ptrs->ptrs = 1; + ptrs->size = ptrsSize; + ptrs->payload[0] = rts_mkWord(cap, w); + bco->ptrs = ptrs; + + StgLargeBitmap *bitmap = (StgLargeBitmap *)bco->bitmap; + bitmap->size = 1; + bitmap->bitmap[0] = 0; // set bit 0 to 0 indicating a closure + c->payload[1] = (StgClosure *)rts_mkWord(cap, w); +} + +StgStack *any_ret_small_prim_frame(Capability *cap); + +void create_any_underflow_frame(Capability *cap, StgStack *stack, StgWord w) { + StgUnderflowFrame *underflowF = (StgUnderflowFrame *)stack->sp; + underflowF->info = &stg_stack_underflow_frame_info; + underflowF->next_chunk = any_ret_small_prim_frame(cap); +} + +// Import from Sanity.c - This implies that the test must be run with debug RTS +// only! +extern void checkSTACK(StgStack *stack); + +// Basically, a stripped down version of createThread() (regarding stack +// creation) +StgStack *setup(Capability *cap, StgWord closureSizeWords, + void (*f)(Capability *, StgStack *, StgWord)) { + StgWord totalSizeWords = + sizeofW(StgStack) + closureSizeWords + MIN_STACK_WORDS; + StgStack *stack = (StgStack *)allocate(cap, totalSizeWords); + SET_HDR(stack, &stg_STACK_info, CCS_SYSTEM); + stack->stack_size = totalSizeWords - sizeofW(StgStack); + stack->dirty = 0; + stack->marking = 0; + + StgPtr spBottom = stack->stack + stack->stack_size; + stack->sp = spBottom; + stack->sp -= sizeofW(StgStopFrame); + SET_HDR((StgClosure *)stack->sp, &stg_stop_thread_info, CCS_SYSTEM); + stack->sp -= closureSizeWords; + + // Pointers can easíly be confused with each other. Provide a start value for + // values (1) in closures and increment it after every usage. The goal is to + // have distinct values in the closure to ensure nothing gets mixed up. + f(cap, stack, 1); + + // Make a sanitiy check to find unsound closures before the GC and the decode + // code. + checkSTACK(stack); + return stack; +} + +StgStack *any_update_frame(Capability *cap) { + return setup(cap, sizeofW(StgUpdateFrame), &create_any_update_frame); +} + +StgStack *any_catch_frame(Capability *cap) { + return setup(cap, sizeofW(StgCatchFrame), &create_any_catch_frame); +} + +StgStack *any_catch_stm_frame(Capability *cap) { + return setup(cap, sizeofW(StgCatchSTMFrame), &create_any_catch_stm_frame); +} + +StgStack *any_catch_retry_frame(Capability *cap) { + return setup(cap, sizeofW(StgCatchRetryFrame), &create_any_catch_retry_frame); +} + +StgStack *any_atomically_frame(Capability *cap) { + return setup(cap, sizeofW(StgAtomicallyFrame), &create_any_atomically_frame); +} + +StgStack *any_ret_small_prim_frame(Capability *cap) { + return setup(cap, sizeofW(StgClosure) + sizeofW(StgWord), + &create_any_ret_small_prim_frame); +} + +StgStack *any_ret_small_closure_frame(Capability *cap) { + return setup(cap, sizeofW(StgClosure) + sizeofW(StgClosurePtr), + &create_any_ret_small_closure_frame); +} + +StgStack *any_ret_small_closures_frame(Capability *cap) { + return setup( + cap, sizeofW(StgClosure) + MAX_SMALL_BITMAP_BITS * sizeofW(StgClosurePtr), + &create_any_ret_small_closures_frame); +} + +StgStack *any_ret_small_prims_frame(Capability *cap) { + return setup(cap, + sizeofW(StgClosure) + MAX_SMALL_BITMAP_BITS * sizeofW(StgWord), + &create_any_ret_small_prims_frame); +} + +StgStack *any_ret_big_closures_min_frame(Capability *cap) { + return setup( + cap, sizeofW(StgClosure) + MIN_LARGE_BITMAP_BITS * sizeofW(StgClosure), + &create_any_ret_big_closures_min_frame); +} + +StgStack *any_ret_big_closures_two_words_frame(Capability *cap) { + return setup(cap, + sizeofW(StgClosure) + + TWO_WORDS_LARGE_BITMAP_BITS * sizeofW(StgClosure), + &create_any_ret_big_closures_two_words_frame); +} + +StgStack *any_ret_big_prims_min_frame(Capability *cap) { + return setup(cap, + sizeofW(StgClosure) + MIN_LARGE_BITMAP_BITS * sizeofW(StgWord), + &create_any_ret_big_prims_min_frame); +} + +StgStack *any_ret_fun_arg_n_prim_frame(Capability *cap) { + return setup(cap, sizeofW(StgRetFun) + sizeofW(StgWord), + &create_any_ret_fun_arg_n_prim_frame); +} + +StgStack *any_ret_fun_arg_gen_frame(Capability *cap) { + return setup(cap, sizeofW(StgRetFun) + 9 * sizeofW(StgClosure), + &create_any_ret_fun_arg_gen_frame); +} + +StgStack *any_ret_fun_arg_gen_big_frame(Capability *cap) { + return setup(cap, sizeofW(StgRetFun) + 59 * sizeofW(StgWord), + &create_any_ret_fun_arg_gen_big_frame); +} + +StgStack *any_bco_frame(Capability *cap) { + return setup(cap, sizeofW(StgClosure) + 2 * sizeofW(StgWord), + &create_any_bco_frame); +} + +StgStack *any_underflow_frame(Capability *cap) { + return setup(cap, sizeofW(StgUnderflowFrame), &create_any_underflow_frame); +} ===================================== libraries/ghc-heap/tests/stack_misc_closures_prim.cmm ===================================== @@ -0,0 +1,231 @@ +#include "Cmm.h" + +any_update_framezh() { + P_ stack; + (stack) = ccall any_update_frame(MyCapability() "ptr"); + return (stack); +} + +any_catch_framezh() { + P_ stack; + (stack) = ccall any_catch_frame(MyCapability() "ptr"); + return (stack); +} + +any_catch_stm_framezh() { + P_ stack; + (stack) = ccall any_catch_stm_frame(MyCapability() "ptr"); + return (stack); +} + +any_catch_retry_framezh() { + P_ stack; + (stack) = ccall any_catch_retry_frame(MyCapability() "ptr"); + return (stack); +} + +any_atomically_framezh() { + P_ stack; + (stack) = ccall any_atomically_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_small_prim_framezh() { + P_ stack; + (stack) = ccall any_ret_small_prim_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_small_prims_framezh() { + P_ stack; + (stack) = ccall any_ret_small_prims_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_small_closure_framezh() { + P_ stack; + (stack) = ccall any_ret_small_closure_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_small_closures_framezh() { + P_ stack; + (stack) = ccall any_ret_small_closures_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_big_prims_min_framezh() { + P_ stack; + (stack) = ccall any_ret_big_prims_min_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_big_closures_min_framezh() { + P_ stack; + (stack) = ccall any_ret_big_closures_min_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_big_closures_two_words_framezh() { + P_ stack; + (stack) = ccall any_ret_big_closures_two_words_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_fun_arg_n_prim_framezh() { + P_ stack; + (stack) = ccall any_ret_fun_arg_n_prim_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_fun_arg_gen_framezh() { + P_ stack; + (stack) = ccall any_ret_fun_arg_gen_frame(MyCapability() "ptr"); + return (stack); +} + +any_ret_fun_arg_gen_big_framezh() { + P_ stack; + (stack) = ccall any_ret_fun_arg_gen_big_frame(MyCapability() "ptr"); + return (stack); +} + +any_bco_framezh() { + P_ stack; + (stack) = ccall any_bco_frame(MyCapability() "ptr"); + return (stack); +} + +any_underflow_framezh() { + P_ stack; + (stack) = ccall any_underflow_frame(MyCapability() "ptr"); + return (stack); +} + +INFO_TABLE_RET ( test_small_ret_full_p, RET_SMALL, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +P_ ptr1, P_ ptr2, P_ ptr3, P_ ptr4, P_ ptr5, P_ ptr6, P_ ptr7, P_ ptr8, P_ ptr9, P_ ptr10, +P_ ptr11, P_ ptr12, P_ ptr13, P_ ptr14, P_ ptr15, P_ ptr16, P_ ptr17, P_ ptr18, P_ ptr19, P_ ptr20, +P_ ptr21, P_ ptr22, P_ ptr23, P_ ptr24, P_ ptr25, P_ ptr26, P_ ptr27 +) +#elif SIZEOF_VOID_P == 8 +P_ ptr1, P_ ptr2, P_ ptr3, P_ ptr4, P_ ptr5, P_ ptr6, P_ ptr7, P_ ptr8, P_ ptr9, P_ ptr10, +P_ ptr11, P_ ptr12, P_ ptr13, P_ ptr14, P_ ptr15, P_ ptr16, P_ ptr17, P_ ptr18, P_ ptr19, P_ ptr20, +P_ ptr21, P_ ptr22, P_ ptr23, P_ ptr24, P_ ptr25, P_ ptr26, P_ ptr27, P_ ptr28, P_ ptr29, P_ ptr30, +P_ ptr31, P_ ptr32, P_ ptr33, P_ ptr34, P_ ptr35, P_ ptr36, P_ ptr37, P_ ptr38, P_ ptr39, P_ ptr40, +P_ ptr41, P_ ptr42, P_ ptr43, P_ ptr44, P_ ptr45, P_ ptr46, P_ ptr47, P_ ptr48, P_ ptr49, P_ ptr50, +P_ ptr51, P_ ptr52, P_ ptr53, P_ ptr54, P_ ptr55, P_ ptr56, P_ ptr57, P_ ptr58 +) +#endif + return (/* no return values */) +{ + return (); +} + +INFO_TABLE_RET ( test_small_ret_full_n, RET_SMALL, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +W_ n1, W_ n2, W_ n3, W_ n4, W_ n5, W_ n6, W_ n7, W_ n8, W_ n9, W_ n10, +W_ n11, W_ n12, W_ n13, W_ n14, W_ n15, W_ n16, W_ n17, W_ n18, W_ n19, W_ n20, +W_ n21, W_ n22, W_ n23, W_ n24, W_ n25, W_ n26, W_ n27 +) +#elif SIZEOF_VOID_P == 8 +W_ n1, W_ n2, W_ n3, W_ n4, W_ n5, W_ n6, W_ n7, W_ n8, W_ n9, W_ n10, +W_ n11, W_ n12, W_ n13, W_ n14, W_ n15, W_ n16, W_ n17, W_ n18, W_ n19, W_ n20, +W_ n21, W_ n22, W_ n23, W_ n24, W_ n25, W_ n26, W_ n27, W_ n28, W_ n29, W_ n30, +W_ n31, W_ n32, W_ n33, W_ n34, W_ n35, W_ n36, W_ n37, W_ n38, W_ n39, W_ n40, +W_ n41, W_ n42, W_ n43, W_ n44, W_ n45, W_ n46, W_ n47, W_ n48, W_ n49, W_ n50, +W_ n51, W_ n52, W_ n53, W_ n54, W_ n55, W_ n56, W_ n57, W_ n58 +) +#endif + return (/* no return values */) +{ + return (); +} + +// Size of this large bitmap closure is: max size of small bitmap + 1 +INFO_TABLE_RET ( test_big_ret_min_n, RET_BIG, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +W_ n1, W_ n2, W_ n3, W_ n4, W_ n5, W_ n6, W_ n7, W_ n8, W_ n9, W_ n10, +W_ n11, W_ n12, W_ n13, W_ n14, W_ n15, W_ n16, W_ n17, W_ n18, W_ n19, W_ n20, +W_ n21, W_ n22, W_ n23, W_ n24, W_ n25, W_ n26, W_ n27, W_ n28 +#elif SIZEOF_VOID_P == 8 +W_ n1, W_ n2, W_ n3, W_ n4, W_ n5, W_ n6, W_ n7, W_ n8, W_ n9, W_ n10, +W_ n11, W_ n12, W_ n13, W_ n14, W_ n15, W_ n16, W_ n17, W_ n18, W_ n19, W_ n20, +W_ n21, W_ n22, W_ n23, W_ n24, W_ n25, W_ n26, W_ n27, W_ n28, W_ n29, W_ n30, +W_ n31, W_ n32, W_ n33, W_ n34, W_ n35, W_ n36, W_ n37, W_ n38, W_ n39, W_ n40, +W_ n41, W_ n42, W_ n43, W_ n44, W_ n45, W_ n46, W_ n47, W_ n48, W_ n49, W_ n50, +W_ n51, W_ n52, W_ n53, W_ n54, W_ n55, W_ n56, W_ n57, W_ n58, W_ n59 +#endif +) + return (/* no return values */) +{ + return (); +} + +// Size of this large bitmap closure is: max size of small bitmap + 1 +INFO_TABLE_RET ( test_big_ret_min_p, RET_BIG, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +P_ p1, P_ p2, P_ p3, P_ p4, P_ p5, P_ p6, P_ p7, P_ p8, P_ p9, P_ p10, +P_ p11, P_ p12, P_ p13, P_ p14, P_ p15, P_ p16, P_ p17, P_ p18, P_ p19, P_ p20, +P_ p21, P_ p22, P_ p23, P_ p24, P_ p25, P_ p26, P_ p27, P_ p28 +#elif SIZEOF_VOID_P == 8 +P_ p1, P_ p2, P_ p3, P_ p4, P_ p5, P_ p6, P_ p7, P_ p8, P_ p9, P_ p10, +P_ p11, P_ p12, P_ p13, P_ p14, P_ p15, P_ p16, P_ p17, P_ p18, P_ p19, P_ p20, +P_ p21, P_ p22, P_ p23, P_ p24, P_ p25, P_ p26, P_ p27, P_ p28, P_ p29, P_ p30, +P_ p31, P_ p32, P_ p33, P_ p34, P_ p35, P_ p36, P_ p37, P_ p38, P_ p39, P_ p40, +P_ p41, P_ p42, P_ p43, P_ p44, P_ p45, P_ p46, P_ p47, P_ p48, P_ p49, P_ p50, +P_ p51, P_ p52, P_ p53, P_ p54, P_ p55, P_ p56, P_ p57, P_ p58, P_ p59 +#endif +) + return (/* no return values */) +{ + return (); +} + +// Size of this large bitmap closure is: max size of bits in machine word + 1. +// This results in a two word StgLargeBitmap. +INFO_TABLE_RET ( test_big_ret_two_words_p, RET_BIG, W_ info_ptr, +#if SIZEOF_VOID_P == 4 +P_ p1, P_ p2, P_ p3, P_ p4, P_ p5, P_ p6, P_ p7, P_ p8, P_ p9, P_ p10, +P_ p11, P_ p12, P_ p13, P_ p14, P_ p15, P_ p16, P_ p17, P_ p18, P_ p19, P_ p20, +P_ p21, P_ p22, P_ p23, P_ p24, P_ p25, P_ p26, P_ p27, P_ p28, P_ p29, P_ p30, +P_ p31, P_ p32, P_ p33 +#elif SIZEOF_VOID_P == 8 +P_ p1, P_ p2, P_ p3, P_ p4, P_ p5, P_ p6, P_ p7, P_ p8, P_ p9, P_ p10, +P_ p11, P_ p12, P_ p13, P_ p14, P_ p15, P_ p16, P_ p17, P_ p18, P_ p19, P_ p20, +P_ p21, P_ p22, P_ p23, P_ p24, P_ p25, P_ p26, P_ p27, P_ p28, P_ p29, P_ p30, +P_ p31, P_ p32, P_ p33, P_ p34, P_ p35, P_ p36, P_ p37, P_ p38, P_ p39, P_ p40, +P_ p41, P_ p42, P_ p43, P_ p44, P_ p45, P_ p46, P_ p47, P_ p48, P_ p49, P_ p50, +P_ p51, P_ p52, P_ p53, P_ p54, P_ p55, P_ p56, P_ p57, P_ p58, P_ p59, P_ p60, +P_ p61, P_ p62, P_ p63, P_ p64, P_ p65 +#endif +) + return (/* no return values */) +{ + return (); +} + +// A BLACKHOLE without any code. Just a placeholder to keep the GC happy. +INFO_TABLE( test_fake_blackhole, 1, 0, BLACKHOLE, "BLACKHOLE", "BLACKHOLE") + (P_ node) +{ + return (); +} + +INFO_TABLE_RET ( test_ret_fun, RET_FUN, W_ info_ptr, W_ size, P_ fun, P_ payload) + return (/* no return values */) +{ + return (); +} + +INFO_TABLE_FUN ( test_arg_n_fun_0_1, 0 , 0, FUN_0_1, "FUN_0_1", "FUN_0_1", 1, ARG_N) + return (/* no return values */) +{ + return (); +} + +INFO_TABLE_RET( test_ret_bco, RET_BCO) + return (/* no return values */) +{ + return (); +} ===================================== libraries/ghc-heap/tests/stack_stm_frames.hs ===================================== @@ -0,0 +1,38 @@ +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Control.Concurrent.STM +import Control.Exception +import GHC.Conc +import GHC.Exts.Heap +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.InfoTable.Types +import GHC.Exts.Stack.Decode +import GHC.Stack.CloneStack +import TestUtils + +main :: IO () +main = do + (stackSnapshot, decodedStack) <- + atomically $ + catchSTM @SomeException (unsafeIOToSTM getDecodedStack) throwSTM + + assertStackInvariants decodedStack + assertThat + "Stack contains one catch stm frame" + (== 1) + (length $ filter isCatchStmFrame decodedStack) + assertThat + "Stack contains one atomically frame" + (== 1) + (length $ filter isAtomicallyFrame decodedStack) + +isCatchStmFrame :: StackFrame -> Bool +isCatchStmFrame (CatchStmFrame {..}) = tipe info_tbl == CATCH_STM_FRAME +isCatchStmFrame _ = False + +isAtomicallyFrame :: StackFrame -> Bool +isAtomicallyFrame (AtomicallyFrame {..}) = tipe info_tbl == ATOMICALLY_FRAME +isAtomicallyFrame _ = False ===================================== libraries/ghc-heap/tests/stack_underflow.hs ===================================== @@ -0,0 +1,49 @@ +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Control.Monad +import Data.Bool (Bool (True)) +import GHC.Exts.Heap +import GHC.Exts.Heap.ClosureTypes +import GHC.Exts.Heap.Closures +import GHC.Exts.Heap.InfoTable.Types +import GHC.Exts.Stack.Decode +import GHC.Stack (HasCallStack) +import GHC.Stack.CloneStack +import TestUtils + +main = loop 256 + +{-# NOINLINE loop #-} +loop 0 = Control.Monad.void getStack +loop n = print "x" >> loop (n - 1) >> print "x" + +getStack :: HasCallStack => IO () +getStack = do + (s, decodedStack) <- getDecodedStack + assertStackInvariants decodedStack + assertThat + "Stack contains underflow frames" + (== True) + (any isUnderflowFrame decodedStack) + assertStackChunksAreDecodable decodedStack + return () + +isUnderflowFrame :: StackFrame -> Bool +isUnderflowFrame (UnderflowFrame {..}) = tipe info_tbl == UNDERFLOW_FRAME +isUnderflowFrame _ = False + +assertStackChunksAreDecodable :: HasCallStack => [StackFrame] -> IO () +assertStackChunksAreDecodable s = do + let underflowFrames = filter isUnderflowFrame s + assertThat + ("Expect some underflow frames. Got " ++ show (length underflowFrames)) + (>= 2) + (length underflowFrames) + let stackFrames = map (ssc_stack . nextChunk) underflowFrames + assertThat + "No empty stack chunks" + (== True) + ( not (any null stackFrames) + ) ===================================== rts/Printer.c ===================================== @@ -259,79 +259,79 @@ printClosure( const StgClosure *obj ) case UPDATE_FRAME: { - StgUpdateFrame* u = (StgUpdateFrame*)obj; + StgUpdateFrame* frame = (StgUpdateFrame*)obj; debugBelch("%s(", info_update_frame(obj)); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); + printPtr((StgPtr)GET_INFO((StgClosure *)frame)); debugBelch(","); - printPtr((StgPtr)u->updatee); + printPtr((StgPtr)frame->updatee); debugBelch(")\n"); break; } case CATCH_FRAME: { - StgCatchFrame* u = (StgCatchFrame*)obj; + StgCatchFrame* frame = (StgCatchFrame*)obj; debugBelch("CATCH_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); + printPtr((StgPtr)GET_INFO((StgClosure *)frame)); debugBelch(","); - printPtr((StgPtr)u->handler); + printPtr((StgPtr)frame->handler); debugBelch(")\n"); break; } case UNDERFLOW_FRAME: { - StgUnderflowFrame* u = (StgUnderflowFrame*)obj; + StgUnderflowFrame* frame = (StgUnderflowFrame*)obj; debugBelch("UNDERFLOW_FRAME("); - printPtr((StgPtr)u->next_chunk); + printPtr((StgPtr)frame->next_chunk); debugBelch(")\n"); break; } case STOP_FRAME: { - StgStopFrame* u = (StgStopFrame*)obj; + StgStopFrame* frame = (StgStopFrame*)obj; debugBelch("STOP_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); + printPtr((StgPtr)GET_INFO((StgClosure *)frame)); debugBelch(")\n"); break; } case ATOMICALLY_FRAME: { - StgAtomicallyFrame* u = (StgAtomicallyFrame*)obj; + StgAtomicallyFrame* frame = (StgAtomicallyFrame*)obj; debugBelch("ATOMICALLY_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); + printPtr((StgPtr)GET_INFO((StgClosure *)frame)); debugBelch(","); - printPtr((StgPtr)u->code); + printPtr((StgPtr)frame->code); debugBelch(","); - printPtr((StgPtr)u->result); + printPtr((StgPtr)frame->result); debugBelch(")\n"); break; } case CATCH_RETRY_FRAME: { - StgCatchRetryFrame* u = (StgCatchRetryFrame*)obj; + StgCatchRetryFrame* frame = (StgCatchRetryFrame*)obj; debugBelch("CATCH_RETRY_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); + printPtr((StgPtr)GET_INFO((StgClosure *)frame)); debugBelch(","); - printPtr((StgPtr)u->first_code); + printPtr((StgPtr)frame->first_code); debugBelch(","); - printPtr((StgPtr)u->alt_code); + printPtr((StgPtr)frame->alt_code); debugBelch(")\n"); break; } case CATCH_STM_FRAME: { - StgCatchSTMFrame* u = (StgCatchSTMFrame*)obj; + StgCatchSTMFrame* frame = (StgCatchSTMFrame*)obj; debugBelch("CATCH_STM_FRAME("); - printPtr((StgPtr)GET_INFO((StgClosure *)u)); + printPtr((StgPtr)GET_INFO((StgClosure *)frame)); debugBelch(","); - printPtr((StgPtr)u->code); + printPtr((StgPtr)frame->code); debugBelch(","); - printPtr((StgPtr)u->handler); + printPtr((StgPtr)frame->handler); debugBelch(")\n"); break; } @@ -715,17 +715,17 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type); switch (fun_info->f.fun_type) { case ARG_GEN: - printSmallBitmap(spBottom, sp+2, + printSmallBitmap(spBottom, (StgPtr) &ret_fun->payload, BITMAP_BITS(fun_info->f.b.bitmap), BITMAP_SIZE(fun_info->f.b.bitmap)); break; case ARG_GEN_BIG: - printLargeBitmap(spBottom, sp+2, + printLargeBitmap(spBottom, (StgPtr) &ret_fun->payload, GET_FUN_LARGE_BITMAP(fun_info), GET_FUN_LARGE_BITMAP(fun_info)->size); break; default: - printSmallBitmap(spBottom, sp+2, + printSmallBitmap(spBottom, (StgPtr) &ret_fun->payload, BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type])); break; ===================================== rts/include/rts/storage/InfoTables.h ===================================== @@ -122,7 +122,7 @@ extern const StgWord16 closure_flags[]; /* * A large bitmap. */ -typedef struct { +typedef struct StgLargeBitmap_ { StgWord size; StgWord bitmap[]; } StgLargeBitmap; ===================================== rts/sm/Sanity.c ===================================== @@ -42,7 +42,6 @@ int isHeapAlloced ( StgPtr p); static void checkSmallBitmap ( StgPtr payload, StgWord bitmap, uint32_t ); static void checkLargeBitmap ( StgPtr payload, StgLargeBitmap*, uint32_t ); static void checkClosureShallow ( const StgClosure * ); -static void checkSTACK (StgStack *stack); static void checkCompactObjects (bdescr *bd); @@ -725,7 +724,7 @@ checkCompactObjects(bdescr *bd) } } -static void +void checkSTACK (StgStack *stack) { StgPtr sp = stack->sp; @@ -1341,5 +1340,4 @@ memInventory (bool show) } - #endif /* DEBUG */ ===================================== rts/sm/Sanity.h ===================================== @@ -39,6 +39,7 @@ void memInventory (bool show); void checkBQ (StgTSO *bqe, StgClosure *closure); +void checkSTACK (StgStack *stack); #include "EndPrivate.h" #endif /* DEBUG */ ===================================== utils/deriveConstants/Main.hs ===================================== @@ -475,6 +475,7 @@ wanteds os = concat ,closureFieldOffset Both "StgStack" "stack" ,closureField C "StgStack" "stack_size" ,closureField C "StgStack" "dirty" + ,closureField C "StgStack" "marking" ,structSize C "StgTSOProfInfo" @@ -483,6 +484,11 @@ wanteds os = concat ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" + ,structSize C "StgRetFun" + ,fieldOffset C "StgRetFun" "size" + ,fieldOffset C "StgRetFun" "fun" + ,fieldOffset C "StgRetFun" "payload" + ,closureSize C "StgPAP" ,closureField C "StgPAP" "n_args" ,closureFieldGcptr C "StgPAP" "fun" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a661ec564e5bab4c0cadb1af9ba2566b9b610df3...e778d8320606726a820f7f351b87f94e0f5a9888 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a661ec564e5bab4c0cadb1af9ba2566b9b610df3...e778d8320606726a820f7f351b87f94e0f5a9888 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 18:40:35 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 14:40:35 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] Move "target has RTS linker" out of settings Message-ID: <6459422358216_38ffda5c8c2e70521925@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: d81375a9 by Rodrigo Mesquita at 2023-05-08T19:38:32+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4727,8 +4727,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . ===================================== compiler/GHC/Platform.hs ===================================== @@ -271,6 +271,20 @@ platformCConvNeedsExtension platform = case platformArch platform of | OSDarwin <- platformOS platform -> True _ -> False +-- | Does this platform have an RTS linker? +platformHasRTSLinker :: Platform -> Bool +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- powerpc + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + -------------------------------------------------- -- Instruction sets ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -451,7 +451,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -126,7 +126,9 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- For this information, we can only either query either ghc --info, or the + -- test settings (which indirectly queried ghc --info) + rtsLinker <- getBooleanSetting TestGhcWithRtsLinker return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d81375a902bf1b7fb0c88c729a065c5b1881797c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d81375a902bf1b7fb0c88c729a065c5b1881797c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 18:53:55 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 08 May 2023 14:53:55 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] Move "target has RTS linker" out of settings Message-ID: <645945439c359_38ffda5e198f08536990@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: 66a4b0c5 by Rodrigo Mesquita at 2023-05-08T19:53:46+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4727,8 +4727,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . ===================================== compiler/GHC/Platform.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Platform , platformInIntRange , platformInWordRange , platformCConvNeedsExtension + , platformHasRTSLinker , PlatformMisc(..) , SseVersion (..) , BmiVersion (..) @@ -271,6 +272,20 @@ platformCConvNeedsExtension platform = case platformArch platform of | OSDarwin <- platformOS platform -> True _ -> False +-- | Does this platform have an RTS linker? +platformHasRTSLinker :: Platform -> Bool +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- powerpc + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + -------------------------------------------------- -- Instruction sets ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -451,7 +451,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -126,7 +126,9 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- For this information, we can only either query either ghc --info, or the + -- test settings (which indirectly queried ghc --info) + rtsLinker <- getBooleanSetting TestGhcWithRtsLinker return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66a4b0c5c160658042f542f962a3d10d3644a40b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66a4b0c5c160658042f542f962a3d10d3644a40b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 19:00:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 May 2023 15:00:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: docs: Remove mentions of ArrayArray# from unlifted FFI section Message-ID: <645946d72d381_38ffda5ed1d388539734@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 888e9b81 by Torsten Schmits at 2023-05-08T15:00:24-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 28 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/exts/ffi.rst - docs/users_guide/using-warnings.rst - rts/RtsStartup.c - testsuite/tests/mdo/should_compile/mdo002.hs - testsuite/tests/polykinds/MonoidsFD.hs - testsuite/tests/polykinds/MonoidsTF.hs - testsuite/tests/profiling/should_run/T3001-2.hs - testsuite/tests/profiling/should_run/ioprof.hs - testsuite/tests/rebindable/rebindable2.hs - testsuite/tests/rebindable/rebindable2.stdout - testsuite/tests/simplCore/T9646/StrictPrim.hs - testsuite/tests/simplCore/should_run/T17744A.hs - testsuite/tests/simplCore/should_run/T3591.hs - testsuite/tests/typecheck/should_run/T1735_Help/State.hs - testsuite/tests/typecheck/should_run/T4809_IdentityT.hs - testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs - testsuite/tests/wcompat-warnings/Template.hs - testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -929,6 +929,7 @@ minusWcompatOpts :: [WarningFlag] minusWcompatOpts = [ Opt_WarnSemigroup , Opt_WarnNonCanonicalMonoidInstances + , Opt_WarnNonCanonicalMonadInstances , Opt_WarnCompatUnqualifiedImports , Opt_WarnTypeEqualityOutOfScope ] ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -65,6 +65,8 @@ interfaceErrorHints = \ case missingInterfaceErrorHints err Can'tFindNameInInterface {} -> noHints + CircularImport {} -> + noHints missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] missingInterfaceErrorHints = \case @@ -86,6 +88,8 @@ interfaceErrorReason (Can'tFindInterface err _) = missingInterfaceErrorReason err interfaceErrorReason (Can'tFindNameInInterface {}) = ErrorWithoutFlag +interfaceErrorReason (CircularImport {}) + = ErrorWithoutFlag missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason missingInterfaceErrorReason = \ case @@ -287,6 +291,9 @@ interfaceErrorDiagnostic opts = \ case LookingForSig sig -> hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) 2 (missingInterfaceErrorDiagnostic opts err) + CircularImport mod -> + text "Circular imports: module" <+> quotes (ppr mod) + <+> text "depends on itself" readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc readInterfaceErrorDiagnostic = \ case ===================================== compiler/GHC/Iface/Errors/Types.hs ===================================== @@ -45,6 +45,7 @@ data IfaceMessage | Can'tFindNameInInterface Name [TyThing] -- possibly relevant TyThings + | CircularImport !Module deriving Generic data MissingInterfaceError ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -605,7 +605,7 @@ tcHiBootIface hsc_src mod (LookingForHiBoot mod) in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. - NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) + NotBoot -> failWithTc (TcRnInterfaceError (CircularImport mod)) -- Someone below us imported us! -- This is a loop with no hi-boot in the way }}}} @@ -613,11 +613,6 @@ tcHiBootIface hsc_src mod need = text "Need the hi-boot interface for" <+> ppr mod <+> text "to compare against the Real Thing" - moduleLoop = text "Circular imports: module" <+> quotes (ppr mod) - <+> text "depends on itself" - - - mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo mkSelfBootInfo iface mds = do -- NB: This is computed DIRECTLY from the ModIface rather ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -22,7 +22,6 @@ import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr ) import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls ) import GHC.Hs -import GHC.Types.Error import GHC.Types.FieldLabel import GHC.Types.Name.Reader import GHC.Rename.HsType @@ -452,11 +451,9 @@ checkCanonicalInstances :: Name -> LHsSigType GhcRn -> LHsBinds GhcRn -> RnM () checkCanonicalInstances cls poly_ty mbinds = do whenWOptM Opt_WarnNonCanonicalMonadInstances $ checkCanonicalMonadInstances - "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return" whenWOptM Opt_WarnNonCanonicalMonoidInstances $ checkCanonicalMonoidInstances - "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid" where -- Warn about unsound/non-canonical 'Applicative'/'Monad' instance @@ -472,19 +469,17 @@ checkCanonicalInstances cls poly_ty mbinds = do -- * Warn if 'pure' is defined backwards (i.e. @pure = return@). -- * Warn if '(*>)' is defined backwards (i.e. @(*>) = (>>)@). -- - checkCanonicalMonadInstances refURL + checkCanonicalMonadInstances | cls == applicativeClassName = forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpanA loc $ case mbind of FunBind { fun_id = L _ name , fun_matches = mg } | name == pureAName, isAliasMG mg == Just returnMName - -> addWarnNonCanonicalMethod1 refURL - Opt_WarnNonCanonicalMonadInstances "pure" "return" + -> addWarnNonCanonicalMonad NonCanonical_Pure | name == thenAName, isAliasMG mg == Just thenMName - -> addWarnNonCanonicalMethod1 refURL - Opt_WarnNonCanonicalMonadInstances "(*>)" "(>>)" + -> addWarnNonCanonicalMonad NonCanonical_ThenA _ -> return () @@ -494,12 +489,10 @@ checkCanonicalInstances cls poly_ty mbinds = do FunBind { fun_id = L _ name , fun_matches = mg } | name == returnMName, isAliasMG mg /= Just pureAName - -> addWarnNonCanonicalMethod2 refURL - Opt_WarnNonCanonicalMonadInstances "return" "pure" + -> addWarnNonCanonicalMonad NonCanonical_Return | name == thenMName, isAliasMG mg /= Just thenAName - -> addWarnNonCanonicalMethod2 refURL - Opt_WarnNonCanonicalMonadInstances "(>>)" "(*>)" + -> addWarnNonCanonicalMonad NonCanonical_ThenM _ -> return () @@ -518,15 +511,14 @@ checkCanonicalInstances cls poly_ty mbinds = do -- -- * Warn if '(<>)' is defined backwards (i.e. @(<>) = mappend@). -- - checkCanonicalMonoidInstances refURL + checkCanonicalMonoidInstances | cls == semigroupClassName = forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpanA loc $ case mbind of FunBind { fun_id = L _ name , fun_matches = mg } | name == sappendName, isAliasMG mg == Just mappendName - -> addWarnNonCanonicalMethod1 refURL - Opt_WarnNonCanonicalMonoidInstances "(<>)" "mappend" + -> addWarnNonCanonicalMonoid NonCanonical_Sappend _ -> return () @@ -536,9 +528,7 @@ checkCanonicalInstances cls poly_ty mbinds = do FunBind { fun_id = L _ name , fun_matches = mg } | name == mappendName, isAliasMG mg /= Just sappendName - -> addWarnNonCanonicalMethod2 refURL - Opt_WarnNonCanonicalMonoidInstances - "mappend" "(<>)" + -> addWarnNonCanonicalMonoid NonCanonical_Mappend _ -> return () @@ -554,51 +544,14 @@ checkCanonicalInstances cls poly_ty mbinds = do , HsVar _ lrhsName <- unLoc body = Just (unLoc lrhsName) isAliasMG _ = Nothing - -- got "lhs = rhs" but expected something different - addWarnNonCanonicalMethod1 refURL flag lhs rhs = do - let dia = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag flag) noHints $ - vcat [ text "Noncanonical" <+> - quotes (text (lhs ++ " = " ++ rhs)) <+> - text "definition detected" - , instDeclCtxt1 poly_ty - , text "Move definition from" <+> - quotes (text rhs) <+> - text "to" <+> quotes (text lhs) - , text "See also:" <+> - text refURL - ] - addDiagnostic dia - - -- expected "lhs = rhs" but got something else - addWarnNonCanonicalMethod2 refURL flag lhs rhs = do - let dia = mkTcRnUnknownMessage $ - mkPlainDiagnostic (WarningWithFlag flag) noHints $ - vcat [ text "Noncanonical" <+> - quotes (text lhs) <+> - text "definition detected" - , instDeclCtxt1 poly_ty - , quotes (text lhs) <+> - text "will eventually be removed in favour of" <+> - quotes (text rhs) - , text "Either remove definition for" <+> - quotes (text lhs) <+> text "(recommended)" <+> - text "or define as" <+> - quotes (text (lhs ++ " = " ++ rhs)) - , text "See also:" <+> - text refURL - ] - addDiagnostic dia - - -- stolen from GHC.Tc.TyCl.Instance - instDeclCtxt1 :: LHsSigType GhcRn -> SDoc - instDeclCtxt1 hs_inst_ty - = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) - - inst_decl_ctxt :: SDoc -> SDoc - inst_decl_ctxt doc = hang (text "in the instance declaration for") - 2 (quotes doc <> text ".") + addWarnNonCanonicalMonoid reason = + addWarnNonCanonicalDefinition (NonCanonicalMonoid reason) + addWarnNonCanonicalMonad reason = + addWarnNonCanonicalDefinition (NonCanonicalMonad reason) + + addWarnNonCanonicalDefinition reason = + addDiagnostic (TcRnNonCanonicalDefinition reason poly_ty) rnClsInstDecl :: ClsInstDecl GhcPs -> RnM (ClsInstDecl GhcRn, FreeVars) rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1859,6 +1859,9 @@ instance Diagnostic TcRnMessage where locations = text "Bound at:" <+> vcat (map ppr (sortBy leftmost_smallest (NE.toList locs))) + TcRnNonCanonicalDefinition reason inst_ty + -> mkSimpleDecorated $ + pprNonCanonicalDefinition inst_ty reason diagnosticReason = \case TcRnUnknownMessage m @@ -2484,6 +2487,11 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnBindingNameConflict{} -> ErrorWithoutFlag + TcRnNonCanonicalDefinition (NonCanonicalMonoid _) _ + -> WarningWithFlag Opt_WarnNonCanonicalMonoidInstances + TcRnNonCanonicalDefinition (NonCanonicalMonad _) _ + -> WarningWithFlag Opt_WarnNonCanonicalMonadInstances + diagnosticHints = \case TcRnUnknownMessage m @@ -3145,6 +3153,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnBindingNameConflict{} -> noHints + TcRnNonCanonicalDefinition reason _ + -> suggestNonCanonicalDefinition reason diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode @@ -5451,3 +5461,78 @@ pprAmbiguousGreName gre | otherwise = pprPanic "addNameClassErrRn" (ppr gre) -- Invariant: either 'lcl' is True or 'iss' is non-empty + +pprNonCanonicalDefinition :: LHsSigType GhcRn + -> NonCanonicalDefinition + -> SDoc +pprNonCanonicalDefinition inst_ty = \case + NonCanonicalMonoid sub -> case sub of + NonCanonical_Sappend -> + msg1 "(<>)" "mappend" + NonCanonical_Mappend -> + msg2 "mappend" "(<>)" + NonCanonicalMonad sub -> case sub of + NonCanonical_Pure -> + msg1 "pure" "return" + NonCanonical_ThenA -> + msg1 "(*>)" "(>>)" + NonCanonical_Return -> + msg2 "return" "pure" + NonCanonical_ThenM -> + msg2 "(>>)" "(*>)" + where + msg1 :: String -> String -> SDoc + msg1 lhs rhs = + vcat [ text "Noncanonical" <+> + quotes (text (lhs ++ " = " ++ rhs)) <+> + text "definition detected" + , inst + ] + + msg2 :: String -> String -> SDoc + msg2 lhs rhs = + vcat [ text "Noncanonical" <+> + quotes (text lhs) <+> + text "definition detected" + , inst + , quotes (text lhs) <+> + text "will eventually be removed in favour of" <+> + quotes (text rhs) + ] + + inst = instDeclCtxt1 inst_ty + + -- stolen from GHC.Tc.TyCl.Instance + instDeclCtxt1 :: LHsSigType GhcRn -> SDoc + instDeclCtxt1 hs_inst_ty + = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) + + inst_decl_ctxt :: SDoc -> SDoc + inst_decl_ctxt doc = hang (text "in the instance declaration for") + 2 (quotes doc <> text ".") + +suggestNonCanonicalDefinition :: NonCanonicalDefinition -> [GhcHint] +suggestNonCanonicalDefinition reason = + [action doc] + where + action = case reason of + NonCanonicalMonoid sub -> case sub of + NonCanonical_Sappend -> move sappendName mappendName + NonCanonical_Mappend -> remove mappendName sappendName + NonCanonicalMonad sub -> case sub of + NonCanonical_Pure -> move pureAName returnMName + NonCanonical_ThenA -> move thenAName thenMName + NonCanonical_Return -> remove returnMName pureAName + NonCanonical_ThenM -> remove thenMName thenAName + + move = SuggestMoveNonCanonicalDefinition + remove = SuggestRemoveNonCanonicalDefinition + + doc = case reason of + NonCanonicalMonoid _ -> doc_monoid + NonCanonicalMonad _ -> doc_monad + + doc_monoid = + "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid" + doc_monad = + "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return" ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -116,6 +116,9 @@ module GHC.Tc.Errors.Types ( , UnusedImportName (..) , NestedForallsContextsIn(..) , UnusedNameProv(..) + , NonCanonicalDefinition(..) + , NonCanonical_Monoid(..) + , NonCanonical_Monad(..) ) where import GHC.Prelude @@ -4037,6 +4040,19 @@ data TcRnMessage where -- ^ The locations of the duplicates -> TcRnMessage + {-| TcRnNonCanonicalDefinition is a warning indicating that an instance + defines an implementation for a method that should not be defined in a way + that deviates from its default implementation, for example because it has + been scheduled to be absorbed into another method, like @pure@ making + @return@ obsolete. + + Test cases: + WCompatWarningsOn, WCompatWarningsOff, WCompatWarningsOnOff + -} + TcRnNonCanonicalDefinition :: !NonCanonicalDefinition -- ^ Specifics + -> !(LHsSigType GhcRn) -- ^ The instance type + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -5567,3 +5583,34 @@ data UnusedNameProv | UnusedNameTypePattern | UnusedNameMatch | UnusedNameLocalBind + +-- | Different reasons for TcRnNonCanonicalDefinition. +data NonCanonicalDefinition = + -- | Related to @(<>)@ and @mappend at . + NonCanonicalMonoid NonCanonical_Monoid + | + -- | Related to @(*>)@/@(>>)@ and @pure@/@return at . + NonCanonicalMonad NonCanonical_Monad + deriving (Generic) + +-- | Possible cases for the -Wnoncanonical-monoid-instances. +data NonCanonical_Monoid = + -- | @(<>) = mappend@ was defined. + NonCanonical_Sappend + | + -- | @mappend@ was defined as something other than @(<>)@. + NonCanonical_Mappend + +-- | Possible cases for the -Wnoncanonical-monad-instances. +data NonCanonical_Monad = + -- | @pure = return@ was defined. + NonCanonical_Pure + | + -- | @(*>) = (>>)@ was defined. + NonCanonical_ThenA + | + -- | @return@ was defined as something other than @pure at . + NonCanonical_Return + | + -- | @(>>)@ was defined as something other than @(*>)@. + NonCanonical_ThenM ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -598,6 +598,8 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnIllegalInferredTyVars" = 54832 GhcDiagnosticCode "TcRnAmbiguousName" = 87543 GhcDiagnosticCode "TcRnBindingNameConflict" = 10498 + GhcDiagnosticCode "NonCanonicalMonoid" = 50928 + GhcDiagnosticCode "NonCanonicalMonad" = 22705 -- PatSynInvalidRhsReason GhcDiagnosticCode "PatSynNotInvertible" = 69317 @@ -717,6 +719,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "NoUnitIdMatching" = 51294 GhcDiagnosticCode "NotAModule" = 35235 GhcDiagnosticCode "Can'tFindNameInInterface" = 83249 + GhcDiagnosticCode "CircularImport" = 75429 GhcDiagnosticCode "HiModuleNameMismatchWarn" = 53693 GhcDiagnosticCode "ExceptionOccurred" = 47808 @@ -856,6 +859,7 @@ type family ConRecursInto con where ConRecursInto "DodgyImportsHiding" = 'Just ImportLookupReason ConRecursInto "TcRnImportLookup" = 'Just ImportLookupReason ConRecursInto "TcRnUnusedImport" = 'Just UnusedImportReason + ConRecursInto "TcRnNonCanonicalDefinition" = 'Just NonCanonicalDefinition -- -- TH errors ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -438,6 +438,21 @@ data GhcHint bind anything useful. -} | SuggestRemoveRecordWildcard + {-| Suggest moving a method implementation to a different instance to its + superclass that defines the canonical version of the method. + -} + | SuggestMoveNonCanonicalDefinition + Name -- ^ move the implementation from this method + Name -- ^ ... to this method + String -- ^ Documentation URL + + {-| Suggest removing a method implementation when a superclass defines the + canonical version of that method. + -} + | SuggestRemoveNonCanonicalDefinition + Name -- ^ method with non-canonical implementation + Name -- ^ possible other method to use as the RHS instead + String -- ^ Documentation URL -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -234,6 +234,17 @@ instance Outputable GhcHint where -> text "Enable Safe Haskell through either Safe, Trustworthy or Unsafe." SuggestRemoveRecordWildcard -> text "Omit the" <+> quotes (text "..") + SuggestMoveNonCanonicalDefinition lhs rhs refURL -> + text "Move definition from" <+> + quotes (pprPrefixUnqual rhs) <+> + text "to" <+> quotes (pprPrefixUnqual lhs) $$ + text "See also:" <+> text refURL + SuggestRemoveNonCanonicalDefinition lhs rhs refURL -> + text "Either remove definition for" <+> + quotes (pprPrefixUnqual lhs) <+> text "(recommended)" <+> + text "or define as" <+> + quotes (pprPrefixUnqual lhs <+> text "=" <+> pprPrefixUnqual rhs) $$ + text "See also:" <+> text refURL perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" @@ -343,3 +354,7 @@ pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope) pp_ns rdr | ns /= tried_ns = pprNameSpace ns | otherwise = empty where ns = rdrNameSpace rdr + +pprPrefixUnqual :: Name -> SDoc +pprPrefixUnqual name = + pprPrefixOcc (getOccName name) ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -126,7 +126,7 @@ types may be used as arguments to FFI calls, subject to these restrictions: * Valid arguments for ``foreign import unsafe`` FFI calls: ``Array#``, - ``SmallArray#``, ``ArrayArray#``, ``ByteArray#``, and the mutable + ``SmallArray#``, ``ByteArray#``, and the mutable counterparts of these types. * Valid arguments for ``foreign import safe`` FFI calls: ``ByteArray#`` and ``MutableByteArray#``. The byte array must be @@ -174,10 +174,6 @@ are: +--------------------------------+-----------+-------------+-----------+---------------+ | ``MutableSmallArray#`` | Unsound | Unsound | Sound | Unsound | +--------------------------------+-----------+-------------+-----------+---------------+ - | ``ArrayArray#`` | Unsound | Unsound | Sound | Unsound | - +--------------------------------+-----------+-------------+-----------+---------------+ - | ``MutableArrayArray#`` | Unsound | Unsound | Sound | Unsound | - +--------------------------------+-----------+-------------+-----------+---------------+ | unpinned ``ByteArray#`` | Unsound | Unsound | Sound | Unsound | +--------------------------------+-----------+-------------+-----------+---------------+ | unpinned ``MutableByteArray#`` | Unsound | Unsound | Sound | Sound | @@ -210,32 +206,32 @@ anything from ``Rts.h``:: In other situations, the C function may need knowledge of the RTS closure types. The following example sums the first element of each ``ByteArray#`` (interpreting the bytes as an array of ``CInt``) -element of an ``ArrayArray##`` [3]_:: +element of an ``Array# ByteArray#`` [3]_:: // C source, must include the RTS to make the struct StgArrBytes - // available along with its fields: ptrs and payload. + // available along with its fields, such as `payload`. #include "Rts.h" - int sum_first (StgArrBytes **bufs) { - StgArrBytes **bufs = (StgArrBytes**)bufsTmp; + int sum_first (StgArrBytes **bufs, StgWord sz) { int res = 0; - for(StgWord ix = 0;ix < arr->ptrs;ix++) { + for(StgWord ix = 0; ix < sz; ix++) { res = res + ((int*)(bufs[ix]->payload))[0]; } return res; } - -- Haskell source, all elements in the argument array must be - -- either ByteArray# or MutableByteArray#. This is not enforced - -- by the type system in this example since ArrayArray is untyped. + -- Haskell source foreign import ccall unsafe "sum_first" - sumFirst :: ArrayArray# -> IO CInt + sumFirst :: Array# ByteArray# -> CInt -> IO CInt + + sumFirst' :: Array# ByteArray# -> IO CInt + sumFirst' arr = sumFirst arr (sizeofArray# arr) -Although GHC allows the user to pass all unlifted boxed types to -foreign functions, some of them are not amenable to useful work. -Although ``Array#`` is unlifted, the elements in its payload are -lifted, and a foreign C function cannot safely force thunks. Consequently, -a foreign C function may not dereference any of the addresses that comprise -the payload of the ``Array#``. +Although GHC allows the user to pass all unlifted boxed types to foreign +functions, some of them are not amenable to useful work. Although ``Array#`` +is unlifted, the elements in its payload can be lifted, and a foreign C +function cannot safely force thunks. Consequently, a foreign C function may not +dereference any of the addresses that comprise the payload of ``Array# a`` if +``a`` has a lifted representation. .. _ffi-newtype-io: @@ -1136,4 +1132,5 @@ byte array can be pinned as a result of three possible causes: as reading bytes from a ``MutableByteArray#``. Users should prefer ``GHC.Exts.readWord8Array#`` for this. .. [3] As in [2]_, the FFI is not actually needed for this. ``GHC.Exts`` - includes primitives for reading from on ``ArrayArray#``. + includes primitives for reading from an ``Array# a``, such as + ``GHC.Exts.indexArray#``. ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -163,6 +163,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wsemigroup` * :ghc-flag:`-Wnoncanonical-monoid-instances` + * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wcompat-unqualified-imports` * :ghc-flag:`-Wtype-equality-out-of-scope` @@ -566,7 +567,7 @@ of ``-W(no-)*``. :since: 8.0 - :default: off + :default: on Warn if noncanonical ``Applicative`` or ``Monad`` instances declarations are detected. @@ -584,6 +585,8 @@ of ``-W(no-)*``. * Warn if ``pure`` is defined backwards (i.e. ``pure = return``). * Warn if ``(*>)`` is defined backwards (i.e. ``(*>) = (>>)``). + This warning is part of the :ghc-flag:`-Wcompat` option group. + .. ghc-flag:: -Wnoncanonical-monadfail-instances :shortdesc: *(deprecated)* warn when ``Monad`` or ``MonadFail`` instances have @@ -610,6 +613,8 @@ of ``-W(no-)*``. :since: 8.0 + :default: on + Warn if noncanonical ``Semigroup`` or ``Monoid`` instances declarations are detected. @@ -625,8 +630,7 @@ of ``-W(no-)*``. * Warn if ``(<>)`` is defined backwards (i.e. ``(<>) = mappend``). - This warning is off by default. However, it is part of the - :ghc-flag:`-Wcompat` option group. + This warning is part of the :ghc-flag:`-Wcompat` option group. .. ghc-flag:: -Wmissing-monadfail-instances :shortdesc: *(deprecated)* ===================================== rts/RtsStartup.c ===================================== @@ -68,7 +68,7 @@ #endif // Count of how many outstanding hs_init()s there have been. -static int hs_init_count = 0; +static StgWord hs_init_count = 0; static bool rts_shutdown = false; #if defined(mingw32_HOST_OS) @@ -242,8 +242,9 @@ hs_init_with_rtsopts(int *argc, char **argv[]) void hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) { - hs_init_count++; - if (hs_init_count > 1) { + // N.B. atomic_inc returns the new value. + StgWord init_count = atomic_inc(&hs_init_count, 1); + if (init_count > 1) { // second and subsequent inits are ignored return; } @@ -452,15 +453,17 @@ hs_exit_(bool wait_foreign) { uint32_t g, i; - if (hs_init_count <= 0) { - errorBelch("warning: too many hs_exit()s"); + // N.B. atomic_dec returns the new value. + StgInt init_count = (StgInt)atomic_dec(&hs_init_count); + if (init_count > 0) { + // ignore until it's the last one return; } - hs_init_count--; - if (hs_init_count > 0) { - // ignore until it's the last one + if (init_count < 0) { + errorBelch("warning: too many hs_exit()s"); return; } + rts_shutdown = true; /* start timing the shutdown */ ===================================== testsuite/tests/mdo/should_compile/mdo002.hs ===================================== @@ -13,11 +13,10 @@ instance Functor X where fmap f (X a) = X (f a) instance Applicative X where - pure = return + pure = X (<*>) = ap instance Monad X where - return = X (X a) >>= f = f a instance MonadFix X where ===================================== testsuite/tests/polykinds/MonoidsFD.hs ===================================== @@ -25,7 +25,7 @@ class Monoidy to comp id m | m to → comp id where -- We use functional dependencies to help the typechecker understand that -- m and ~> uniquely determine comp (times) and id. --- +-- -- This kind of type class would not have been possible in previous -- versions of GHC; with the new kind system, however, we can abstract -- over kinds!2 Now, let’s create types for the additive and @@ -89,18 +89,17 @@ instance Monoidy (→) (,) () m ⇒ Monoid m where mempty = munit () instance Applicative Wrapper where - pure = return + pure x = runNT munit $ Id x (<*>) = ap -- instance (Functor m, Monoidy NT FC Id m) ⇒ Monad m where instance Monad Wrapper where - return x = runNT munit $ Id x x >>= f = runNT mjoin $ FC (f `fmap` x) -- And so the following works: test3 - = do { print (mappend mempty (Sum 2)) + = do { print (mappend mempty (Sum 2)) -- Sum 2 ; print (mappend (Product 2) (Product 3)) -- Product 6 ===================================== testsuite/tests/polykinds/MonoidsTF.hs ===================================== @@ -103,11 +103,10 @@ instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m) mempty = munit () instance Applicative Wrapper where - pure = return + pure x = runNT munit $ Id x (<*>) = ap instance Monad Wrapper where - return x = runNT munit $ Id x x >>= f = runNT mjoin $ FC (f `fmap` x) -- And so the following works: ===================================== testsuite/tests/profiling/should_run/T3001-2.hs ===================================== @@ -90,22 +90,20 @@ instance Functor PutM where fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w instance Monad PutM where - return a = Put $ PairS a mempty - m >>= k = Put $ let PairS a w = unPut m PairS b w' = unPut (k a) in PairS b (w `mappend` w') - m >> k = Put $ +instance Applicative PutM where + pure a = Put $ PairS a mempty + (<*>) = ap + + m *> k = Put $ let PairS _ w = unPut m PairS b w' = unPut k in PairS b (w `mappend` w') -instance Applicative PutM where - pure = return - (<*>) = ap - tell :: Builder -> Put tell b = Put $ PairS () b @@ -189,9 +187,6 @@ joinZ bb lb | otherwise = L.Chunk bb lb instance Monad Get where - return a = Get (\s -> (a, s)) - {-# INLINE return #-} - m >>= k = Get (\s -> let (a, s') = unGet m s in unGet (k a) s') {-# INLINE (>>=) #-} @@ -200,7 +195,9 @@ instance MonadFail Get where fail = error "failDesc" instance Applicative Get where - pure = return + pure a = Get (\s -> (a, s)) + {-# INLINE pure #-} + (<*>) = ap getZ :: Get S ===================================== testsuite/tests/profiling/should_run/ioprof.hs ===================================== @@ -10,13 +10,13 @@ newtype M s a = M { unM :: s -> (s,a) } instance Monad (M s) where (M m) >>= k = M $ \s -> case m s of (s',a) -> unM (k a) s' - return a = M $ \s -> (s,a) + instance Functor (M s) where fmap = liftM instance Applicative (M s) where - pure = return + pure a = M $ \s -> (s,a) (<*>) = ap errorM :: String -> M s a ===================================== testsuite/tests/rebindable/rebindable2.hs ===================================== @@ -24,16 +24,15 @@ module Main where }; instance (Applicative TM) where { - pure = return; + pure a = MkTM (debugFunc "pure" (Prelude.pure a)); + (*>) ma mb = MkTM (debugFunc "*>" ((Prelude.*>) (unTM ma) (unTM mb))); (<*>) = ap; }; instance (Monad TM) where { - return a = MkTM (debugFunc "return" (Prelude.return a)); - + return = pure; (>>=) ma amb = MkTM (debugFunc ">>=" ((Prelude.>>=) (unTM ma) (\a -> unTM (amb a)))); - - (>>) ma mb = MkTM (debugFunc ">>" ((Prelude.>>) (unTM ma) (unTM mb))); + (>>) = (*>) }; instance (MonadFail TM) where { ===================================== testsuite/tests/rebindable/rebindable2.stdout ===================================== @@ -1,18 +1,18 @@ start test test_do failure -++ >> +++ *> ++ >>= ++ fail -- fail -- >>= --- >> +-- *> end test test_do failure start test test_do success -++ >> +++ *> ++ >>= -++ return --- return +++ pure +-- pure -- >>= --- >> +-- *> end test test_do success start test test_fromInteger 135 ===================================== testsuite/tests/simplCore/T9646/StrictPrim.hs ===================================== @@ -18,7 +18,10 @@ newtype StrictPrim s a instance Applicative (StrictPrim s) where {-# INLINE pure #-} - pure = return + pure !x = StrictPrim ( \ !s -> (# s, x #)) + + {-# INLINE (*>) #-} + (!m) *> (!k) = do { _ <- m ; k } {-# INLINE (<*>) #-} (<*>) a b = do f <- a ; v <- b ; return $! (f $! v) @@ -31,11 +34,6 @@ instance Functor (StrictPrim s) where instance Monad (StrictPrim s) where - {-# INLINE return #-} - return !x = StrictPrim ( \ !s -> (# s, x #)) - - {-# INLINE (>>) #-} - (!m) >> (!k) = do { _ <- m ; k } {-# INLINE (>>=) #-} (StrictPrim !m) >>= (!k) = ===================================== testsuite/tests/simplCore/should_run/T17744A.hs ===================================== @@ -17,10 +17,9 @@ instance Functor (Parser t) where fmap f p = apply (fmap f) p instance Applicative (Parser t) where - pure = return + pure = Result mempty instance Monad (Parser t) where - return = Result mempty Result s r >>= f = feed s (f r) p >>= f = apply (>>= f) p ===================================== testsuite/tests/simplCore/should_run/T3591.hs ===================================== @@ -1,4 +1,4 @@ -{- +{- Copyright 2009 Mario Blazevic This file is part of the Streaming Component Combinators (SCC) project. @@ -20,7 +20,7 @@ -- | Module "Trampoline" defines the pipe computations and their basic building blocks. {-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses, - TypeFamilies, KindSignatures, FlexibleContexts, + TypeFamilies, KindSignatures, FlexibleContexts, FlexibleInstances, OverlappingInstances, UndecidableInstances #-} @@ -75,11 +75,10 @@ instance Functor Identity where fmap = liftM instance Applicative Identity where - pure = return + pure a = Identity a (<*>) = ap instance Monad Identity where - return a = Identity a m >>= k = k (runIdentity m) newtype Trampoline m s r = Trampoline {bounce :: m (TrampolineState m s r)} @@ -89,11 +88,10 @@ instance (Monad m, Functor s) => Functor (Trampoline m s) where fmap = liftM instance (Monad m, Functor s) => Applicative (Trampoline m s) where - pure = return + pure x = Trampoline (return (Done x)) (<*>) = ap instance (Monad m, Functor s) => Monad (Trampoline m s) where - return x = Trampoline (return (Done x)) t >>= f = Trampoline (bounce t >>= apply f) where apply f (Done x) = bounce (f x) apply f (Suspend s) = return (Suspend (fmap (>>= f) s)) @@ -111,7 +109,7 @@ instance Functor (Await x) where data EitherFunctor l r x = LeftF (l x) | RightF (r x) instance (Functor l, Functor r) => Functor (EitherFunctor l r) where - fmap f v = trace "fmap Either" $ + fmap f v = trace "fmap Either" $ case v of LeftF l -> trace "fmap LeftF" $ LeftF (fmap f l) RightF r -> trace "fmap RightF" $ RightF (fmap f r) @@ -178,7 +176,7 @@ liftOut :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Trampoli liftOut (Trampoline ma) = trace "liftOut" $ Trampoline (liftM inject ma) where inject :: TrampolineState m a x -> TrampolineState m d x inject (Done x) = Done x - inject (Suspend a) = trace "inject suspend" $ Suspend (liftFunctor $ trace "calling fmap" $ + inject (Suspend a) = trace "inject suspend" $ Suspend (liftFunctor $ trace "calling fmap" $ fmap liftOut (trace "poking a" a)) data Sink (m :: Type -> Type) a x = ===================================== testsuite/tests/typecheck/should_run/T1735_Help/State.hs ===================================== @@ -7,7 +7,6 @@ import Control.Monad (ap, liftM) newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } instance Monad m => Monad (StateT s m) where - return a = StateT $ \s -> return (a, s) m >>= k = StateT $ \s -> do ~(a, s') <- runStateT m s runStateT (k a) s' @@ -19,7 +18,7 @@ instance Monad m => Functor (StateT s m) where fmap = liftM instance Monad m => Applicative (StateT s m) where - pure = return + pure a = StateT $ \s -> pure (a, s) (<*>) = ap get :: Monad m => StateT s m s ===================================== testsuite/tests/typecheck/should_run/T4809_IdentityT.hs ===================================== @@ -19,9 +19,8 @@ data XML -- * IdentityT Monad Transformer newtype IdentityT m a = IdentityT { runIdentityT :: m a } - deriving (Functor, Monad, MonadIO, MonadPlus) + deriving (Functor, Applicative, Monad, MonadIO, MonadPlus) -instance Monad m => Applicative (IdentityT m) where instance Monad m => Alternative (IdentityT m) where instance MonadTrans IdentityT where ===================================== testsuite/tests/typecheck/should_run/T4809_XMLGenerator.hs ===================================== @@ -34,12 +34,9 @@ import Control.Monad (MonadPlus(..),liftM) -- | The monad transformer that allows a monad to generate XML values. newtype XMLGenT m a = XMLGenT (m a) - deriving (Monad, Functor, MonadIO, MonadPlus, MonadWriter w, MonadReader r, - MonadState s, MonadRWS r w s, MonadCont, MonadError e) - -instance Monad m => Applicative (XMLGenT m) where - pure = return - (<*>) = ap + deriving (Monad, Functor, Applicative, MonadIO, MonadPlus, MonadWriter w, + MonadReader r, MonadState s, MonadRWS r w s, MonadCont, + MonadError e) instance Monad m => Alternative (XMLGenT m) where ===================================== testsuite/tests/wcompat-warnings/Template.hs ===================================== @@ -13,3 +13,18 @@ instance Semi.Semigroup S where instance Monoid S where S a `mappend` S b = S (a+b) mempty = S 0 + +newtype M a = M a + +instance Functor M where + fmap = undefined + +instance Applicative M where + liftA2 = undefined + pure = return + (*>) = (>>) + +instance Monad M where + return = undefined + (>>=) = undefined + (>>) = undefined ===================================== testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr ===================================== @@ -3,15 +3,47 @@ Template.hs:5:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. This will become an error in a future release. -Template.hs:11:3: warning: [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] +Template.hs:11:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] Noncanonical ‘(<>) = mappend’ definition detected in the instance declaration for ‘Semigroup S’. - Move definition from ‘mappend’ to ‘(<>)’ - See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid + Suggested fix: + Move definition from ‘mappend’ to ‘(<>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid -Template.hs:14:3: warning: [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] +Template.hs:14:3: warning: [GHC-50928] [-Wnoncanonical-monoid-instances (in -Wdefault, -Wcompat)] Noncanonical ‘mappend’ definition detected in the instance declaration for ‘Monoid S’. ‘mappend’ will eventually be removed in favour of ‘(<>)’ - Either remove definition for ‘mappend’ (recommended) or define as ‘mappend = (<>)’ - See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid + Suggested fix: + Either remove definition for ‘mappend’ (recommended) or define as ‘mappend = (<>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid + +Template.hs:24:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)] + Noncanonical ‘pure = return’ definition detected + in the instance declaration for ‘Applicative M’. + Suggested fix: + Move definition from ‘return’ to ‘pure’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return + +Template.hs:25:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)] + Noncanonical ‘(*>) = (>>)’ definition detected + in the instance declaration for ‘Applicative M’. + Suggested fix: + Move definition from ‘(>>)’ to ‘(*>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return + +Template.hs:28:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)] + Noncanonical ‘return’ definition detected + in the instance declaration for ‘Monad M’. + ‘return’ will eventually be removed in favour of ‘pure’ + Suggested fix: + Either remove definition for ‘return’ (recommended) or define as ‘return = pure’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return + +Template.hs:30:3: warning: [GHC-22705] [-Wnoncanonical-monad-instances (in -Wdefault, -Wcompat)] + Noncanonical ‘(>>)’ definition detected + in the instance declaration for ‘Monad M’. + ‘(>>)’ will eventually be removed in favour of ‘(*>)’ + Suggested fix: + Either remove definition for ‘(>>)’ (recommended) or define as ‘(>>) = (*>)’ + See also: https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d21dfdfa320d24999a8c23c20a9e6a47cc36d385...888e9b81ab4e5f47e54bac3d06ed968e43ee58ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d21dfdfa320d24999a8c23c20a9e6a47cc36d385...888e9b81ab4e5f47e54bac3d06ed968e43ee58ca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 22:35:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 May 2023 18:35:24 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] 67 commits: Allow generation of TTH syntax with TH Message-ID: <6459792c7c11a_38ffda717c1a346584f4@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - beec0251 by Ben Gamari at 2023-05-08T18:02:41-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) - - - - - 110e07a3 by Ben Gamari at 2023-05-08T18:35:18-04:00 compiler: Record original thunk info tables on stack - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd91d3872914e8a813b08032ec4241114b0b0f35...110e07a3068e68efa1dfb7947d83a9fb9066deef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd91d3872914e8a813b08032ec4241114b0b0f35...110e07a3068e68efa1dfb7947d83a9fb9066deef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 22:42:11 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 08 May 2023 18:42:11 -0400 Subject: [Git][ghc/ghc][wip/T23070-pipeline-monad] Wibbles Message-ID: <64597ac35322d_38ffda7204343c66594a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-pipeline-monad at Glasgow Haskell Compiler / GHC Commits: 7ed9bfea by Simon Peyton Jones at 2023-05-08T23:42:00+01:00 Wibbles - - - - - 5 changed files: - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - testsuite/tests/typecheck/should_run/Typeable1.stderr Changes: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -114,12 +114,16 @@ solveEquality ev eq_rel ty1 ty2 ; case mb_canon of { - Left irred_ct -> do { tryInertIrreds irred_ct + -- An IrredCt equality may be insoluble; but maybe not! + -- E.g. m a ~R# m b is not canonical, but may be + -- solved by a quantified constraint (T15290) + Left irred_ct -> do { tryInertIrreds irred_ct + ; tryQCsIrredEqCt irred_ct ; return (CIrredCan irred_ct) } ; - Right eq_ct -> do { interactEq eq_ct - ; tryFunDeps eq_ct - ; tryQCsEqCt eq_ct + Right eq_ct -> do { tryInertEqs eq_ct + ; tryFunDeps eq_ct + ; tryQCsEqCt eq_ct ; return (CEqCan eq_ct) } } } @@ -2477,7 +2481,7 @@ rewriteEqEvidence new_rewriters old_ev swapped (Reduction lhs_co nlhs) (Reductio {- ********************************************************************** * * - interactEq + tryInertEqs * * ********************************************************************** @@ -2517,8 +2521,8 @@ But it's not so simple: call to strictly_more_visible. -} -interactEq :: EqCt -> SolverStage () -interactEq work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) +tryInertEqs :: EqCt -> SolverStage () +tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = Stage $ do { inerts <- getInertCans ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item @@ -2670,23 +2674,16 @@ See -} -------------------- -{- -tryQCsIrredCt :: IrredCt -> SolverStage () -tryQCsIrredCt irred@(IrredCt { ir_ev = ev }) +tryQCsIrredEqCt :: IrredCt -> SolverStage () +tryQCsIrredEqCt irred@(IrredCt { ir_ev = ev }) | EqPred eq_rel t1 t2 <- classifyPredType (ctEvPred ev) = lookup_eq_in_qcis (CIrredCan irred) eq_rel t1 t2 - -- If the final_qci_check fails, we'll do continueWith on an IrredCt - -- That in turn will go down the Irred pipeline, so which deals with - -- the case where we have [G] Coercible (m a) (m b), and [W] m a ~R# m b - -- When we de-pipeline Irreds we may have to adjust here - - | otherwise -- All the calls come from in this module, where we deal - -- only with equalities, so ctEvPred ev) must be an equality. - -- Indeed, we could pass eq_rel, t1, t2 as arguments, to avoid - -- this can't happen case, but it's not a hot path, and this is - -- simple and robust + + | otherwise -- All the calls come from in this module, where we deal only with + -- equalities, so ctEvPred ev) must be an equality. Indeed, we could + -- pass eq_rel, t1, t2 as arguments, to avoid this can't-happen case, + -- but it's not a hot path, and this is simple and robust = pprPanic "solveIrredEquality" (ppr ev) --} -------------------- tryQCsEqCt :: EqCt -> SolverStage () ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -3,7 +3,7 @@ {-# LANGUAGE RecursiveDo #-} module GHC.Tc.Solver.Irred( - solveIrred, tryInertIrreds + solveIrred, tryInertIrreds, tryQCsIrredCt ) where import GHC.Prelude ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -730,8 +730,9 @@ getHasGivenEqs tclvl ; return (has_ge, given_insols) } where insoluble_given_equality :: IrredCt -> Bool - insoluble_given_equality irred - = insolubleIrredCt irred && isGiven (irredCtEvidence irred) + -- Check for unreachability; specifically do not include UserError/Unsatisfiable + insoluble_given_equality (IrredCt { ir_ev = ev, ir_reason = reason }) + = isInsolubleReason reason && isGiven ev removeInertCts :: [Ct] -> InertCans -> InertCans -- ^ Remove inert constraints from the 'InertCans', for use when a ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -443,31 +443,32 @@ instance Outputable NotConcreteError where -- | Used to indicate extra information about why a CIrredCan is irreducible data CtIrredReason = IrredShapeReason - -- ^ this constraint has a non-canonical shape (e.g. @c Int@, for a variable @c@) + -- ^ This constraint has a non-canonical shape (e.g. @c Int@, for a variable @c@) + -- Also used for (U | NonCanonicalReason CheckTyEqResult - -- ^ an equality where some invariant other than (TyEq:H) of 'CEqCan' is not satisfied; + -- ^ An equality where some invariant other than (TyEq:H) of 'CEqCan' is not satisfied; -- the 'CheckTyEqResult' states exactly why | ReprEqReason - -- ^ an equality that cannot be decomposed because it is representational. + -- ^ An equality that cannot be decomposed because it is representational. -- Example: @a b ~R# Int at . -- These might still be solved later. -- INVARIANT: The constraint is a representational equality constraint | ShapeMismatchReason - -- ^ a nominal equality that relates two wholly different types, + -- ^ A nominal equality that relates two wholly different types, -- like @Int ~# Bool@ or @a b ~# 3 at . -- INVARIANT: The constraint is a nominal equality constraint | AbstractTyConReason - -- ^ an equality like @T a b c ~ Q d e@ where either @T@ or @Q@ + -- ^ An equality like @T a b c ~ Q d e@ where either @T@ or @Q@ -- is an abstract type constructor. See Note [Skolem abstract data] -- in GHC.Core.TyCon. -- INVARIANT: The constraint is an equality constraint between two TyConApps | PluginReason - -- ^ a typechecker plugin returned this in the pluginBagCts field + -- ^ A typechecker plugin returned this in the pluginBadCts field -- of TcPluginProgress instance Outputable CtIrredReason where @@ -1306,14 +1307,15 @@ insolubleWantedCt ct = insolubleCt ct && not (arisesFromGivens ct) && not (isWantedWantedFunDepOrigin (ctOrigin ct)) -insolubleIrredCt :: IrredCt -> Bool --- Returns True of Irred constraints that are /definitely/ insoluble -insolubleIrredCt (IrredCt { ir_reason = reason }) +insolubleEqIrredCt :: IrredCt -> Bool +-- True of Irred constraints that are +-- a) definitely insoluble +-- b) not (TypeError msg) +insolubleEqIrredCt (IrredCt { ir_reason = reason }) = isInsolubleReason reason --- | Returns True of constraints that are definitely insoluble, --- as well as TypeError constraints. --- Can return 'True' for Given constraints, unlike 'insolubleWantedCt'. +insolubleIrredCt :: IrredCt -> Bool +-- Returns True of Irred constraints that are /definitely/ insoluble -- -- This function is critical for accurate pattern-match overlap warnings. -- See Note [Pattern match warnings with insoluble Givens] in GHC.Tc.Solver @@ -1321,16 +1323,9 @@ insolubleIrredCt (IrredCt { ir_reason = reason }) -- Note that this does not traverse through the constraint to find -- nested custom type errors: it only detects @TypeError msg :: Constraint@, -- and not e.g. @Eq (TypeError msg)@. --- --- The function is tuned for application /after/ constraint solving --- i.e. assuming canonicalisation has been done --- That's why it looks only for IrredCt, with an insoluble IrredCtReason -insolubleCt :: Ct -> Bool -insolubleCt ct - | isTopLevelUserTypeError (ctPred ct) = True - | CIrredCan ir_ct <- ct = insolubleIrredCt ir_ct - | otherwise = False - where +insolubleIrredCt (IrredCt { ir_ev = ev, ir_reason = reason }) + = isInsolubleReason reason + || isTopLevelUserTypeError (ctEvPred ev) -- NB: 'isTopLevelUserTypeError' detects constraints of the form "TypeError msg" -- and "Unsatisfiable msg". It deliberately does not detect TypeError -- nested in a type (e.g. it does not use "containsUserTypeError"), as that @@ -1347,6 +1342,18 @@ insolubleCt ct -- > Assert 'True _errMsg = () -- > Assert _check errMsg = errMsg +-- | Returns True of constraints that are definitely insoluble, +-- as well as TypeError constraints. +-- Can return 'True' for Given constraints, unlike 'insolubleWantedCt'. +-- +-- The function is tuned for application /after/ constraint solving +-- i.e. assuming canonicalisation has been done +-- That's why it looks only for IrredCt; all insoluble constraints +-- are put into CIrredCan +insolubleCt :: Ct -> Bool +insolubleCt (CIrredCan ir_ct) = insolubleIrredCt ir_ct +insolubleCt _ = False + -- | Does this hole represent an "out of scope" error? -- See Note [Insoluble holes] isOutOfScopeHole :: Hole -> Bool ===================================== testsuite/tests/typecheck/should_run/Typeable1.stderr ===================================== @@ -9,8 +9,8 @@ Typeable1.hs:22:5: error: [GHC-40564] [-Winaccessible-code (in -Wdefault), Werro TypeRep a -> TypeRep b -> TypeRep t, in a pattern binding in a 'do' block - Couldn't match type: ComposeK - with: a3 b3 + Couldn't match type: a3 b3 + with: ComposeK • In the pattern: App x y In a stmt of a 'do' block: App x y <- pure x In the expression: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ed9bfea3bc3f7174451b803eb0842617c522b19 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ed9bfea3bc3f7174451b803eb0842617c522b19 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 23:03:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 May 2023 19:03:46 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] compiler: Record original thunk info tables on stack Message-ID: <64597fd24ff79_38ffda7514fb5c68046e@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: 69321e89 by Ben Gamari at 2023-05-08T19:03:37-04:00 compiler: Record original thunk info tables on stack - - - - - 10 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - docs/users_guide/debugging.rst - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -37,6 +37,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -329,6 +329,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -558,6 +559,7 @@ codeGenFlags = EnumSet.fromList -- Flags that affect debugging information , Opt_DistinctConstructorTables , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3481,6 +3481,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -49,6 +49,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== docs/users_guide/debugging.rst ===================================== @@ -1072,6 +1072,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69321e899e949d1a4c7eeb881e1493d6d6e0acb8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69321e899e949d1a4c7eeb881e1493d6d6e0acb8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 23:11:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 May 2023 19:11:12 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] Add structured error messages for GHC.IfaceToCore Message-ID: <64598190a8acc_38ffda7576910068862e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 24effc02 by Torsten Schmits at 2023-05-08T19:11:07-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 4 changed files: - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Error/Codes.hs Changes: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -65,6 +65,8 @@ interfaceErrorHints = \ case missingInterfaceErrorHints err Can'tFindNameInInterface {} -> noHints + CircularImport {} -> + noHints missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] missingInterfaceErrorHints = \case @@ -86,6 +88,8 @@ interfaceErrorReason (Can'tFindInterface err _) = missingInterfaceErrorReason err interfaceErrorReason (Can'tFindNameInInterface {}) = ErrorWithoutFlag +interfaceErrorReason (CircularImport {}) + = ErrorWithoutFlag missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason missingInterfaceErrorReason = \ case @@ -287,6 +291,9 @@ interfaceErrorDiagnostic opts = \ case LookingForSig sig -> hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) 2 (missingInterfaceErrorDiagnostic opts err) + CircularImport mod -> + text "Circular imports: module" <+> quotes (ppr mod) + <+> text "depends on itself" readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc readInterfaceErrorDiagnostic = \ case ===================================== compiler/GHC/Iface/Errors/Types.hs ===================================== @@ -45,6 +45,7 @@ data IfaceMessage | Can'tFindNameInInterface Name [TyThing] -- possibly relevant TyThings + | CircularImport !Module deriving Generic data MissingInterfaceError ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -605,7 +605,7 @@ tcHiBootIface hsc_src mod (LookingForHiBoot mod) in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. - NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) + NotBoot -> failWithTc (TcRnInterfaceError (CircularImport mod)) -- Someone below us imported us! -- This is a loop with no hi-boot in the way }}}} @@ -613,11 +613,6 @@ tcHiBootIface hsc_src mod need = text "Need the hi-boot interface for" <+> ppr mod <+> text "to compare against the Real Thing" - moduleLoop = text "Circular imports: module" <+> quotes (ppr mod) - <+> text "depends on itself" - - - mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo mkSelfBootInfo iface mds = do -- NB: This is computed DIRECTLY from the ModIface rather ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -719,6 +719,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "NoUnitIdMatching" = 51294 GhcDiagnosticCode "NotAModule" = 35235 GhcDiagnosticCode "Can'tFindNameInInterface" = 83249 + GhcDiagnosticCode "CircularImport" = 75429 GhcDiagnosticCode "HiModuleNameMismatchWarn" = 53693 GhcDiagnosticCode "ExceptionOccurred" = 47808 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24effc0241d63dffc8f0add3c2092a860187c231 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24effc0241d63dffc8f0add3c2092a860187c231 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 23:20:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 08 May 2023 19:20:38 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] 2 commits: compiler: Fingerprint more code generation flags Message-ID: <645983c61fd8d_38ffda76ebebfc698941@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: 70e0c8a2 by Ben Gamari at 2023-05-08T19:20:30-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) - - - - - 1d75c827 by Ben Gamari at 2023-05-08T19:20:30-04:00 compiler: Record original thunk info tables on stack - - - - - 11 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - docs/users_guide/debugging.rst - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -37,6 +37,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -5,6 +5,7 @@ module GHC.Driver.Flags , GeneralFlag(..) , Language(..) , optimisationFlags + , codeGenFlags -- * Warnings , WarningGroup(..) @@ -328,6 +329,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -473,15 +475,11 @@ data GeneralFlag | Opt_G_NoOptCoercion deriving (Eq, Show, Enum) --- Check whether a flag should be considered an "optimisation flag" --- for purposes of recompilation avoidance (see --- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is --- not a guarantee that the flag has no other effect. We could, and --- perhaps should, separate out the flags that have some minor impact on --- program semantics and/or error behavior (e.g., assertions), but --- then we'd need to go to extra trouble (and an additional flag) --- to allow users to ignore the optimisation level even though that --- means ignoring some change. +-- | The set of flags which affect optimisation for the purposes of +-- recompilation avoidance. Specifically, these include flags which +-- affect code generation but not the semantics of the program. +-- +-- See Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags) optimisationFlags :: EnumSet GeneralFlag optimisationFlags = EnumSet.fromList [ Opt_CallArity @@ -489,7 +487,6 @@ optimisationFlags = EnumSet.fromList , Opt_LateDmdAnal , Opt_KillAbsence , Opt_KillOneShot - , Opt_FullLaziness , Opt_FloatIn , Opt_LateSpecialise , Opt_Specialise @@ -503,7 +500,6 @@ optimisationFlags = EnumSet.fromList , Opt_SpecConstr , Opt_SpecConstrKeen , Opt_DoLambdaEtaExpansion - , Opt_IgnoreAsserts , Opt_DoEtaReduction , Opt_CaseMerge , Opt_CaseFolding @@ -513,16 +509,12 @@ optimisationFlags = EnumSet.fromList , Opt_EnableRewriteRules , Opt_RegsGraph , Opt_RegsIterative - , Opt_PedanticBottoms , Opt_LlvmTBAA - , Opt_LlvmFillUndefWithGarbage , Opt_IrrefutableTuples , Opt_CmmSink , Opt_CmmElimCommonBlocks , Opt_AsmShortcutting - , Opt_OmitYields , Opt_FunToThunk - , Opt_DictsStrict , Opt_DmdTxDictSel , Opt_Loopification , Opt_CfgBlocklayout @@ -531,8 +523,43 @@ optimisationFlags = EnumSet.fromList , Opt_WorkerWrapper , Opt_WorkerWrapperUnlift , Opt_SolveConstantDicts + ] + +-- | The set of flags which affect code generation and can change a program's +-- runtime behavior (other than performance). These include flags which affect: +-- +-- * asympototic space behavior (e.g. -ffull-laziness) +-- * user visible debugging information (e.g. info table provenance) +-- * the ability to catch runtime errors (e.g. -fignore-asserts) +-- * the runtime result of the program (e.g. -fomit-yields) +-- * which code or interface file declarations are emitted +-- +codeGenFlags :: EnumSet GeneralFlag +codeGenFlags = EnumSet.fromList + [ -- Flags that affect runtime result + Opt_EagerBlackHoling + , Opt_ExcessPrecision + , Opt_DictsStrict + , Opt_PedanticBottoms + , Opt_OmitYields + + -- Flags that affect generated code + , Opt_ExposeAllUnfoldings + , Opt_NoTypeableBinds + + -- Flags that affect catching of runtime errors , Opt_CatchNonexhaustiveCases , Opt_IgnoreAsserts + , Opt_LlvmFillUndefWithGarbage + , Opt_DoTagInferenceChecks + + -- Flags that affect space + , Opt_FullLaziness + + -- Flags that affect debugging information + , Opt_DistinctConstructorTables + , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -66,6 +66,7 @@ module GHC.Driver.Session ( makeDynFlagsConsistent, positionIndependent, optimisationFlags, + codeGenFlags, setFlagsFromEnvFile, pprDynFlagsDiff, flagSpecOf, @@ -3481,6 +3482,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio = ticky = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] - flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters)) + -- Other flags which affect code generation + codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags) + + flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ computeFingerprint nameio flags ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -49,6 +49,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== docs/users_guide/debugging.rst ===================================== @@ -1072,6 +1072,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69321e899e949d1a4c7eeb881e1493d6d6e0acb8...1d75c8271a8cc3ee6ff4318d935f84e34ed44072 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69321e899e949d1a4c7eeb881e1493d6d6e0acb8...1d75c8271a8cc3ee6ff4318d935f84e34ed44072 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 23:42:38 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 08 May 2023 19:42:38 -0400 Subject: [Git][ghc/ghc][wip/T23070-pipeline-monad] Wibble2 Message-ID: <645988ee8502_38ffda78df66b4714715@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-pipeline-monad at Glasgow Haskell Compiler / GHC Commits: 8859a484 by Simon Peyton Jones at 2023-05-09T00:42:24+01:00 Wibble2 - - - - - 1 changed file: - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1307,13 +1307,6 @@ insolubleWantedCt ct = insolubleCt ct && not (arisesFromGivens ct) && not (isWantedWantedFunDepOrigin (ctOrigin ct)) -insolubleEqIrredCt :: IrredCt -> Bool --- True of Irred constraints that are --- a) definitely insoluble --- b) not (TypeError msg) -insolubleEqIrredCt (IrredCt { ir_reason = reason }) - = isInsolubleReason reason - insolubleIrredCt :: IrredCt -> Bool -- Returns True of Irred constraints that are /definitely/ insoluble -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8859a484019dd1674bf44b1458f11da30a12c169 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8859a484019dd1674bf44b1458f11da30a12c169 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 8 23:43:40 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 08 May 2023 19:43:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23070-dicts Message-ID: <6459892c101e_38ffda798e7244715663@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23070-dicts You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 01:41:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 May 2023 21:41:30 -0400 Subject: [Git][ghc/ghc][master] rts: Fix data-race in hs_init_ghc Message-ID: <6459a4ca3212_38ffda8038ff74755490@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 1 changed file: - rts/RtsStartup.c Changes: ===================================== rts/RtsStartup.c ===================================== @@ -68,7 +68,7 @@ #endif // Count of how many outstanding hs_init()s there have been. -static int hs_init_count = 0; +static StgWord hs_init_count = 0; static bool rts_shutdown = false; #if defined(mingw32_HOST_OS) @@ -242,8 +242,9 @@ hs_init_with_rtsopts(int *argc, char **argv[]) void hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) { - hs_init_count++; - if (hs_init_count > 1) { + // N.B. atomic_inc returns the new value. + StgWord init_count = atomic_inc(&hs_init_count, 1); + if (init_count > 1) { // second and subsequent inits are ignored return; } @@ -452,15 +453,17 @@ hs_exit_(bool wait_foreign) { uint32_t g, i; - if (hs_init_count <= 0) { - errorBelch("warning: too many hs_exit()s"); + // N.B. atomic_dec returns the new value. + StgInt init_count = (StgInt)atomic_dec(&hs_init_count); + if (init_count > 0) { + // ignore until it's the last one return; } - hs_init_count--; - if (hs_init_count > 0) { - // ignore until it's the last one + if (init_count < 0) { + errorBelch("warning: too many hs_exit()s"); return; } + rts_shutdown = true; /* start timing the shutdown */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e3a6be4023189b2d637beda240e23fa9e856810 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e3a6be4023189b2d637beda240e23fa9e856810 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 01:42:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 08 May 2023 21:42:08 -0400 Subject: [Git][ghc/ghc][master] Add structured error messages for GHC.IfaceToCore Message-ID: <6459a4f07e595_38ffda8030cc00759378@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 4 changed files: - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Error/Codes.hs Changes: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -65,6 +65,8 @@ interfaceErrorHints = \ case missingInterfaceErrorHints err Can'tFindNameInInterface {} -> noHints + CircularImport {} -> + noHints missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] missingInterfaceErrorHints = \case @@ -86,6 +88,8 @@ interfaceErrorReason (Can'tFindInterface err _) = missingInterfaceErrorReason err interfaceErrorReason (Can'tFindNameInInterface {}) = ErrorWithoutFlag +interfaceErrorReason (CircularImport {}) + = ErrorWithoutFlag missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason missingInterfaceErrorReason = \ case @@ -287,6 +291,9 @@ interfaceErrorDiagnostic opts = \ case LookingForSig sig -> hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) 2 (missingInterfaceErrorDiagnostic opts err) + CircularImport mod -> + text "Circular imports: module" <+> quotes (ppr mod) + <+> text "depends on itself" readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc readInterfaceErrorDiagnostic = \ case ===================================== compiler/GHC/Iface/Errors/Types.hs ===================================== @@ -45,6 +45,7 @@ data IfaceMessage | Can'tFindNameInInterface Name [TyThing] -- possibly relevant TyThings + | CircularImport !Module deriving Generic data MissingInterfaceError ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -605,7 +605,7 @@ tcHiBootIface hsc_src mod (LookingForHiBoot mod) in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. - NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) + NotBoot -> failWithTc (TcRnInterfaceError (CircularImport mod)) -- Someone below us imported us! -- This is a loop with no hi-boot in the way }}}} @@ -613,11 +613,6 @@ tcHiBootIface hsc_src mod need = text "Need the hi-boot interface for" <+> ppr mod <+> text "to compare against the Real Thing" - moduleLoop = text "Circular imports: module" <+> quotes (ppr mod) - <+> text "depends on itself" - - - mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo mkSelfBootInfo iface mds = do -- NB: This is computed DIRECTLY from the ModIface rather ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -719,6 +719,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "NoUnitIdMatching" = 51294 GhcDiagnosticCode "NotAModule" = 35235 GhcDiagnosticCode "Can'tFindNameInInterface" = 83249 + GhcDiagnosticCode "CircularImport" = 75429 GhcDiagnosticCode "HiModuleNameMismatchWarn" = 53693 GhcDiagnosticCode "ExceptionOccurred" = 47808 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78c8dc509eacef5a5f09601b6bd004e13ae3a4c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78c8dc509eacef5a5f09601b6bd004e13ae3a4c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 04:01:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 00:01:33 -0400 Subject: [Git][ghc/ghc][wip/glossary] Use glossary directive Message-ID: <6459c59d34c3e_38ffda86417ff479099d@gitlab.mail> Ben Gamari pushed to branch wip/glossary at Glasgow Haskell Compiler / GHC Commits: 774cfaee by Ben Gamari at 2023-05-09T04:01:31+00:00 Use glossary directive - - - - - 1 changed file: - docs/users_guide/glossary.rst Changes: ===================================== docs/users_guide/glossary.rst ===================================== @@ -1,12 +1,13 @@ Glossary ======== -technology preview:: +.. glossary:: + technology preview - GHC will occassionally ship features advertised as being in a *technology - preview* state. Such features are generally opt-in in nature (e.g. new - language extensions) and may have various shortcomings. These may include - known bugs (which we will try to document), lacking optimisation, and - unhandled interactions with other language features. As such, behavior - of such features may change in the future. However, we do expect features - to converge to non-preview state over the course of a few GHC major releases. + GHC will occassionally ship features advertised as being in a *technology + preview* state. Such features are generally opt-in in nature (e.g. new + language extensions) and may have various shortcomings. These may include + known bugs (which we will try to document), lacking optimisation, and + unhandled interactions with other language features. As such, behavior + of such features may change in the future. However, we do expect features + to converge to non-preview state over the course of a few GHC major releases. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/774cfaeefd521a15f39d4aa378b00758ee081e58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/774cfaeefd521a15f39d4aa378b00758ee081e58 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 04:19:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 00:19:42 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] 29 commits: Add sized primitive literal syntax Message-ID: <6459c9dea086c_38ffda87052ff8793178@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 26c3ab3e by Ben Gamari at 2023-05-09T00:18:49-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) - - - - - 09fb21d7 by Ben Gamari at 2023-05-09T00:18:49-04:00 compiler: Record original thunk info tables on stack - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d75c8271a8cc3ee6ff4318d935f84e34ed44072...09fb21d748fbc5d6805dcf8e260c16b2ef686fcf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d75c8271a8cc3ee6ff4318d935f84e34ed44072...09fb21d748fbc5d6805dcf8e260c16b2ef686fcf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 04:30:57 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 00:30:57 -0400 Subject: [Git][ghc/ghc][wip/T13660] 31 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <6459cc81b2d83_38ffda870d63447975bb@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 89dae1c2 by Ben Gamari at 2023-03-29T14:00:27-04:00 base: Add test for #13660 - - - - - 4850ab82 by Ben Gamari at 2023-03-30T19:09:05-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 16826c77 by Ben Gamari at 2023-03-30T19:09:05-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - 6c7aa824 by Ben Gamari at 2023-03-30T19:09:05-04:00 base: Clean up documentation - - - - - 6625b5fc by Ben Gamari at 2023-03-30T19:09:05-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - libraries/base/Data/Data.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/IORef.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Conc/Sync.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b99477030a04d52962c816f188a5b4c82045c6a5...6625b5fc91b4771971826b4bc245a24e7fc2b245 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b99477030a04d52962c816f188a5b4c82045c6a5...6625b5fc91b4771971826b4bc245a24e7fc2b245 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 04:32:23 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 00:32:23 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] Update IORef.hs Message-ID: <6459ccd7dc79a_38ffda870d6344799034@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: ec9c1e8b by Ben Gamari at 2023-05-09T04:32:22+00:00 Update IORef.hs - - - - - 1 changed file: - libraries/base/GHC/IORef.hs Changes: ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,7 +127,6 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a -atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> atomicSwapIORef (IORef (STRef ref)) new = IO (atomicSwapMutVar# ref new) -- | A strict version of 'Data.IORef.atomicModifyIORef'. This forces both the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec9c1e8ba3e0f3d94b4caca5d72d7aca13f7aee4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec9c1e8ba3e0f3d94b4caca5d72d7aca13f7aee4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 04:38:10 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 00:38:10 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 3 commits: hi Message-ID: <6459ce324701_38ffda88242d58803620@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: 63735007 by Ben Gamari at 2023-05-08T17:17:16-04:00 hi - - - - - ec0a50b7 by Ben Gamari at 2023-05-08T19:18:53-04:00 CausedBy - - - - - c0b8a4f0 by Ben Gamari at 2023-05-09T00:24:18-04:00 NoCatch - - - - - 3 changed files: - libraries/base/GHC/Exception/Context.hs - libraries/base/GHC/Exception/Type.hs - libraries/base/GHC/IO.hs Changes: ===================================== libraries/base/GHC/Exception/Context.hs ===================================== @@ -64,7 +64,7 @@ addExceptionAnnotation x (ExceptionContext xs) = ExceptionContext (SomeException getExceptionAnnotations :: forall a. ExceptionAnnotation a => ExceptionContext -> [a] getExceptionAnnotations (ExceptionContext xs) = [ x - | SomeExceptionAnnotation (x :: b) <- xs + | SomeExceptionAnnotation (x :: b) <- xs , Just HRefl <- return (typeRep @a `eqTypeRep` typeRep @b) ] ===================================== libraries/base/GHC/Exception/Type.hs ===================================== @@ -32,6 +32,8 @@ module GHC.Exception.Type , emptyExceptionContext , mergeExceptionContext , ExceptionWithContext(..) + -- * CausedBy annotations + , CausedBy(..) -- * Arithmetic exceptions , ArithException(..) , divZeroException, overflowException, ratioZeroDenomException @@ -225,6 +227,15 @@ instance Exception a => Exception (ExceptionWithContext a) where backtraceDesired (ExceptionWithContext _ e) = backtraceDesired e displayException = displayException . toException +-- | An 'ExceptionAnnotation' which wraps the exception which +-- +-- @since 4.19.0.0 +newtype CausedBy = CausedBy SomeException + +instance ExceptionAnnotation CausedBy where + displayExceptionAnnotation (CausedBy e) = + "Caused by: " ++ displayException e + -- |Arithmetic exceptions. data ArithException = Overflow ===================================== libraries/base/GHC/IO.hs ===================================== @@ -161,6 +161,10 @@ catchException !io handler = catch io handler -- to catch exceptions of any type, see the section \"Catching all -- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so. -- +-- If the exception handler throws an exception during execution, the +-- thrown exception will be annotated with a 'CausedBy' +-- 'ExceptionAnnotation'. +-- -- For catching exceptions in pure (non-'IO') expressions, see the -- function 'evaluate'. -- @@ -184,11 +188,24 @@ catch :: Exception e -> (e -> IO a) -- ^ Handler to invoke if an exception is raised -> IO a -- See #exceptions_and_strictness#. -catch (IO io) handler = IO $ catch# io handler' +catch io handler = catchNoCause io (\e -> withCausedBy e (handler e)) + +-- | Catch an exception without adding a 'CausedBy' 'ExceptionContext' to any +-- exceptions thrown by the handler. See the documentation of 'catch' for a +-- detailed description of the semantics of this function. +-- +-- @since 4.19.0.0 +catchNoCause + :: Exception e + => IO a -- ^ The computation to run + -> (e -> IO a) -- ^ Handler to invoke if an exception is raised + -> IO a +-- See #exceptions_and_strictness#. +catchNoCause (IO io) handler = IO $ catch# io handler' where handler' e = case fromException e of - Just e' -> unIO (withAugmentedContext (exceptionContext e) (handler e')) + Just e' -> unIO (handler e') Nothing -> raiseIO# e -- | Catch any 'Exception' type in the 'IO' monad. @@ -200,12 +217,10 @@ catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a catchAny !(IO io) handler = IO $ catch# io handler' where handler' se@(SomeException e) = - unIO (withAugmentedContext (exceptionContext se) (handler e)) + unIO (withCausedBy se (handler e)) -withAugmentedContext :: ExceptionContext -> IO a -> IO a -withAugmentedContext ctxt (IO io) = IO (catch# io handler) - where - handler se = raiseIO# (augmentExceptionContext ctxt se) +withCausedBy :: SomeException -> IO a -> IO a +withCausedBy cause = annotateIO (CausedBy cause) -- | Execute an 'IO' action, adding the given 'ExceptionContext' -- to any thrown synchronous exceptions. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c39cf7827eb4f96ce27efa784440f19514abc919...c0b8a4f0294a420cf8e2bc9d1233ca2ae094022e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c39cf7827eb4f96ce27efa784440f19514abc919...c0b8a4f0294a420cf8e2bc9d1233ca2ae094022e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 05:46:27 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 09 May 2023 01:46:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/compact-sourcetext Message-ID: <6459de335c5b2_38ffda8ce833c08273d3@gitlab.mail> Zubin pushed new branch wip/compact-sourcetext at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/compact-sourcetext You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 06:46:46 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 09 May 2023 02:46:46 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/b/ghcup-metadata-nightly Message-ID: <6459ec561149e_38ffda8f573d90840333@gitlab.mail> Bryan R pushed new branch wip/b/ghcup-metadata-nightly at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/b/ghcup-metadata-nightly You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 08:44:37 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 09 May 2023 04:44:37 -0400 Subject: [Git][ghc/ghc][wip/compact-sourcetext] 3 commits: Use compact representation for SourceText Message-ID: <645a07f562196_38ffda97b7b8fc89849d@gitlab.mail> Zubin pushed to branch wip/compact-sourcetext at Glasgow Haskell Compiler / GHC Commits: c693827b by Zubin Duggal at 2023-05-09T14:14:29+05:30 Use compact representation for SourceText - - - - - 6d1880ec by Zubin Duggal at 2023-05-09T14:14:29+05:30 Use compact representation for SourceNotes - - - - - dbf2a234 by Zubin Duggal at 2023-05-09T14:14:29+05:30 Use compact representation for UsageFile (#22744) - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/IPE.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Types/Tickish.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46c06c09d7a01638be00c5d8aa889a96cf798205...dbf2a234c5bf0361df39daafdb934441181720cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46c06c09d7a01638be00c5d8aa889a96cf798205...dbf2a234c5bf0361df39daafdb934441181720cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 09:03:50 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 09 May 2023 05:03:50 -0400 Subject: [Git][ghc/ghc][wip/b/ghcup-metadata-nightly] Fix up rules for ghcup-metadata-nightly-push Message-ID: <645a0c7612c4c_38ffda98a7f0b09076be@gitlab.mail> Bryan R pushed to branch wip/b/ghcup-metadata-nightly at Glasgow Haskell Compiler / GHC Commits: 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: rules: - if: $NIGHTLY -# Update the +# Update the ghcup metadata with information about this nightly pipeline ghcup-metadata-nightly-push: stage: deploy image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" @@ -1072,11 +1072,8 @@ ghcup-metadata-nightly-push: - git commit -m "Update metadata" - git push gitlab_origin HEAD:updates -o ci.skip rules: - - if: $NIGHTLY # Only run the update on scheduled nightly pipelines, ie once a day - - if: $CI_PIPELINE_SOURCE == "schedule" - # And only update the metadata for master branch - - if: '$CI_COMMIT_BRANCH == "master"' + - if: $NIGHTLY && $CI_PIPELINE_SOURCE == "schedule" && $CI_COMMIT_BRANCH == "master" ghcup-metadata-release: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e2df4c9ac59a10080bd6e029e83a355ecd01c8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e2df4c9ac59a10080bd6e029e83a355ecd01c8b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 09:47:51 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 09 May 2023 05:47:51 -0400 Subject: [Git][ghc/ghc][wip/dynamic-alpine] Build vanilla alpine bindists Message-ID: <645a16c78440c_38ffda9c5e41f0933540@gitlab.mail> Matthew Pickering pushed to branch wip/dynamic-alpine at Glasgow Haskell Compiler / GHC Commits: 17b70f2e by Matthew Pickering at 2023-05-09T10:47:40+01:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 3 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -424,7 +424,7 @@ distroVariables Alpine = mconcat -- T10458, ghcilink002: due to #17869 -- linker_unload_native: due to musl not supporting any means of probing dynlib dependencies -- (see Note [Object unloading]). - , "BROKEN_TESTS" =: "encoding004 T10458 ghcilink002 linker_unload_native" + , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native" ] distroVariables Centos7 = mconcat [ "HADRIAN_ARGS" =: "--docs=no-sphinx" @@ -903,8 +903,11 @@ job_groups = , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) - , standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static) - , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + -- Fully static build, in theory usable on any linux distribution. + , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) + -- Dynamically linked build, suitable for building your own static executables on alpine + , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) + , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") ) @@ -919,6 +922,10 @@ job_groups = ] where + + -- ghcilink002 broken due to #17869 + fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 ") + hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url") tsan_jobs = ===================================== .gitlab/jobs.yaml ===================================== @@ -597,7 +597,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -606,6 +606,68 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-alpine3_12-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "8 weeks", + "paths": [ + "ghc-x86_64-linux-alpine3_12-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--docs=no-sphinx", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -659,7 +721,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -2472,7 +2534,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2535,7 +2597,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2545,6 +2607,69 @@ "XZ_OPT": "-9" } }, + "release-x86_64-linux-alpine3_12-release+no_split_sections": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "release+no_split_sections", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", + "IGNORE_PERF_FAILURES": "all", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", + "XZ_OPT": "-9" + } + }, "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3581,7 +3706,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -30,6 +30,7 @@ def job_triple(job_name): 'release-x86_64-linux-deb9-release': 'x86_64-deb9-linux', 'release-x86_64-linux-centos7-release': 'x86_64-centos7-linux', 'release-x86_64-linux-alpine3_12-release+fully_static': 'x86_64-alpine3_12-linux-static', + 'release-x86_64-linux-alpine3_12-release': 'x86_64-alpine3_12-linux', 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17b70f2ecebaa2506da949f07327a98654627cdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17b70f2ecebaa2506da949f07327a98654627cdb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 11:21:27 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 09 May 2023 07:21:27 -0400 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] Use unboxed codebuffers in base Message-ID: <645a2cb72ca6_38ffdaa1f2bcf4964469@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: 536e0538 by Josh Meredith at 2023-05-09T11:19:39+00:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 8 changed files: - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/Encoding/Failure.hs - libraries/base/GHC/IO/Encoding/Iconv.hs - libraries/base/GHC/IO/Encoding/Latin1.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs Changes: ===================================== libraries/base/GHC/IO/Encoding.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} ----------------------------------------------------------------------------- @@ -336,11 +337,13 @@ mkTextEncoding' cfm enc = latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8) -latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8 +latin1_encode input output = IO $ \st -> case Latin1.latin1_encode input output st of + (# st', _why, input', output' #) -> (# st', (input', output') #) -- unchecked, used for char8 --latin1_encode = unsafePerformIO $ do mkTextEncoder Iconv.latin1 >>= return.encode latin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer) -latin1_decode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_decode input output +latin1_decode input output = IO $ \st -> case Latin1.latin1_decode input output st of + (# st', _why, input', output' #) -> (# st', (input',output') #) --latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode unknownEncodingErr :: String -> IO a ===================================== libraries/base/GHC/IO/Encoding/CodePage/API.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, NondecreasingIndentation, - RecordWildCards, ScopedTypeVariables #-} + RecordWildCards, ScopedTypeVariables, + UnboxedTuples #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} module GHC.IO.Encoding.CodePage.API ( @@ -157,11 +158,15 @@ newCP rec fn cp = do utf16_native_encode' :: EncodeBuffer utf16_native_decode' :: DecodeBuffer #if defined(WORDS_BIGENDIAN) -utf16_native_encode' = utf16be_encode -utf16_native_decode' = utf16be_decode +utf16_native_encode' i o = IO $ \st -> case utf16be_encode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) +utf16_native_decode' i o = IO $ \st -> case utf16be_decode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) #else -utf16_native_encode' = utf16le_encode -utf16_native_decode' = utf16le_decode +utf16_native_encode' i o = IO $ \st -> case utf16le_encode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) +utf16_native_decode' i o = IO $ \st -> case utf16le_decode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) #endif saner :: CodeBuffer from to ===================================== libraries/base/GHC/IO/Encoding/Failure.hs ===================================== @@ -1,5 +1,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- | @@ -18,7 +21,8 @@ module GHC.IO.Encoding.Failure ( CodingFailureMode(..), codingFailureModeSuffix, isSurrogate, - recoverDecode, recoverEncode + recoverDecode, recoverEncode, + recoverDecode#, recoverEncode#, ) where import GHC.IO @@ -142,6 +146,12 @@ unescapeRoundtripCharacterSurrogate c | otherwise = Nothing where x = ord c +recoverDecode# :: CodingFailureMode -> Buffer Word8 -> Buffer Char + -> State# RealWorld -> (# State# RealWorld, Buffer Word8, Buffer Char #) +recoverDecode# cfm input output st = + let !(# st', (bIn, bOut) #) = unIO (recoverDecode cfm input output) st + in (# st', bIn, bOut #) + recoverDecode :: CodingFailureMode -> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char) recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } @@ -160,6 +170,12 @@ recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } ow' <- writeCharBuf oraw ow (escapeToRoundtripCharacterSurrogate b) return (input { bufL=ir+1 }, output { bufR=ow' }) +recoverEncode# :: CodingFailureMode -> Buffer Char -> Buffer Word8 + -> State# RealWorld -> (# State# RealWorld, Buffer Char, Buffer Word8 #) +recoverEncode# cfm input output st = + let !(# st', (bIn, bOut) #) = unIO (recoverEncode cfm input output) st + in (# st', bIn, bOut #) + recoverEncode :: CodingFailureMode -> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8) recoverEncode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } ===================================== libraries/base/GHC/IO/Encoding/Iconv.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE CPP , NoImplicitPrelude , NondecreasingIndentation + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} @@ -133,19 +135,24 @@ newIConv from to rec fn = withCAString to $ \ to_str -> do iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt - return BufferCodec{ - encode = fn iconvt, - recover = rec, - close = iclose, + fn_iconvt ibuf obuf st = case unIO (fn iconvt ibuf obuf) st of + (# st', (prog, ibuf', obuf') #) -> (# st', prog, ibuf', obuf' #) + return BufferCodec# { + encode# = fn_iconvt, + recover# = rec#, + close# = iclose, -- iconv doesn't supply a way to save/restore the state - getState = return (), - setState = const $ return () + getState# = return (), + setState# = const $ return () } + where + rec# ibuf obuf st = case unIO (rec ibuf obuf) st of + (# st', (ibuf', obuf') #) -> (# st', ibuf', obuf' #) -iconvDecode :: IConv -> DecodeBuffer +iconvDecode :: IConv -> Buffer Word8 -> Buffer Char -> IO (CodingProgress, Buffer Word8, Buffer Char) iconvDecode iconv_t ibuf obuf = iconvRecode iconv_t ibuf 0 obuf char_shift -iconvEncode :: IConv -> EncodeBuffer +iconvEncode :: IConv -> Buffer Char -> Buffer Word8 -> IO (CodingProgress, Buffer Char, Buffer Word8) iconvEncode iconv_t ibuf obuf = iconvRecode iconv_t ibuf char_shift obuf 0 iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int ===================================== libraries/base/GHC/IO/Encoding/Latin1.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE NoImplicitPrelude , BangPatterns , NondecreasingIndentation + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -56,22 +58,22 @@ mkLatin1 cfm = TextEncoding { textEncodingName = "ISO-8859-1", latin1_DF :: CodingFailureMode -> IO (TextDecoder ()) latin1_DF cfm = - return (BufferCodec { - encode = latin1_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) latin1_EF :: CodingFailureMode -> IO (TextEncoder ()) latin1_EF cfm = - return (BufferCodec { - encode = latin1_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) latin1_checked :: TextEncoding @@ -85,12 +87,12 @@ mkLatin1_checked cfm = TextEncoding { textEncodingName = "ISO-8859-1", latin1_checked_EF :: CodingFailureMode -> IO (TextEncoder ()) latin1_checked_EF cfm = - return (BufferCodec { - encode = latin1_checked_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_checked_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -- ----------------------------------------------------------------------------- @@ -108,22 +110,22 @@ mkAscii cfm = TextEncoding { textEncodingName = "ASCII", ascii_DF :: CodingFailureMode -> IO (TextDecoder ()) ascii_DF cfm = - return (BufferCodec { - encode = ascii_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = ascii_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) ascii_EF :: CodingFailureMode -> IO (TextEncoder ()) ascii_EF cfm = - return (BufferCodec { - encode = ascii_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = ascii_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) @@ -134,97 +136,115 @@ ascii_EF cfm = -- TODO: Eliminate code duplication between the checked and unchecked -- versions of the decoder or encoder (but don't change the Core!) -latin1_decode :: DecodeBuffer +latin1_decode :: DecodeBuffer# latin1_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 + !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -ascii_decode :: DecodeBuffer +ascii_decode :: DecodeBuffer# ascii_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - if c0 > 0x7f then invalid else do - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 + if c0 > 0x7f then invalid st1 else do + let !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -latin1_encode :: EncodeBuffer +latin1_encode :: EncodeBuffer# latin1_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - writeWord8Buf oraw ow (fromIntegral (ord c)) - loop ir' (ow+1) + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (ord c))) st1 + loop ir' (ow+1) st2 in - loop ir0 ow0 + loop ir0 ow0 st -latin1_checked_encode :: EncodeBuffer +latin1_checked_encode :: EncodeBuffer# latin1_checked_encode input output = single_byte_checked_encode 0xff input output -ascii_encode :: EncodeBuffer +ascii_encode :: EncodeBuffer# ascii_encode input output = single_byte_checked_encode 0x7f input output -single_byte_checked_encode :: Int -> EncodeBuffer +single_byte_checked_encode :: Int -> EncodeBuffer# single_byte_checked_encode max_legal_char input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if ord c > max_legal_char then invalid else do - writeWord8Buf oraw ow (fromIntegral (ord c)) - loop ir' (ow+1) + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if ord c > max_legal_char then invalid st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (ord c))) st1 + loop ir' (ow+1) st2 where - invalid = done InvalidSequence ir ow + invalid :: EncodingBuffer# + invalid st' = done InvalidSequence ir ow st' in - loop ir0 ow0 + loop ir0 ow0 st {-# INLINE single_byte_checked_encode #-} ===================================== libraries/base/GHC/IO/Encoding/UTF16.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -61,64 +62,66 @@ mkUTF16 cfm = TextEncoding { textEncodingName = "UTF-16", mkTextDecoder = utf16_DF cfm, mkTextEncoder = utf16_EF cfm } -utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) +utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#)) utf16_DF cfm = do seen_bom <- newIORef Nothing - return (BufferCodec { - encode = utf16_decode seen_bom, - recover = recoverDecode cfm, - close = return (), - getState = readIORef seen_bom, - setState = writeIORef seen_bom + return (BufferCodec# { + encode# = utf16_decode seen_bom, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef seen_bom, + setState# = writeIORef seen_bom }) utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf16_EF cfm = do done_bom <- newIORef False - return (BufferCodec { - encode = utf16_encode done_bom, - recover = recoverEncode cfm, - close = return (), - getState = readIORef done_bom, - setState = writeIORef done_bom + return (BufferCodec# { + encode# = utf16_encode done_bom, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef done_bom, + setState# = writeIORef done_bom }) -utf16_encode :: IORef Bool -> EncodeBuffer +utf16_encode :: IORef Bool -> EncodeBuffer# utf16_encode done_bom input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef done_bom - if b then utf16_native_encode input output + let !(# st1, b #) = unIO (readIORef done_bom) st0 + if b then utf16_native_encode input output st1 else if os - ow < 2 - then return (OutputUnderflow,input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef done_bom True - writeWord8Buf oraw ow bom1 - writeWord8Buf oraw (ow+1) bom2 - utf16_native_encode input output{ bufR = ow+2 } + let !(# st2, () #) = unIO (writeIORef done_bom True) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom2) st3 + utf16_native_encode input output{ bufR = ow+2 } st4 -utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer +utf16_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer# utf16_decode seen_bom input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - mb <- readIORef seen_bom + let !(# st1, mb #) = unIO (readIORef seen_bom) st0 case mb of - Just decode -> decode input output + Just decode -> decode input output st1 Nothing -> - if iw - ir < 2 then return (InputUnderflow,input,output) else do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) + if iw - ir < 2 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 case () of - _ | c0 == bomB && c1 == bomL -> do - writeIORef seen_bom (Just utf16be_decode) - utf16be_decode input{ bufL= ir+2 } output - | c0 == bomL && c1 == bomB -> do - writeIORef seen_bom (Just utf16le_decode) - utf16le_decode input{ bufL= ir+2 } output - | otherwise -> do - writeIORef seen_bom (Just utf16_native_decode) - utf16_native_decode input output + _ | c0 == bomB && c1 == bomL -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16be_decode)) st3 + in utf16be_decode input{ bufL= ir+2 } output st4 + | c0 == bomL && c1 == bomB -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16le_decode)) st3 + in utf16le_decode input{ bufL= ir+2 } output st4 + | otherwise -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16_native_decode)) st3 + in utf16_native_decode input output st4 bomB, bomL, bom1, bom2 :: Word8 @@ -126,10 +129,10 @@ bomB = 0xfe bomL = 0xff -- choose UTF-16BE by default for UTF-16 output -utf16_native_decode :: DecodeBuffer +utf16_native_decode :: DecodeBuffer# utf16_native_decode = utf16be_decode -utf16_native_encode :: EncodeBuffer +utf16_native_encode :: EncodeBuffer# utf16_native_encode = utf16be_encode bom1 = bomB @@ -149,22 +152,22 @@ mkUTF16be cfm = TextEncoding { textEncodingName = "UTF-16BE", utf16be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16be_DF cfm = - return (BufferCodec { - encode = utf16be_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16be_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16be_EF cfm = - return (BufferCodec { - encode = utf16be_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16be_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16le :: TextEncoding @@ -178,114 +181,127 @@ mkUTF16le cfm = TextEncoding { textEncodingName = "UTF16-LE", utf16le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16le_DF cfm = - return (BufferCodec { - encode = utf16le_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16le_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16le_EF cfm = - return (BufferCodec { - encode = utf16le_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16le_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -utf16be_decode :: DecodeBuffer +utf16be_decode :: DecodeBuffer# utf16be_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow - | ir + 1 == iw = done InputUnderflow ir ow + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | ir + 1 == iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 let x1 = fromIntegral c0 `shiftL` 8 + fromIntegral c1 if validate1 x1 - then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1)) - loop (ir+2) ow' - else if iw - ir < 4 then done InputUnderflow ir ow else do - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3 - if not (validate2 x1 x2) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 x1 x2) - loop (ir+4) ow' + then let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral x1))) st2 + in loop (ir+2) ow' st3 + else if iw - ir < 4 then done InputUnderflow ir ow st2 else do + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3 + if not (validate2 x1 x2) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr2 x1 x2)) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input { bufL = 0, bufR = 0 } else input { bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf16le_decode :: DecodeBuffer +utf16le_decode :: DecodeBuffer# utf16le_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow - | ir + 1 == iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | ir + 1 == iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 if validate1 x1 - then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1)) - loop (ir+2) ow' - else if iw - ir < 4 then done InputUnderflow ir ow else do - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 - if not (validate2 x1 x2) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 x1 x2) - loop (ir+4) ow' + then let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral x1))) st2 + in loop (ir+2) ow' st3 + else if iw - ir < 4 then done InputUnderflow ir ow st2 else do + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 + if not (validate2 x1 x2) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr2 x1 x2)) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf16be_encode :: EncodeBuffer +utf16be_encode :: EncodeBuffer# utf16be_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 2 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 2 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of - x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do - writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8)) - writeWord8Buf oraw (ow+1) (fromIntegral x) - loop ir' (ow+2) + x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8))) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) (fromIntegral x)) st2 + loop ir' (ow+2) st3 | otherwise -> do - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) @@ -294,35 +310,39 @@ utf16be_encode c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 -- - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - writeWord8Buf oraw (ow+3) c4 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c4) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -utf16le_encode :: EncodeBuffer +utf16le_encode :: EncodeBuffer# utf16le_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 2 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 2 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of - x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do - writeWord8Buf oraw ow (fromIntegral x) - writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8)) - loop ir' (ow+2) + x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))) st2 + loop ir' (ow+2) st3 | otherwise -> - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) @@ -331,13 +351,13 @@ utf16le_encode c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 -- - writeWord8Buf oraw ow c2 - writeWord8Buf oraw (ow+1) c1 - writeWord8Buf oraw (ow+2) c4 - writeWord8Buf oraw (ow+3) c3 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c2) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c4) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c3) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st chr2 :: Word16 -> Word16 -> Char chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#)) ===================================== libraries/base/GHC/IO/Encoding/UTF32.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -61,68 +62,70 @@ mkUTF32 cfm = TextEncoding { textEncodingName = "UTF-32", mkTextDecoder = utf32_DF cfm, mkTextEncoder = utf32_EF cfm } -utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) +utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#)) utf32_DF cfm = do seen_bom <- newIORef Nothing - return (BufferCodec { - encode = utf32_decode seen_bom, - recover = recoverDecode cfm, - close = return (), - getState = readIORef seen_bom, - setState = writeIORef seen_bom + return (BufferCodec# { + encode# = utf32_decode seen_bom, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef seen_bom, + setState# = writeIORef seen_bom }) utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf32_EF cfm = do done_bom <- newIORef False - return (BufferCodec { - encode = utf32_encode done_bom, - recover = recoverEncode cfm, - close = return (), - getState = readIORef done_bom, - setState = writeIORef done_bom + return (BufferCodec# { + encode# = utf32_encode done_bom, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef done_bom, + setState# = writeIORef done_bom }) -utf32_encode :: IORef Bool -> EncodeBuffer +utf32_encode :: IORef Bool -> EncodeBuffer# utf32_encode done_bom input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef done_bom - if b then utf32_native_encode input output + let !(# st1, b #) = unIO (readIORef done_bom) st0 + if b then utf32_native_encode input output st1 else if os - ow < 4 - then return (OutputUnderflow, input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef done_bom True - writeWord8Buf oraw ow bom0 - writeWord8Buf oraw (ow+1) bom1 - writeWord8Buf oraw (ow+2) bom2 - writeWord8Buf oraw (ow+3) bom3 - utf32_native_encode input output{ bufR = ow+4 } - -utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer + let !(# st2, () #) = unIO (writeIORef done_bom True) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom0) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+2) bom2) st4 + !(# st6, () #) = unIO (writeWord8Buf oraw (ow+3) bom3) st5 + utf32_native_encode input output{ bufR = ow+4 } st6 + +utf32_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer# utf32_decode seen_bom input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - mb <- readIORef seen_bom + let !(# st1, mb #) = unIO (readIORef seen_bom) st0 case mb of - Just decode -> decode input output + Just decode -> decode input output st1 Nothing -> - if iw - ir < 4 then return (InputUnderflow, input,output) else do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + if iw - ir < 4 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 + !(# st4, c2 #) = unIO (readWord8Buf iraw (ir+2)) st3 + !(# st5, c3 #) = unIO (readWord8Buf iraw (ir+3)) st4 case () of - _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> do - writeIORef seen_bom (Just utf32be_decode) - utf32be_decode input{ bufL= ir+4 } output - _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> do - writeIORef seen_bom (Just utf32le_decode) - utf32le_decode input{ bufL= ir+4 } output - | otherwise -> do - writeIORef seen_bom (Just utf32_native_decode) - utf32_native_decode input output + _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32be_decode)) st5 + in utf32be_decode input{ bufL= ir+4 } output st6 + _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32le_decode)) st5 + in utf32le_decode input{ bufL= ir+4 } output st6 + | otherwise -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32_native_decode)) st5 + in utf32_native_decode input output st6 bom0, bom1, bom2, bom3 :: Word8 @@ -132,10 +135,10 @@ bom2 = 0xfe bom3 = 0xff -- choose UTF-32BE by default for UTF-32 output -utf32_native_decode :: DecodeBuffer +utf32_native_decode :: DecodeBuffer# utf32_native_decode = utf32be_decode -utf32_native_encode :: EncodeBuffer +utf32_native_encode :: EncodeBuffer# utf32_native_encode = utf32be_encode -- ----------------------------------------------------------------------------- @@ -152,22 +155,22 @@ mkUTF32be cfm = TextEncoding { textEncodingName = "UTF-32BE", utf32be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf32be_DF cfm = - return (BufferCodec { - encode = utf32be_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32be_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf32be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf32be_EF cfm = - return (BufferCodec { - encode = utf32be_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32be_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) @@ -182,128 +185,145 @@ mkUTF32le cfm = TextEncoding { textEncodingName = "UTF-32LE", utf32le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf32le_DF cfm = - return (BufferCodec { - encode = utf32le_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32le_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf32le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf32le_EF cfm = - return (BufferCodec { - encode = utf32le_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32le_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -utf32be_decode :: DecodeBuffer +utf32be_decode :: DecodeBuffer# utf32be_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | iw - ir < 4 = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | iw - ir < 4 = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 let x1 = chr4 c0 c1 c2 c3 - if not (validate x1) then invalid else do - ow' <- writeCharBuf oraw ow x1 - loop (ir+4) ow' + if not (validate x1) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf32le_decode :: DecodeBuffer +utf32le_decode :: DecodeBuffer# utf32le_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | iw - ir < 4 = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | iw - ir < 4 = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 let x1 = chr4 c3 c2 c1 c0 - if not (validate x1) then invalid else do - ow' <- writeCharBuf oraw ow x1 - loop (ir+4) ow' + if not (validate x1) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf32be_encode :: EncodeBuffer +utf32be_encode :: EncodeBuffer# utf32be_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 4 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 4 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if isSurrogate c then done InvalidSequence ir ow else do + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if isSurrogate c then done InvalidSequence ir ow st1 else do let (c0,c1,c2,c3) = ord4 c - writeWord8Buf oraw ow c0 - writeWord8Buf oraw (ow+1) c1 - writeWord8Buf oraw (ow+2) c2 - writeWord8Buf oraw (ow+3) c3 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c0) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c2) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c3) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -utf32le_encode :: EncodeBuffer +utf32le_encode :: EncodeBuffer# utf32le_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 4 = done OutputUnderflow ir ow + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 4 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if isSurrogate c then done InvalidSequence ir ow else do + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if isSurrogate c then done InvalidSequence ir ow st1 else do let (c0,c1,c2,c3) = ord4 c - writeWord8Buf oraw ow c3 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c1 - writeWord8Buf oraw (ow+3) c0 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c3) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c0) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) = ===================================== libraries/base/GHC/IO/Encoding/UTF8.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -56,22 +57,22 @@ mkUTF8 cfm = TextEncoding { textEncodingName = "UTF-8", utf8_DF :: CodingFailureMode -> IO (TextDecoder ()) utf8_DF cfm = - return (BufferCodec { - encode = utf8_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf8_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf8_EF :: CodingFailureMode -> IO (TextEncoder ()) utf8_EF cfm = - return (BufferCodec { - encode = utf8_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf8_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf8_bom :: TextEncoding @@ -85,177 +86,188 @@ mkUTF8_bom cfm = TextEncoding { textEncodingName = "UTF-8BOM", utf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool) utf8_bom_DF cfm = do ref <- newIORef True - return (BufferCodec { - encode = utf8_bom_decode ref, - recover = recoverDecode cfm, - close = return (), - getState = readIORef ref, - setState = writeIORef ref + return (BufferCodec# { + encode# = utf8_bom_decode ref, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef ref, + setState# = writeIORef ref }) utf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf8_bom_EF cfm = do ref <- newIORef True - return (BufferCodec { - encode = utf8_bom_encode ref, - recover = recoverEncode cfm, - close = return (), - getState = readIORef ref, - setState = writeIORef ref + return (BufferCodec# { + encode# = utf8_bom_encode ref, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef ref, + setState# = writeIORef ref }) -utf8_bom_decode :: IORef Bool -> DecodeBuffer +utf8_bom_decode :: IORef Bool -> DecodeBuffer# utf8_bom_decode ref input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - first <- readIORef ref + let !(# st1, first #) = unIO (readIORef ref) st0 if not first - then utf8_decode input output + then utf8_decode input output st1 else do - let no_bom = do writeIORef ref False; utf8_decode input output - if iw - ir < 1 then return (InputUnderflow,input,output) else do - c0 <- readWord8Buf iraw ir + let no_bom = let !(# st', () #) = unIO (writeIORef ref False) st1 in utf8_decode input output st' + if iw - ir < 1 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir) st1 if (c0 /= bom0) then no_bom else do - if iw - ir < 2 then return (InputUnderflow,input,output) else do - c1 <- readWord8Buf iraw (ir+1) + if iw - ir < 2 then (# st2,InputUnderflow,input,output #) else do + let !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 if (c1 /= bom1) then no_bom else do - if iw - ir < 3 then return (InputUnderflow,input,output) else do - c2 <- readWord8Buf iraw (ir+2) + if iw - ir < 3 then (# st3,InputUnderflow,input,output #) else do + let !(# st4, c2 #) = unIO (readWord8Buf iraw (ir+2)) st3 if (c2 /= bom2) then no_bom else do -- found a BOM, ignore it and carry on - writeIORef ref False - utf8_decode input{ bufL = ir + 3 } output + let !(# st5, () #) = unIO (writeIORef ref False) st4 + utf8_decode input{ bufL = ir + 3 } output st5 -utf8_bom_encode :: IORef Bool -> EncodeBuffer +utf8_bom_encode :: IORef Bool -> EncodeBuffer# utf8_bom_encode ref input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef ref - if not b then utf8_encode input output + let !(# st1, b #) = unIO (readIORef ref) st0 + if not b then utf8_encode input output st1 else if os - ow < 3 - then return (OutputUnderflow,input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef ref False - writeWord8Buf oraw ow bom0 - writeWord8Buf oraw (ow+1) bom1 - writeWord8Buf oraw (ow+2) bom2 - utf8_encode input output{ bufR = ow+3 } + let !(# st2, () #) = unIO (writeIORef ref False) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom0) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+2) bom2) st4 + utf8_encode input output{ bufR = ow+3 } st5 bom0, bom1, bom2 :: Word8 bom0 = 0xef bom1 = 0xbb bom2 = 0xbf -utf8_decode :: DecodeBuffer +utf8_decode :: DecodeBuffer# utf8_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 case c0 of _ | c0 <= 0x7f -> do - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' - | c0 >= 0xc0 && c0 <= 0xc1 -> invalid -- Overlong forms + let !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 + | c0 >= 0xc0 && c0 <= 0xc1 -> invalid st1 -- Overlong forms | c0 >= 0xc2 && c0 <= 0xdf -> - if iw - ir < 2 then done InputUnderflow ir ow else do - c1 <- readWord8Buf iraw (ir+1) - if (c1 < 0x80 || c1 >= 0xc0) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 c0 c1) - loop (ir+2) ow' + if iw - ir < 2 then done InputUnderflow ir ow st1 else do + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + if (c1 < 0x80 || c1 >= 0xc0) then invalid st2 else do + let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (chr2 c0 c1)) st2 + loop (ir+2) ow' st3 | c0 >= 0xe0 && c0 <= 0xef -> case iw - ir of - 1 -> done InputUnderflow ir ow + 1 -> done InputUnderflow ir ow st1 2 -> do -- check for an error even when we don't have -- the full sequence yet (#3341) - c1 <- readWord8Buf iraw (ir+1) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 if not (validate3 c0 c1 0x80) - then invalid else done InputUnderflow ir ow + then invalid st2 else done InputUnderflow ir ow st2 _ -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - if not (validate3 c0 c1 c2) then invalid else do - ow' <- writeCharBuf oraw ow (chr3 c0 c1 c2) - loop (ir+3) ow' + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + if not (validate3 c0 c1 c2) then invalid st3 else do + let !(# st4, ow' #) = unIO (writeCharBuf oraw ow (chr3 c0 c1 c2)) st3 + loop (ir+3) ow' st4 | c0 >= 0xf0 -> case iw - ir of - 1 -> done InputUnderflow ir ow + 1 -> done InputUnderflow ir ow st1 2 -> do -- check for an error even when we don't have -- the full sequence yet (#3341) - c1 <- readWord8Buf iraw (ir+1) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 if not (validate4 c0 c1 0x80 0x80) - then invalid else done InputUnderflow ir ow + then invalid st2 else done InputUnderflow ir ow st2 3 -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 if not (validate4 c0 c1 c2 0x80) - then invalid else done InputUnderflow ir ow + then invalid st3 else done InputUnderflow ir ow st3 _ -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - if not (validate4 c0 c1 c2 c3) then invalid else do - ow' <- writeCharBuf oraw ow (chr4 c0 c1 c2 c3) - loop (ir+4) ow' + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + if not (validate4 c0 c1 c2 c3) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr4 c0 c1 c2 c3)) st4 + loop (ir+4) ow' st5 | otherwise -> - invalid + invalid st1 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0} else input{ bufL = ir } + !ro = output { bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf8_encode :: EncodeBuffer +utf8_encode :: EncodeBuffer# utf8_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of x | x <= 0x7F -> do - writeWord8Buf oraw ow (fromIntegral x) - loop ir' (ow+1) + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 + loop ir' (ow+1) st2 | x <= 0x07FF -> - if os - ow < 2 then done OutputUnderflow ir ow else do + if os - ow < 2 then done OutputUnderflow ir ow st1 else do let (c1,c2) = ord2 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - loop ir' (ow+2) - | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow else do - if os - ow < 3 then done OutputUnderflow ir ow else do + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + loop ir' (ow+2) st3 + | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow st1 else do + if os - ow < 3 then done OutputUnderflow ir ow st1 else do let (c1,c2,c3) = ord3 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - loop ir' (ow+3) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + loop ir' (ow+3) st4 | otherwise -> do - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let (c1,c2,c3,c4) = ord4 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - writeWord8Buf oraw (ow+3) c4 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c4) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -- ----------------------------------------------------------------------------- -- UTF-8 primitives, lifted from Data.Text.Fusion.Utf8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/536e0538a9256e52229bbf8e10159e35593a155f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/536e0538a9256e52229bbf8e10159e35593a155f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 11:33:51 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 09 May 2023 07:33:51 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/b/ghcup-metadata-nightly Message-ID: <645a2f9f1f29d_38ffdaa2a08a649726d9@gitlab.mail> Bryan R deleted branch wip/b/ghcup-metadata-nightly at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 11:34:02 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 09 May 2023 07:34:02 -0400 Subject: [Git][ghc/ghc][master] Fix up rules for ghcup-metadata-nightly-push Message-ID: <645a2faabf9e8_38ffdaa273eb1c974839@gitlab.mail> Bryan R pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: rules: - if: $NIGHTLY -# Update the +# Update the ghcup metadata with information about this nightly pipeline ghcup-metadata-nightly-push: stage: deploy image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" @@ -1072,11 +1072,8 @@ ghcup-metadata-nightly-push: - git commit -m "Update metadata" - git push gitlab_origin HEAD:updates -o ci.skip rules: - - if: $NIGHTLY # Only run the update on scheduled nightly pipelines, ie once a day - - if: $CI_PIPELINE_SOURCE == "schedule" - # And only update the metadata for master branch - - if: '$CI_COMMIT_BRANCH == "master"' + - if: $NIGHTLY && $CI_PIPELINE_SOURCE == "schedule" && $CI_COMMIT_BRANCH == "master" ghcup-metadata-release: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e2df4c9ac59a10080bd6e029e83a355ecd01c8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e2df4c9ac59a10080bd6e029e83a355ecd01c8b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 12:33:37 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 08:33:37 -0400 Subject: [Git][ghc/ghc][wip/exception-context] hi Message-ID: <645a3da1841a0_38ffdaa6bfbdb8100149@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: 68027225 by Ben Gamari at 2023-05-09T08:33:30-04:00 hi - - - - - 1 changed file: - libraries/base/GHC/IO.hs Changes: ===================================== libraries/base/GHC/IO.hs ===================================== @@ -188,7 +188,12 @@ catch :: Exception e -> (e -> IO a) -- ^ Handler to invoke if an exception is raised -> IO a -- See #exceptions_and_strictness#. -catch io handler = catchNoCause io (\e -> withCausedBy e (handler e)) +catch (IO io) handler = IO $ catch# io handler' + where + handler' e = + case fromException e of + Just e' -> unIO (withCausedBy e $ handler e') + Nothing -> raiseIO# e -- | Catch an exception without adding a 'CausedBy' 'ExceptionContext' to any -- exceptions thrown by the handler. See the documentation of 'catch' for a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68027225a6a31e3dbaadee50139e15974c81ac7e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68027225a6a31e3dbaadee50139e15974c81ac7e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 12:34:51 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 08:34:51 -0400 Subject: [Git][ghc/ghc][wip/T13660] base: Ensure that FilePaths don't contain NULs Message-ID: <645a3deb7aa45_38ffdaa49c33401002131@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 8c28341e by Ben Gamari at 2023-05-09T08:34:44-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -34,7 +34,7 @@ import System.Posix.Types import Foreign import Foreign.C --- import Data.Bits +import Data.OldList (elem) import Data.Maybe #if !defined(HTYPE_TCFLAG_T) @@ -43,6 +43,7 @@ import System.IO.Error import GHC.Base import GHC.Num +import GHC.Ptr import GHC.Real import GHC.IO import GHC.IO.IOMode @@ -164,13 +165,23 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) + #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +189,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen0 enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen0 enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8c28341e66558cf0c1b382c32c7f5ddcd7ab45ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8c28341e66558cf0c1b382c32c7f5ddcd7ab45ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 12:42:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 08:42:03 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 164 commits: Handle records in the renamer Message-ID: <645a3f9b1fd40_38ffdaa49c33401005442@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec9c1e8ba3e0f3d94b4caca5d72d7aca13f7aee4...6b29154de6b63597553c5b69b9974c8838a7a80a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec9c1e8ba3e0f3d94b4caca5d72d7aca13f7aee4...6b29154de6b63597553c5b69b9974c8838a7a80a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 13:55:05 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 09 May 2023 09:55:05 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] Move "target has RTS linker" out of settings Message-ID: <645a50b99ea93_38ffdaaddca0c0106322a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: aef4155c by Rodrigo Mesquita at 2023-05-09T14:54:50+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4727,8 +4727,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . ===================================== compiler/GHC/Platform.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Platform , platformInIntRange , platformInWordRange , platformCConvNeedsExtension + , platformHasRTSLinker , PlatformMisc(..) , SseVersion (..) , BmiVersion (..) @@ -271,6 +272,20 @@ platformCConvNeedsExtension platform = case platformArch platform of | OSDarwin <- platformOS platform -> True _ -> False +-- | Does this platform have an RTS linker? +platformHasRTSLinker :: Platform -> Bool +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- powerpc + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + -------------------------------------------------- -- Instruction sets ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -451,7 +451,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -126,7 +126,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- For this information, we need to query ghc --info, however, that would + -- require building ghc, which we don't want to do here. Therefore, the + -- logic from `platformHasRTSLinker` is duplicated here. + let rtsLinker = arch `elem` ["powerpc", "powerpc64", "powerpc64le", "s390x", "riscv64", "loongarch64", "javascript", "wasm32"] return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aef4155c1e4c6ce75c523b43b4dfb748faeb5ac4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aef4155c1e4c6ce75c523b43b4dfb748faeb5ac4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 14:19:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 10:19:01 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Add structured error messages for GHC.IfaceToCore Message-ID: <645a565573e59_38ffdaaf4971181075746@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - 1d98a68e by doyougnu at 2023-05-09T10:18:38-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - f7c1e9eb by Krzysztof Gogolewski at 2023-05-09T10:18:39-04:00 Add a regression test for #21050 - - - - - 26 changed files: - .gitlab-ci.yml - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Types/Error/Codes.hs - compiler/ghc.cabal.in - + testsuite/tests/javascript/opt/all.T - + testsuite/tests/javascript/opt/deadCodeElim.hs - + testsuite/tests/javascript/opt/deadCodeElim.stdout - testsuite/tests/linters/notes.stdout - + testsuite/tests/th/T21050.hs - + testsuite/tests/th/T21050.stderr - testsuite/tests/th/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: rules: - if: $NIGHTLY -# Update the +# Update the ghcup metadata with information about this nightly pipeline ghcup-metadata-nightly-push: stage: deploy image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" @@ -1072,11 +1072,8 @@ ghcup-metadata-nightly-push: - git commit -m "Update metadata" - git push gitlab_origin HEAD:updates -o ci.skip rules: - - if: $NIGHTLY # Only run the update on scheduled nightly pipelines, ie once a day - - if: $CI_PIPELINE_SOURCE == "schedule" - # And only update the metadata for master branch - - if: '$CI_COMMIT_BRANCH == "master"' + - if: $NIGHTLY && $CI_PIPELINE_SOURCE == "schedule" && $CI_COMMIT_BRANCH == "master" ghcup-metadata-release: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -65,6 +65,8 @@ interfaceErrorHints = \ case missingInterfaceErrorHints err Can'tFindNameInInterface {} -> noHints + CircularImport {} -> + noHints missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] missingInterfaceErrorHints = \case @@ -86,6 +88,8 @@ interfaceErrorReason (Can'tFindInterface err _) = missingInterfaceErrorReason err interfaceErrorReason (Can'tFindNameInInterface {}) = ErrorWithoutFlag +interfaceErrorReason (CircularImport {}) + = ErrorWithoutFlag missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason missingInterfaceErrorReason = \ case @@ -287,6 +291,9 @@ interfaceErrorDiagnostic opts = \ case LookingForSig sig -> hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) 2 (missingInterfaceErrorDiagnostic opts err) + CircularImport mod -> + text "Circular imports: module" <+> quotes (ppr mod) + <+> text "depends on itself" readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc readInterfaceErrorDiagnostic = \ case ===================================== compiler/GHC/Iface/Errors/Types.hs ===================================== @@ -45,6 +45,7 @@ data IfaceMessage | Can'tFindNameInInterface Name [TyThing] -- possibly relevant TyThings + | CircularImport !Module deriving Generic data MissingInterfaceError ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -605,7 +605,7 @@ tcHiBootIface hsc_src mod (LookingForHiBoot mod) in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. - NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) + NotBoot -> failWithTc (TcRnInterfaceError (CircularImport mod)) -- Someone below us imported us! -- This is a loop with no hi-boot in the way }}}} @@ -613,11 +613,6 @@ tcHiBootIface hsc_src mod need = text "Need the hi-boot interface for" <+> ppr mod <+> text "to compare against the Real Thing" - moduleLoop = text "Circular imports: module" <+> quotes (ppr mod) - <+> text "depends on itself" - - - mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo mkSelfBootInfo iface mds = do -- NB: This is computed DIRECTLY from the ModIface rather ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -83,7 +83,7 @@ module GHC.JS.Make -- $intro_funcs , var , jString - , jLam, jVar, jFor, jForIn, jForEachIn, jTryCatchFinally + , jLam, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally -- * Combinators -- $combinators , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!) @@ -253,7 +253,7 @@ jLam f = ValExpr . UnsatVal . IS $ do -- of the enclosed expression. The result is a block statement. -- Usage: -- --- @jVar $ \x y -> mconcat [jVar x ||= one_, jVar y ||= two_, jVar x + jVar y]@ +-- @jVar $ \x y -> mconcat [x ||= one_, y ||= two_, x + y]@ jVar :: ToSat a => a -> JStat jVar f = UnsatBlock . IS $ do (block, is) <- runIdentSupply $ toSat_ f [] @@ -262,6 +262,9 @@ jVar f = UnsatBlock . IS $ do addDecls x = x return $ addDecls block +jFunction :: Ident -> [Ident] -> JStat -> JStat +jFunction name args body = FuncStat name args body + -- | Create a 'for in' statement. -- Usage: -- @@ -279,6 +282,23 @@ jForEachIn e f = UnsatBlock . IS $ do let i = head is return $ decl i `mappend` ForInStat True i e block +-- | Create a 'for' statement given a function for initialization, a predicate +-- to step to, a step and a body +-- Usage: +-- +-- @ jFor (|= zero_) (.<. Int 65536) preIncrS +-- (\j -> ...something with the counter j...)@ +-- +jFor :: (JExpr -> JStat) + -> (JExpr -> JExpr) + -> (JExpr -> JStat) + -> (JExpr -> JStat) + -> JStat +jFor init pred step body = jVar $ \i -> ForStat (init i) (pred i) (step i) (body i) + +jForNoDecl :: Ident -> JExpr -> JExpr -> JStat -> JStat -> JStat +jForNoDecl i initial p step body = ForStat (toJExpr i |= initial) p step body + -- | As with "jForIn" but creating a \"for each in\" statement. jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat jTryCatchFinally s f s2 = UnsatBlock . IS $ do @@ -294,13 +314,6 @@ var = ValExpr . JVar . TxtI jString :: FastString -> JExpr jString = toJExpr --- | Create a 'for' statement -jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat -jFor before p after b = BlockStat [before, WhileStat False (toJExpr p) b'] - where b' = case toStat b of - BlockStat xs -> BlockStat $ xs ++ [after] - x -> BlockStat [x,after] - -- | construct a js declaration with the given identifier decl :: Ident -> JStat decl i = DeclStat i Nothing ===================================== compiler/GHC/JS/Optimizer.hs ===================================== @@ -0,0 +1,271 @@ +{-# LANGUAGE LambdaCase #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.JS.Optimizer +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Jeffrey Young +-- Luite Stegeman +-- Sylvain Henry +-- Josh Meredith +-- Stability : experimental +-- +-- +-- * Domain and Purpose +-- +-- GHC.JS.Optimizer is a shallow embedding of a peephole optimizer. That is, +-- this module defines transformations over the JavaScript IR in +-- 'GHC.JS.Syntax', transforming the IR forms from inefficient, or +-- non-idiomatic, JavaScript to more efficient and idiomatic JavaScript. The +-- optimizer is written in continuation passing style so optimizations +-- compose. +-- +-- * Architecture of the optimizer +-- +-- The design is that each optimization pattern matches on the head of a +-- block by pattern matching onto the head of the stream of nodes in the +-- JavaScript IR. If an optimization gets a successful match then it performs +-- whatever rewrite is necessary and then calls the 'loop' continuation. This +-- ensures that the result of the optimization is subject to the same +-- optimization, /and/ the rest of the optimizations. If there is no match +-- then the optimization should call the 'next' continuation to pass the +-- stream to the next optimization in the optimization chain. We then define +-- the last "optimization" to be @tailLoop@ which selects the next block of +-- code to optimize and begin the optimization pipeline again. +----------------------------------------------------------------------------- +module GHC.JS.Optimizer + ( jsOptimize + ) where + + +import Prelude + +import GHC.JS.Syntax + +import Control.Arrow + +{- +Note [ Unsafe JavaScript Optimizations ] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +There are a number of optimizations that the JavaScript Backend performs that +are not sound with respect to arbritrary JavaScript. We still perform these +optimizations because we are not optimizing arbritrary javascript and under the +assumption that the JavaScript backend will not generate code that violates the +soundness of the optimizer. For example, the @deadCodeElim@ optimization removes +all statements that occur after a 'return' in JavaScript, however this is not +always sound because of hoisting, consider this program: + + function foo() { + var x = 2; + bar(); + return x; + + function bar() { + x = 10; + }} + + which is transformed to: + + function foo() { + var x = 2; + bar(); + return x; + }} + +The optimized form is clearly a program that goes wrong because `bar()` is no +longer defined. But the JavaScript backend will never generate this code, so as +long as that assumption holds we are safe to perform optimizations that would +normally be unsafe. +-} + + +-------------------------------------------------------------------------------- +-- Top level Driver +-------------------------------------------------------------------------------- +jsOptimize :: JStat -> JStat +jsOptimize = go + where + p_opt = jsOptimize + opt = jsOptimize' + e_opt = jExprOptimize + -- base case + go (BlockStat xs) = BlockStat (opt xs) + -- recursive cases + go (ForStat i p s body) = ForStat (go i) (e_opt p) (go s) (p_opt body) + go (ForInStat b i p body) = ForInStat b i p (p_opt body) + go (WhileStat b c body) = WhileStat b (e_opt c) (p_opt body) + go (SwitchStat s ps body) = SwitchStat s (fmap (second go) ps) (p_opt body) + go (FuncStat i args body) = FuncStat i args (p_opt body) + go (IfStat c t e) = IfStat (e_opt c) (p_opt t) (p_opt e) + go (TryStat ths i c f) = TryStat (p_opt ths) i (p_opt c) (p_opt f) + go (LabelStat lbl s) = LabelStat lbl (p_opt s) + -- special case: drive the optimizer into expressions + go (AssignStat id op rhs) = AssignStat (e_opt id) op (e_opt rhs) + go (DeclStat i (Just e)) = DeclStat i (Just $ e_opt e) + go (ReturnStat e) = ReturnStat (e_opt e) + go (UOpStat op e) = UOpStat op (e_opt e) + go (ApplStat f args) = ApplStat (e_opt f) (e_opt <$> args) + -- all else is terminal, we match on these to force a warning in the event + -- another constructor is added + go x at BreakStat{} = x + go x at ContinueStat{} = x + go x at DeclStat{} = x -- match on the nothing case + +jsOptimize' :: [JStat] -> [JStat] +jsOptimize' = runBlockOpt opts . single_pass_opts + where + opts :: BlockOpt + opts = safe_opts + <> unsafe_opts + <> tailLoop -- tailloop must be last, see module description + + unsafe_opts :: BlockOpt + unsafe_opts = mconcat [ deadCodeElim ] + + safe_opts :: BlockOpt + safe_opts = mconcat [ declareAssign, combineOps ] + + single_pass_opts :: BlockTrans + single_pass_opts = runBlockTrans sp_opts + + sp_opts = [flattenBlocks] + +-- | recur over a @JExpr@ and optimize the @JVal at s +jExprOptimize :: JExpr -> JExpr +-- the base case +jExprOptimize (ValExpr val) = ValExpr (jValOptimize val) +-- recursive cases +jExprOptimize (SelExpr obj field) = SelExpr (jExprOptimize obj) field +jExprOptimize (IdxExpr obj ix) = IdxExpr (jExprOptimize obj) (jExprOptimize ix) +jExprOptimize (UOpExpr op exp) = UOpExpr op (jExprOptimize exp) +jExprOptimize (IfExpr c t e) = IfExpr c (jExprOptimize t) (jExprOptimize e) +jExprOptimize (ApplExpr f args ) = ApplExpr (jExprOptimize f) (jExprOptimize <$> args) +jExprOptimize (InfixExpr op l r) = InfixExpr op (jExprOptimize l) (jExprOptimize r) + +-- | drive optimizations to anonymous functions and over expressions +jValOptimize :: JVal -> JVal +-- base case +jValOptimize (JFunc args body) = JFunc args (jsOptimize body) +-- recursive cases +jValOptimize (JList exprs) = JList (jExprOptimize <$> exprs) +jValOptimize (JHash hash) = JHash (jExprOptimize <$> hash) +-- all else is terminal +jValOptimize x at JVar{} = x +jValOptimize x at JDouble{} = x +jValOptimize x at JInt{} = x +jValOptimize x at JStr{} = x +jValOptimize x at JRegEx{} = x + +-- | A block transformation is a function from a stream of syntax to another +-- stream +type BlockTrans = [JStat] -> [JStat] + +-- | A BlockOpt is a function that alters the stream, and a continuation that +-- represents the rest of the stream. The first @BlockTrans@ represents +-- restarting the optimizer after a change has happened. The second @BlockTrans@ +-- represents the rest of the continuation stream. +newtype BlockOpt = BlockOpt (BlockTrans -> BlockTrans -> BlockTrans) + +-- | To merge two BlockOpt we first run the left-hand side optimization and +-- capture the right-hand side in the continuation +instance Semigroup BlockOpt where + BlockOpt opt0 <> BlockOpt opt1 = BlockOpt + $ \loop next -> opt0 loop (opt1 loop next) + +instance Monoid BlockOpt where + -- don't loop, just finalize + mempty = BlockOpt $ \_loop next -> next + +-- | loop until a fixpoint is reached +runBlockOpt :: BlockOpt -> [JStat] -> [JStat] +runBlockOpt (BlockOpt opt) xs = recur xs + where recur = opt recur id + +runBlockTrans :: [BlockTrans] -> [JStat] -> [JStat] +runBlockTrans opts = foldl (.) id opts + +-- | Perform all the optimizations on the tail of a block. +tailLoop :: BlockOpt +tailLoop = BlockOpt $ \loop next -> \case + [] -> next [] + -- this call to jsOptimize is required or else the optimizer will not + -- properly recur down JStat. See the 'deadCodeElim' test for examples which + -- were failing before this change + (x:xs) -> next (jsOptimize x : loop xs) + +-------------------------------------------------------------------------------- +-- Single Slot Optimizations +-------------------------------------------------------------------------------- + +{- | + Catch modify and assign operators: + case 1: + i = i + 1; ==> ++i; + case 2: + i = i - 1; ==> --i; + case 3: + i = i + n; ==> i += n; + case 4: + i = i - n; ==> i -= n; +-} +combineOps :: BlockOpt +combineOps = BlockOpt $ \loop next -> + \case + -- find a op pattern, and rerun the optimizer on its result unless there is + -- nothing to optimize, in which case call the next optimization + (unchanged@(AssignStat + ident@(ValExpr (JVar i)) + AssignOp + (InfixExpr op (ValExpr (JVar i')) e)) : xs) + | i == i' -> case (op, e) of + (AddOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreIncOp ident : xs + (SubOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreDecOp ident : xs + (AddOp, e') -> loop $ AssignStat ident AddAssignOp e' : xs + (SubOp, e') -> loop $ AssignStat ident SubAssignOp e' : xs + _ -> next $ unchanged : xs + -- commutative cases + (unchanged@(AssignStat + ident@(ValExpr (JVar i)) + AssignOp + (InfixExpr op e (ValExpr (JVar i')))) : xs) + | i == i' -> case (op, e) of + (AddOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreIncOp ident : xs + (SubOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreDecOp ident : xs + (AddOp, e') -> loop $ AssignStat ident AddAssignOp e' : xs + (SubOp, e') -> loop $ AssignStat ident SubAssignOp e' : xs + _ -> next $ unchanged : xs + -- general case, we had nothing to optimize in this case so call the next + -- optimization + xs -> next xs + + +-------------------------------------------------------------------------------- +-- Dual Slot Optimizations +-------------------------------------------------------------------------------- +-- | Catch 'var i; i = q;' ==> 'var i = q;' +declareAssign :: BlockOpt +declareAssign = BlockOpt $ + \loop next -> \case + ( (DeclStat i Nothing) + : (AssignStat (ValExpr (JVar i')) AssignOp v) + : xs + ) | i == i' -> loop (DeclStat i (Just v) : xs) + xs -> next xs + +-- | Eliminate all code after a return statement. This is a special case +-- optimization that doesn't need to loop. See Note [Unsafe JavaScript +-- optimizations] +deadCodeElim :: BlockOpt +deadCodeElim = BlockOpt $ + \_loop next -> \case + (x at ReturnStat{}:_) -> next [x] + xs -> next xs + +-- | remove nested blocks +flattenBlocks :: BlockTrans +flattenBlocks (BlockStat y : ys) = flattenBlocks y ++ flattenBlocks ys +flattenBlocks (x:xs) = x : flattenBlocks xs +flattenBlocks [] = [] ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -10,10 +10,46 @@ -- For Outputable instances for JS syntax {-# OPTIONS_GHC -Wno-orphans #-} --- | Pretty-printing JavaScript +----------------------------------------------------------------------------- +-- | +-- Module : GHC.JS.Ppr +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Jeffrey Young +-- Luite Stegeman +-- Sylvain Henry +-- Josh Meredith +-- Stability : experimental +-- +-- +-- * Domain and Purpose +-- +-- GHC.JS.Ppr defines the code generation facilities for the JavaScript +-- backend. That is, this module exports a function from the JS backend IR +-- to JavaScript compliant concrete syntax that can readily be executed by +-- nodejs or called in a browser. +-- +-- * Design +-- +-- This module follows the architecture and style of the other backends in +-- GHC: it intances Outputable for the relevant types, creates a class that +-- describes a morphism from the IR domain to JavaScript concrete Syntax and +-- then generates that syntax on a case by case basis. +-- +-- * How to use +-- +-- The key functions are @renderJS@, @jsToDoc@, and the @RenderJS@ record. +-- Use the @RenderJS@ record and @jsToDoc@ to define a custom renderers for +-- specific parts of the backend, for example in 'GHC.StgToJS.Linker.Opt' a +-- custom renderer ensures all @Ident@ generated by the linker optimization +-- pass are prefixed differently than the default. Use @renderJS@ to +-- generate JavaScript concrete syntax in the general case, suitable for +-- human consumption. +----------------------------------------------------------------------------- + module GHC.JS.Ppr ( renderJs - , renderJs' , renderPrefixJs , renderPrefixJs' , JsToDoc(..) @@ -21,9 +57,10 @@ module GHC.JS.Ppr , RenderJs(..) , jsToDoc , pprStringLit - , flattenBlocks , braceNest , hangBrace + , interSemi + , addSemi ) where @@ -49,9 +86,9 @@ instance Outputable JExpr where instance Outputable JVal where ppr = docToSDoc . renderJs - -($$$) :: Doc -> Doc -> Doc -x $$$ y = nest 2 $ x $+$ y +-------------------------------------------------------------------------------- +-- Top level API +-------------------------------------------------------------------------------- -- | Render a syntax tree as a pretty-printable document -- (simply showing the resultant doc produces a nice, @@ -84,26 +121,17 @@ renderPrefixJs = renderPrefixJs' defaultRenderJs renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc renderPrefixJs' r = jsToDocR r -braceNest :: Doc -> Doc -braceNest x = char '{' <+> nest 2 x $$ char '}' - --- | Hang with braces: --- --- hdr { --- body --- } -hangBrace :: Doc -> Doc -> Doc -hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] +-------------------------------------------------------------------------------- +-- Code Generator +-------------------------------------------------------------------------------- class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc -instance JsToDoc JStat where jsToDocR r = renderJsS r r -instance JsToDoc JExpr where jsToDocR r = renderJsE r r -instance JsToDoc JVal where jsToDocR r = renderJsV r r -instance JsToDoc Ident where jsToDocR r = renderJsI r r -instance JsToDoc [JExpr] where - jsToDocR r = vcat . map ((<> semi) . jsToDocR r) -instance JsToDoc [JStat] where - jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc JStat where jsToDocR r = renderJsS r r +instance JsToDoc JExpr where jsToDocR r = renderJsE r r +instance JsToDoc JVal where jsToDocR r = renderJsV r r +instance JsToDoc Ident where jsToDocR r = renderJsI r r +instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) defRenderJsS :: RenderJs -> JStat -> Doc defRenderJsS r = \case @@ -120,12 +148,16 @@ defRenderJsS r = \case ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s where - printBS (BlockStat ss) = vcat $ interSemi $ flattenBlocks ss + printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - interSemi [x] = [jsToDocR r x] - interSemi [] = [] - interSemi (x:xs) = (jsToDocR r x <> semi) : interSemi xs + ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb) + where + forCond = parens $ hcat $ interSemi + [ jsToDocR r init + , jsToDocR r p + , parens (jsToDocR r s1) + ] ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) where txt | each = "for each" | otherwise = "for" @@ -134,12 +166,15 @@ defRenderJsS r = \case cases = vcat l' ReturnStat e -> text "return" <+> jsToDocR r e ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) + FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i + <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) + (jsToDocR r b) TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally where mbCatch | s1 == BlockStat [] = PP.empty | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) mbFinally | s2 == BlockStat [] = PP.empty | otherwise = hangBrace (text "finally") (jsToDocR r s2) - AssignStat i x -> case x of + AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. -- @@ -148,19 +183,13 @@ defRenderJsS r = \case -- ... -- }); -- - ValExpr (JFunc is b) -> sep [jsToDocR r i <+> text "= function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] - _ -> jsToDocR r i <+> char '=' <+> jsToDocR r x + ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] + _ -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x | isPre op -> ftext (uOpText op) <> optParens r x | otherwise -> optParens r x <> ftext (uOpText op) - BlockStat xs -> jsToDocR r (flattenBlocks xs) - -flattenBlocks :: [JStat] -> [JStat] -flattenBlocks = \case - BlockStat y:ys -> flattenBlocks y ++ flattenBlocks ys - y:ys -> y : flattenBlocks ys - [] -> [] + BlockStat xs -> jsToDocR r xs optParens :: RenderJs -> JExpr -> Doc optParens r x = case x of @@ -204,33 +233,12 @@ defRenderJsV r = \case defRenderJsI :: RenderJs -> Ident -> Doc defRenderJsI _ (TxtI t) = ftext t +aOpText :: AOp -> FastString +aOpText = \case + AssignOp -> "=" + AddAssignOp -> "+=" + SubAssignOp -> "-=" -pprStringLit :: FastString -> Doc -pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] - -encodeJson :: FastString -> Doc -encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) - -encodeJsonChar :: Char -> Doc -encodeJsonChar = \case - '/' -> text "\\/" - '\b' -> text "\\b" - '\f' -> text "\\f" - '\n' -> text "\\n" - '\r' -> text "\\r" - '\t' -> text "\\t" - '"' -> text "\\\"" - '\\' -> text "\\\\" - c - | not (isControl c) && ord c <= 127 -> char c - | ord c <= 0xff -> hexxs "\\x" 2 (ord c) - | ord c <= 0xffff -> hexxs "\\u" 4 (ord c) - | otherwise -> let cp0 = ord c - 0x10000 -- output surrogate pair - in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) <> - hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00) - where hexxs prefix pad cp = - let h = showHex cp "" - in text (prefix ++ replicate (pad - length h) '0' ++ h) uOpText :: UOp -> FastString uOpText = \case @@ -289,3 +297,56 @@ isAlphaOp = \case YieldOp -> True VoidOp -> True _ -> False + +pprStringLit :: FastString -> Doc +pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] + +-------------------------------------------------------------------------------- +-- Utilities +-------------------------------------------------------------------------------- + +encodeJson :: FastString -> Doc +encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) + +encodeJsonChar :: Char -> Doc +encodeJsonChar = \case + '/' -> text "\\/" + '\b' -> text "\\b" + '\f' -> text "\\f" + '\n' -> text "\\n" + '\r' -> text "\\r" + '\t' -> text "\\t" + '"' -> text "\\\"" + '\\' -> text "\\\\" + c + | not (isControl c) && ord c <= 127 -> char c + | ord c <= 0xff -> hexxs "\\x" 2 (ord c) + | ord c <= 0xffff -> hexxs "\\u" 4 (ord c) + | otherwise -> let cp0 = ord c - 0x10000 -- output surrogate pair + in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) <> + hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00) + where hexxs prefix pad cp = + let h = showHex cp "" + in text (prefix ++ replicate (pad - length h) '0' ++ h) + +braceNest :: Doc -> Doc +braceNest x = char '{' <+> nest 2 x $$ char '}' + +interSemi :: [Doc] -> [Doc] +interSemi [] = [] +interSemi [s] = [s] +interSemi (x:xs) = x <> text ";" : interSemi xs + +addSemi :: Doc -> Doc +addSemi x = x <> text ";" + +-- | Hang with braces: +-- +-- hdr { +-- body +-- } +hangBrace :: Doc -> Doc -> Doc +hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] + +($$$) :: Doc -> Doc -> Doc +x $$$ y = nest 2 $ x $+$ y ===================================== compiler/GHC/JS/Syntax.hs ===================================== @@ -58,6 +58,7 @@ module GHC.JS.Syntax , JVal(..) , Op(..) , UOp(..) + , AOp(..) , Ident(..) , JLabel -- * pattern synonyms over JS operators @@ -110,20 +111,22 @@ import GHC.Generics -- Reference](https://tc39.es/ecma262/#sec-ecmascript-language-statements-and-declarations) -- for details data JStat - = DeclStat !Ident !(Maybe JExpr) -- ^ Variable declarations: var foo [= e] - | ReturnStat JExpr -- ^ Return - | IfStat JExpr JStat JStat -- ^ If + = DeclStat !Ident !(Maybe JExpr) -- ^ Variable declarations: var foo [= e] + | ReturnStat JExpr -- ^ Return + | IfStat JExpr JStat JStat -- ^ If | WhileStat Bool JExpr JStat -- ^ While, bool is "do" when True + | ForStat JStat JExpr JStat JStat -- ^ For | ForInStat Bool Ident JExpr JStat -- ^ For-in, bool is "each' when True | SwitchStat JExpr [(JExpr, JStat)] JStat -- ^ Switch | TryStat JStat Ident JStat JStat -- ^ Try - | BlockStat [JStat] -- ^ Blocks - | ApplStat JExpr [JExpr] -- ^ Application - | UOpStat UOp JExpr -- ^ Unary operators - | AssignStat JExpr JExpr -- ^ Binding form: @foo = bar@ - | LabelStat JLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic - | BreakStat (Maybe JLabel) -- ^ Break - | ContinueStat (Maybe JLabel) -- ^ Continue + | BlockStat [JStat] -- ^ Blocks + | ApplStat JExpr [JExpr] -- ^ Application + | UOpStat UOp JExpr -- ^ Unary operators + | AssignStat JExpr AOp JExpr -- ^ Binding form: @ @ + | LabelStat JLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic + | BreakStat (Maybe JLabel) -- ^ Break + | ContinueStat (Maybe JLabel) -- ^ Continue + | FuncStat !Ident [Ident] JStat -- ^ an explicit function definition deriving (Eq, Typeable, Generic) -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of @@ -146,9 +149,9 @@ appendJStat mx my = case (mx,my) of (BlockStat [] , y ) -> y (x , BlockStat []) -> x (BlockStat xs , BlockStat ys) -> BlockStat $! xs ++ ys - (BlockStat xs , ys ) -> BlockStat $! xs ++ [ys] - (xs , BlockStat ys) -> BlockStat $! xs : ys - (xs , ys ) -> BlockStat [xs,ys] + (BlockStat xs , ys ) -> BlockStat $! xs ++ [ys] + (xs , BlockStat ys) -> BlockStat $! xs : ys + (xs , ys ) -> BlockStat [xs,ys] -------------------------------------------------------------------------------- @@ -156,13 +159,13 @@ appendJStat mx my = case (mx,my) of -------------------------------------------------------------------------------- -- | JavaScript Expressions data JExpr - = ValExpr JVal -- ^ All values are trivially expressions - | SelExpr JExpr Ident -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^' - | IdxExpr JExpr JExpr -- ^ Indexing: Obj[foo], see 'GHC.JS.Make..!' - | InfixExpr Op JExpr JExpr -- ^ Infix Expressions, see 'JExpr' pattern synonyms - | UOpExpr UOp JExpr -- ^ Unary Expressions + = ValExpr JVal -- ^ All values are trivially expressions + | SelExpr JExpr Ident -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^' + | IdxExpr JExpr JExpr -- ^ Indexing: Obj[foo], see 'GHC.JS.Make..!' + | InfixExpr Op JExpr JExpr -- ^ Infix Expressions, see 'JExpr' pattern synonyms + | UOpExpr UOp JExpr -- ^ Unary Expressions | IfExpr JExpr JExpr JExpr -- ^ If-expression - | ApplExpr JExpr [JExpr] -- ^ Application + | ApplExpr JExpr [JExpr] -- ^ Application deriving (Eq, Typeable, Generic) -- * Useful pattern synonyms to ease programming with the deeply embedded JS @@ -321,6 +324,15 @@ data UOp instance NFData UOp +-- | JS Unary Operators +data AOp + = AssignOp -- ^ Vanilla Assignment: = + | AddAssignOp -- ^ Addition Assignment: += + | SubAssignOp -- ^ Subtraction Assignment: -= + deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic) + +instance NFData AOp + -- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' -- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on -- Sane-ness @@ -345,10 +357,12 @@ instance Show SaneDouble where -------------------------------------------------------------------------------- jassignAllEqual :: [JExpr] -> [JExpr] -> JStat -jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" AssignStat xs ys) +jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" go xs ys) + where go l r = AssignStat l AssignOp r jassignAll :: [JExpr] -> [JExpr] -> JStat -jassignAll xs ys = mconcat (zipWith AssignStat xs ys) +jassignAll xs ys = mconcat $ zipWith go xs ys + where go l r = AssignStat l AssignOp r jvar :: FastString -> JExpr jvar = ValExpr . JVar . TxtI ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -47,6 +47,7 @@ identsS = \case Sat.ReturnStat e -> identsE e Sat.IfStat e s1 s2 -> identsE e ++ identsS s1 ++ identsS s2 Sat.WhileStat _ e s -> identsE e ++ identsS s + Sat.ForStat init p step body -> identsS init ++ identsE p ++ identsS step ++ identsS body Sat.ForInStat _ i e s -> [i] ++ identsE e ++ identsS s Sat.SwitchStat e xs s -> identsE e ++ concatMap traverseCase xs ++ identsS s where traverseCase (e,s) = identsE e ++ identsS s @@ -54,10 +55,11 @@ identsS = \case Sat.BlockStat xs -> concatMap identsS xs Sat.ApplStat e es -> identsE e ++ concatMap identsE es Sat.UOpStat _op e -> identsE e - Sat.AssignStat e1 e2 -> identsE e1 ++ identsE e2 + Sat.AssignStat e1 _op e2 -> identsE e1 ++ identsE e2 Sat.LabelStat _l s -> identsS s Sat.BreakStat{} -> [] Sat.ContinueStat{} -> [] + Sat.FuncStat i args body -> [i] ++ args ++ identsS body {-# INLINE identsE #-} identsE :: Sat.JExpr -> [Ident] @@ -148,6 +150,8 @@ jmcompos ret app f' v = ReturnStat i -> ret ReturnStat `app` f i IfStat e s s' -> ret IfStat `app` f e `app` f s `app` f s' WhileStat b e s -> ret (WhileStat b) `app` f e `app` f s + ForStat init p step body -> ret ForStat `app` f init `app` f p + `app` f step `app` f body ForInStat b i e s -> ret (ForInStat b) `app` f i `app` f e `app` f s SwitchStat e l d -> ret SwitchStat `app` f e `app` l' `app` f d where l' = mapM' (\(c,s) -> ret (,) `app` f c `app` f s) l @@ -158,6 +162,7 @@ jmcompos ret app f' v = AssignStat e e' -> ret AssignStat `app` f e `app` f e' UnsatBlock _ -> ret v' ContinueStat l -> ret (ContinueStat l) + FuncStat i args body -> ret FuncStat `app` f i `app` mapM' f args `app` f body BreakStat l -> ret (BreakStat l) LabelStat l s -> ret (LabelStat l) `app` f s JMGExpr v' -> ret JMGExpr `app` case v' of @@ -217,7 +222,6 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) -------------------------------------------------------------------------------- -- Translation -- --- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- satJStat :: JStat -> Sat.JStat satJStat = witness . proof @@ -229,6 +233,9 @@ satJStat = witness . proof witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) + witness (ForStat init p step body) = Sat.ForStat + (witness init) (satJExpr p) + (witness step) (witness body) witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i (satJExpr iter) (witness body) @@ -240,12 +247,13 @@ satJStat = witness . proof witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) + witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) Sat.AssignOp (satJExpr rhs) witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) witness (BreakStat Nothing) = Sat.BreakStat Nothing witness (BreakStat (Just l)) = Sat.BreakStat $! Just l witness (ContinueStat Nothing) = Sat.ContinueStat Nothing witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l + witness (FuncStat i args body) = Sat.FuncStat i args (witness body) witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" ===================================== compiler/GHC/JS/Unsat/Syntax.hs ===================================== @@ -146,6 +146,7 @@ data JStat | ReturnStat JExpr -- ^ Return | IfStat JExpr JStat JStat -- ^ If | WhileStat Bool JExpr JStat -- ^ While, bool is "do" when True + | ForStat JStat JExpr JStat JStat -- ^ For | ForInStat Bool Ident JExpr JStat -- ^ For-in, bool is "each' when True | SwitchStat JExpr [(JExpr, JStat)] JStat -- ^ Switch | TryStat JStat Ident JStat JStat -- ^ Try @@ -157,6 +158,7 @@ data JStat | LabelStat JsLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic | BreakStat (Maybe JsLabel) -- ^ Break | ContinueStat (Maybe JsLabel) -- ^ Continue + | FuncStat !Ident [Ident] JStat -- ^ an explicit function definition deriving (Eq, Typeable, Generic) -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -408,17 +408,11 @@ mkApplyArr = mconcat [ TxtI "h$apply" ||= toJExpr (JList []) , TxtI "h$paps" ||= toJExpr (JList []) , ApplStat (var "h$initStatic" .^ "push") - [ ValExpr $ JFunc [] $ jVar \i -> mconcat - [ i |= zero_ - , WhileStat False (i .<. Int 65536) $ mconcat - [ var "h$apply" .! i |= var "h$ap_gen" - , preIncrS i - ] - , i |= zero_ - , WhileStat False (i .<. Int 128) $ mconcat - [ var "h$paps" .! i |= var "h$pap_gen" - , preIncrS i - ] + [ ValExpr $ JFunc [] $ mconcat + [ jFor (|= zero_) (.<. Int 65536) preIncrS + (\j -> var "h$apply" .! j |= var "h$ap_gen") + , jFor (|= zero_) (.<. Int 128) preIncrS + (\j -> var "h$paps" .! j |= var "h$pap_gen") , mconcat (map assignSpec applySpec) , mconcat (map assignPap specPap) ] ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -16,6 +16,7 @@ import GHC.JS.Ppr import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import GHC.JS.Optimizer import GHC.StgToJS.Arg import GHC.StgToJS.Sinker @@ -133,10 +134,10 @@ genUnits m ss spt_entries foreign_stubs = do glbl <- State.gets gsGlobal staticInit <- initStaticPtrs spt_entries - let stat = ( -- O.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m 1) - $ mconcat (reverse glbl) <> staticInit) + let stat = ( jsOptimize + . satJStat + . jsSaturate (Just $ modulePrefix m 1) + $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] let oi = ObjUnit { oiSymbols = syms @@ -208,7 +209,9 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsOptimize + . satJStat + $ jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -245,10 +248,10 @@ genUnits m ss spt_entries foreign_stubs = do let allDeps = collectIds unf decl topDeps = collectTopIds decl required = hasExport decl - stat = -- Opt.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m n) - $ mconcat (reverse extraTl) <> tl + stat = jsOptimize + . satJStat + . jsSaturate (Just $ modulePrefix m n) + $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps let oi = ObjUnit { oiSymbols = syms @@ -308,15 +311,15 @@ genSetConInfo i d l {- srt -} = do (fixedLayout $ map uTypeVt fields) (CICon $ dataConTag d) sr - return (ei ||= mkDataEntry) + return (mkDataEntry ei) where -- dataConRepArgTys sometimes returns unboxed tuples. is that a bug? fields = concatMap (map primRepToType . typePrimRep . unwrapType . scaledThing) (dataConRepArgTys d) -- concatMap (map slotTyToType . repTypeSlots . repType) (dataConRepArgTys d) -mkDataEntry :: JExpr -mkDataEntry = ValExpr $ JFunc [] returnStack +mkDataEntry :: Ident -> JStat +mkDataEntry i = FuncStat i [] returnStack genToplevelRhs :: Id -> CgStgRhs -> G JStat -- general cases: ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -240,7 +240,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) = body <- genBody ctx R1 args body typ ei@(TxtI eii) <- identForEntryId i sr <- genStaticRefsRhs rhs - let f = JFunc [] (bh <> lvs <> body) + let f = (bh <> lvs <> body) emitClosureInfo $ ClosureInfo ei (CIRegs 0 $ concatMap idVt args) @@ -249,7 +249,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) = map (stackSlotType . fst) (ctxLneFrameVars ctx)) CIStackFrame sr - emitToplevel (ei ||= toJExpr f) + emitToplevel (jFunction ei [] f) genEntryLne ctx i (StgRhsCon cc con _mu _ticks args _typ) = resetSlots $ do let payloadSize = ctxLneFrameSize ctx ei@(TxtI _eii) <- identForEntryId i @@ -258,8 +258,7 @@ genEntryLne ctx i (StgRhsCon cc con _mu _ticks args _typ) = resetSlots $ do p <- popLneFrame True payloadSize ctx args' <- concatMapM genArg args ac <- allocCon ii con cc args' - emitToplevel (ei ||= toJExpr (JFunc [] - (mconcat [decl ii, p, ac, r1 |= toJExpr ii, returnStack]))) + emitToplevel (jFunction ei [] (mconcat [decl ii, p, ac, r1 |= toJExpr ii, returnStack])) -- | Generate the entry function for a local closure genEntry :: HasDebugCallStack => ExprCtx -> Id -> CgStgRhs -> G () @@ -283,7 +282,7 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) = (fixedLayout $ map (uTypeVt . idType) live) et sr - emitToplevel (ei ||= toJExpr (JFunc [] (mconcat [ll, llv, upd, setcc, body]))) + emitToplevel (jFunction ei [] (mconcat [ll, llv, upd, setcc, body])) where entryCtx = ctxSetTarget [] (ctxClearLneFrame ctx) @@ -630,7 +629,7 @@ genRet ctx e at as l = freshIdent >>= f ++ if prof then [ObjV] else map stackSlotType lneVars) CIStackFrame sr - emitToplevel $ r ||= toJExpr (JFunc [] fun') + emitToplevel $ jFunction r [] fun' return (pushLne <> saveCCS <> pushRet) fst3 ~(x,_,_) = x ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -30,6 +30,7 @@ import Prelude import GHC.Platform.Host (hostPlatformArchOS) import GHC.JS.Make +import GHC.JS.Optimizer import GHC.JS.Unsat.Syntax import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform @@ -43,11 +44,11 @@ import GHC.Linker.Static.Utils (exeFileName) import GHC.StgToJS.Linker.Types import GHC.StgToJS.Linker.Utils +import GHC.StgToJS.Linker.Opt import GHC.StgToJS.Rts.Rts import GHC.StgToJS.Object import GHC.StgToJS.Types hiding (LinkableUnit) import GHC.StgToJS.Symbols -import GHC.StgToJS.Printer import GHC.StgToJS.Arg import GHC.StgToJS.Closure @@ -332,7 +333,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | --- Module : GHC.StgToJS.Printer +-- Module : GHC.StgToJS.Linker.Opt -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file LICENSE) -- @@ -13,15 +13,14 @@ -- Sylvain Henry -- Stability : experimental -- --- Custom prettyprinter for JS AST uses the JS PPr module for most of --- the work +-- Optimization pass at link time +-- -- -- ----------------------------------------------------------------------------- -module GHC.StgToJS.Printer +module GHC.StgToJS.Linker.Opt ( pretty , ghcjsRenderJs - , prettyBlock ) where @@ -93,8 +92,7 @@ hexDoc v = text $ go v -- attempt to resugar some of the common constructs ghcjsRenderJsS :: RenderJs -> JStat -> Doc -ghcjsRenderJsS r (BlockStat xs) = prettyBlock r (flattenBlocks xs) -ghcjsRenderJsS r s = renderJsS defaultRenderJs r s +ghcjsRenderJsS r s = renderJsS defaultRenderJs r s -- don't quote keys in our object literals, so closure compiler works ghcjsRenderJsV :: RenderJs -> JVal -> Doc @@ -120,97 +118,3 @@ ghcjsRenderJsV r (JHash m) validOtherIdent c = isAlpha c || isDigit c ghcjsRenderJsV r v = renderJsV defaultRenderJs r v - -prettyBlock :: RenderJs -> [JStat] -> Doc -prettyBlock r xs = vcat $ map addSemi (prettyBlock' r xs) - --- recognize common patterns in a block and convert them to more idiomatic/concise javascript -prettyBlock' :: RenderJs -> [JStat] -> [Doc] --- return/... -prettyBlock' r ( x@(ReturnStat _) - : xs - ) - | not (null xs) - = prettyBlock' r [x] --- declare/assign -prettyBlock' r ( (DeclStat i Nothing) - : (AssignStat (ValExpr (JVar i')) v) - : xs - ) - | i == i' - = prettyBlock' r (DeclStat i (Just v) : xs) - --- resugar for loops with/without var declaration -prettyBlock' r ( (DeclStat i (Just v0)) - : (WhileStat False p (BlockStat bs)) - : xs - ) - | not (null flat) && isForUpdStat (last flat) - = mkFor r True i v0 p (last flat) (init flat) : prettyBlock' r xs - where - flat = flattenBlocks bs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) v0) - : (WhileStat False p (BlockStat bs)) - : xs - ) - | not (null flat) && isForUpdStat (last flat) - = mkFor r False i v0 p (last flat) (init flat) : prettyBlock' r xs - where - flat = flattenBlocks bs - --- global function (does not preserve semantics but works for GHCJS) -prettyBlock' r ( (DeclStat i (Just (ValExpr (JFunc is b)))) - : xs - ) - = (hangBrace (text "function" <+> jsToDocR r i <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) - (jsToDocR r b) - ) : prettyBlock' r xs --- modify/assign operators -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) (ValExpr (JInt 1)))) - : xs - ) - | i == i' = (text "++" <> jsToDocR r i) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr SubOp (ValExpr (JVar i')) (ValExpr (JInt 1)))) - : xs - ) - | i == i' = (text "--" <> jsToDocR r i) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) e)) - : xs - ) - | i == i' = (jsToDocR r i <+> text "+=" <+> jsToDocR r e) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr SubOp (ValExpr (JVar i')) e)) - : xs - ) - | i == i' = (jsToDocR r i <+> text "-=" <+> jsToDocR r e) : prettyBlock' r xs - - -prettyBlock' r (x:xs) = jsToDocR r x : prettyBlock' r xs -prettyBlock' _ [] = [] - --- build the for block -mkFor :: RenderJs -> Bool -> Ident -> JExpr -> JExpr -> JStat -> [JStat] -> Doc -mkFor r decl i v0 p s1 sb = hangBrace (text "for" <> forCond) - (jsToDocR r $ BlockStat sb) - where - c0 | decl = text "var" <+> jsToDocR r i <+> char '=' <+> jsToDocR r v0 - | otherwise = jsToDocR r i <+> char '=' <+> jsToDocR r v0 - forCond = parens $ hcat $ interSemi - [ c0 - , jsToDocR r p - , parens (jsToDocR r s1) - ] - --- check if a statement is suitable to be converted to something in the for(;;x) position -isForUpdStat :: JStat -> Bool -isForUpdStat UOpStat {} = True -isForUpdStat AssignStat {} = True -isForUpdStat ApplStat {} = True -isForUpdStat _ = False - -interSemi :: [Doc] -> [Doc] -interSemi [] = [PP.empty] -interSemi [s] = [s] -interSemi (x:xs) = x <> text ";" : interSemi xs - -addSemi :: Doc -> Doc -addSemi x = x <> text ";" ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -408,31 +408,35 @@ instance Binary Sat.JStat where put_ bh (Sat.ReturnStat e) = putByte bh 2 >> put_ bh e put_ bh (Sat.IfStat e s1 s2) = putByte bh 3 >> put_ bh e >> put_ bh s1 >> put_ bh s2 put_ bh (Sat.WhileStat b e s) = putByte bh 4 >> put_ bh b >> put_ bh e >> put_ bh s - put_ bh (Sat.ForInStat b i e s) = putByte bh 5 >> put_ bh b >> put_ bh i >> put_ bh e >> put_ bh s - put_ bh (Sat.SwitchStat e ss s) = putByte bh 6 >> put_ bh e >> put_ bh ss >> put_ bh s - put_ bh (Sat.TryStat s1 i s2 s3) = putByte bh 7 >> put_ bh s1 >> put_ bh i >> put_ bh s2 >> put_ bh s3 - put_ bh (Sat.BlockStat xs) = putByte bh 8 >> put_ bh xs - put_ bh (Sat.ApplStat e es) = putByte bh 9 >> put_ bh e >> put_ bh es - put_ bh (Sat.UOpStat o e) = putByte bh 10 >> put_ bh o >> put_ bh e - put_ bh (Sat.AssignStat e1 e2) = putByte bh 11 >> put_ bh e1 >> put_ bh e2 - put_ bh (Sat.LabelStat l s) = putByte bh 12 >> put_ bh l >> put_ bh s - put_ bh (Sat.BreakStat ml) = putByte bh 13 >> put_ bh ml - put_ bh (Sat.ContinueStat ml) = putByte bh 14 >> put_ bh ml + put_ bh (Sat.ForStat is c s bd) = putByte bh 5 >> put_ bh is >> put_ bh c >> put_ bh s >> put_ bh bd + put_ bh (Sat.ForInStat b i e s) = putByte bh 6 >> put_ bh b >> put_ bh i >> put_ bh e >> put_ bh s + put_ bh (Sat.SwitchStat e ss s) = putByte bh 7 >> put_ bh e >> put_ bh ss >> put_ bh s + put_ bh (Sat.TryStat s1 i s2 s3) = putByte bh 8 >> put_ bh s1 >> put_ bh i >> put_ bh s2 >> put_ bh s3 + put_ bh (Sat.BlockStat xs) = putByte bh 9 >> put_ bh xs + put_ bh (Sat.ApplStat e es) = putByte bh 10 >> put_ bh e >> put_ bh es + put_ bh (Sat.UOpStat o e) = putByte bh 11 >> put_ bh o >> put_ bh e + put_ bh (Sat.AssignStat e1 op e2) = putByte bh 12 >> put_ bh e1 >> put_ bh op >> put_ bh e2 + put_ bh (Sat.LabelStat l s) = putByte bh 13 >> put_ bh l >> put_ bh s + put_ bh (Sat.BreakStat ml) = putByte bh 14 >> put_ bh ml + put_ bh (Sat.ContinueStat ml) = putByte bh 15 >> put_ bh ml + put_ bh (Sat.FuncStat i is b) = putByte bh 16 >> put_ bh i >> put_ bh is >> put_ bh b get bh = getByte bh >>= \case 1 -> Sat.DeclStat <$> get bh <*> get bh 2 -> Sat.ReturnStat <$> get bh 3 -> Sat.IfStat <$> get bh <*> get bh <*> get bh 4 -> Sat.WhileStat <$> get bh <*> get bh <*> get bh - 5 -> Sat.ForInStat <$> get bh <*> get bh <*> get bh <*> get bh - 6 -> Sat.SwitchStat <$> get bh <*> get bh <*> get bh - 7 -> Sat.TryStat <$> get bh <*> get bh <*> get bh <*> get bh - 8 -> Sat.BlockStat <$> get bh - 9 -> Sat.ApplStat <$> get bh <*> get bh - 10 -> Sat.UOpStat <$> get bh <*> get bh - 11 -> Sat.AssignStat <$> get bh <*> get bh - 12 -> Sat.LabelStat <$> get bh <*> get bh - 13 -> Sat.BreakStat <$> get bh - 14 -> Sat.ContinueStat <$> get bh + 5 -> Sat.ForStat <$> get bh <*> get bh <*> get bh <*> get bh + 6 -> Sat.ForInStat <$> get bh <*> get bh <*> get bh <*> get bh + 7 -> Sat.SwitchStat <$> get bh <*> get bh <*> get bh + 8 -> Sat.TryStat <$> get bh <*> get bh <*> get bh <*> get bh + 9 -> Sat.BlockStat <$> get bh + 10 -> Sat.ApplStat <$> get bh <*> get bh + 11 -> Sat.UOpStat <$> get bh <*> get bh + 12 -> Sat.AssignStat <$> get bh <*> get bh <*> get bh + 13 -> Sat.LabelStat <$> get bh <*> get bh + 14 -> Sat.BreakStat <$> get bh + 15 -> Sat.ContinueStat <$> get bh + 16 -> Sat.FuncStat <$> get bh <*> get bh <*> get bh n -> error ("Binary get bh JStat: invalid tag: " ++ show n) @@ -541,6 +545,10 @@ instance Binary Sat.UOp where put_ bh = putEnum bh get bh = getEnum bh +instance Binary Sat.AOp where + put_ bh = putEnum bh + get bh = getEnum bh + -- 16 bit sizes should be enough... instance Binary CILayout where put_ bh CILayoutVariable = putByte bh 1 ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,16 +30,18 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import GHC.JS.Optimizer import GHC.StgToJS.Apply import GHC.StgToJS.Closure import GHC.StgToJS.Heap -import GHC.StgToJS.Printer import GHC.StgToJS.Profiling import GHC.StgToJS.Regs import GHC.StgToJS.Types import GHC.StgToJS.Stack +import GHC.StgToJS.Linker.Opt + import GHC.Data.FastString import GHC.Types.Unique.Map @@ -134,7 +136,7 @@ closureConstructors s = BlockStat | otherwise = mempty mkClosureCon :: Maybe Int -> JStat - mkClosureCon n0 = funName ||= toJExpr fun + mkClosureCon n0 = jFunction funName args funBod where n | Just n' <- n0 = n' | Nothing <- n0 = 0 @@ -142,7 +144,6 @@ closureConstructors s = BlockStat | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] args = TxtI "f" : addCCArg' (map varName [1..n]) - fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- @@ -157,12 +158,12 @@ closureConstructors s = BlockStat ] mkDataFill :: Int -> JStat - mkDataFill n = funName ||= toJExpr fun + mkDataFill n = jFunction funName (map TxtI ds) body where funName = TxtI $ dataName n ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds - fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) + body = (checkD <> returnS extra_args) -- | JS Payload to perform stack manipulation in the RTS stackManip :: JStat @@ -172,10 +173,10 @@ stackManip = mconcat (map mkPush [1..32]) <> mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) as = map varName [1..n] - fun = JFunc as ((sp |= sp + toJExpr n) - <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) - [1..] as)) - in funName ||= toJExpr fun + body = ((sp |= sp + toJExpr n) + <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) + [1..] as)) + in jFunction funName as body -- partial pushes, based on bitmap, increases Sp by highest bit mkPpush :: Integer -> JStat @@ -185,11 +186,10 @@ stackManip = mconcat (map mkPush [1..32]) <> n = length bits h = last bits args = map varName [1..n] - fun = JFunc args $ - mconcat [ sp |= sp + toJExpr (h+1) - , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) - ] - in funName ||= toJExpr fun + body = mconcat [ sp |= sp + toJExpr (h+1) + , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) + ] + in jFunction funName args body bitsIdx :: Integer -> [Int] bitsIdx n | n < 0 = error "bitsIdx: negative" @@ -244,12 +244,12 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map varName [1..n] - assign = zipWith (\a r -> toJExpr r |= toJExpr a) - args (reverse $ take n regsFromR1) - fname = TxtI $ mkFastString ("h$l" ++ show n) - fun = JFunc args (mconcat assign) - in fname ||= toJExpr fun + mkLoad n = let args = map varName [1..n] + body = mconcat $ + zipWith (\a r -> toJExpr r |= toJExpr a) + args (reverse $ take n regsFromR1) + fname = TxtI $ mkFastString ("h$l" ++ show n) + in jFunction fname args body -- | Assign registers R1 ... Rn in descending order, that is assign Rn first. -- This function uses the 'assignRegs'' array to construct functions which set @@ -314,11 +314,11 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . jsOptimize . satJStat . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty . jsOptimize . satJStat $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' rts :: StgToJSConfig -> JStat ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -719,6 +719,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "NoUnitIdMatching" = 51294 GhcDiagnosticCode "NotAModule" = 35235 GhcDiagnosticCode "Can'tFindNameInInterface" = 83249 + GhcDiagnosticCode "CircularImport" = 75429 GhcDiagnosticCode "HiModuleNameMismatchWarn" = 53693 GhcDiagnosticCode "ExceptionOccurred" = 47808 ===================================== compiler/ghc.cabal.in ===================================== @@ -532,6 +532,7 @@ Library GHC.IfaceToCore GHC.Iface.Type GHC.JS.Make + GHC.JS.Optimizer GHC.JS.Ppr GHC.JS.Syntax GHC.JS.Transform @@ -672,7 +673,6 @@ Library GHC.StgToJS.Object GHC.StgToJS.Prim GHC.StgToJS.Profiling - GHC.StgToJS.Printer GHC.StgToJS.Regs GHC.StgToJS.Rts.Types GHC.StgToJS.Rts.Rts @@ -686,6 +686,7 @@ Library GHC.StgToJS.Linker.Linker GHC.StgToJS.Linker.Types GHC.StgToJS.Linker.Utils + GHC.StgToJS.Linker.Opt GHC.Stg.Unarise GHC.SysTools GHC.SysTools.Ar ===================================== testsuite/tests/javascript/opt/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests for the JS backend optimizer +setTestOpts(when(not(js_arch()),skip)) + +test('deadCodeElim', normal, compile_and_run, ['-package ghc']) ===================================== testsuite/tests/javascript/opt/deadCodeElim.hs ===================================== @@ -0,0 +1,96 @@ + +import GHC.JS.Optimizer +import GHC.JS.Syntax +import GHC.JS.Unsat.Syntax (Ident (..)) + +import GHC.Data.FastString + +double_return :: JStat +double_return = BlockStat [ ReturnStat (SatInt 0) + , ReturnStat (SatInt 1) + ] + +double_return_opt :: JStat +double_return_opt = (BlockStat [ReturnStat (SatInt 0)]) + +in_func :: JStat +in_func = AssignStat (jvar (fsLit "foo")) AssignOp (ValExpr (JFunc [] double_return)) + +in_func_opt :: JStat +in_func_opt = AssignStat (jvar (fsLit "foo")) AssignOp (ValExpr (JFunc [] double_return_opt)) + +nested_blocks :: JStat +nested_blocks = BlockStat [ double_return <> double_return + , double_return + ] <> double_return + +nested_blocks_opt :: JStat +nested_blocks_opt = double_return_opt + +global_func :: JStat +global_func = FuncStat (TxtI (fsLit "bar")) [] double_return + +global_func_opt :: JStat +global_func_opt = FuncStat (TxtI (fsLit "bar")) [] double_return_opt + +func_with_locals :: JStat +func_with_locals = AssignStat (jvar (fsLit "foo")) + AssignOp + (ValExpr (JFunc [] + (BlockStat [ AssignStat (jvar (fsLit "one")) AssignOp (SatInt 2) + , AssignStat (jvar (fsLit "two")) AssignOp (SatInt 3) + , ApplStat (jvar (fsLit "f")) [(SatInt 100)] + , ReturnStat (SatInt 0) + , ReturnStat (SatInt 1) + ]))) + +func_with_locals_opt :: JStat +func_with_locals_opt = AssignStat (jvar (fsLit "foo")) + AssignOp + (ValExpr (JFunc [] + (BlockStat [ AssignStat (jvar (fsLit "one")) AssignOp (SatInt 2) + , AssignStat (jvar (fsLit "two")) AssignOp (SatInt 3) + , ApplStat (jvar (fsLit "f")) [(SatInt 100)] + , ReturnStat (SatInt 0) + ]))) + +-- This one comes straight from MR10260 where we noticed the optimizer was not catching the redundant return +bignum_test :: JStat +bignum_test = DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + , ReturnStat (ApplExpr (jvar $ fsLit "h$rs") [])])) + +bignum_test_opt :: JStat +bignum_test_opt = + DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + ])) + +bignum_test_2 :: JStat +bignum_test_2 = BlockStat [FuncStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99") [] (BlockStat [DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + , ReturnStat (ApplExpr (jvar $ fsLit "h$rs") [])]))])] + +bignum_test_opt_2 :: JStat +bignum_test_opt_2 = BlockStat [FuncStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99") [] (BlockStat [DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + ]))])] + +main :: IO () +main = mapM_ print + [ jsOptimize double_return == double_return_opt + , jsOptimize in_func == in_func_opt + , jsOptimize nested_blocks == nested_blocks_opt + , jsOptimize global_func == global_func_opt + , jsOptimize func_with_locals == func_with_locals_opt + , jsOptimize bignum_test == bignum_test_opt + , jsOptimize bignum_test_2 == bignum_test_opt_2 + ] ===================================== testsuite/tests/javascript/opt/deadCodeElim.stdout ===================================== @@ -0,0 +1,7 @@ +True +True +True +True +True +True +True ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -7,7 +7,7 @@ ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:3993:49: Note [Eta-reduction in -O0] +ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice] ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices] @@ -15,6 +15,7 @@ ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constr ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -25,14 +26,14 @@ ref compiler/GHC/Tc/Gen/HsType.hs:2621:7: Note [Matching a kind signature ref compiler/GHC/Tc/Gen/Pat.hs:176:20: Note [Typing patterns in pattern bindings] ref compiler/GHC/Tc/Gen/Pat.hs:1127:7: Note [Matching polytyped patterns] ref compiler/GHC/Tc/Gen/Sig.hs:81:10: Note [Overview of type signatures] -ref compiler/GHC/Tc/Gen/Splice.hs:357:16: Note [How brackets and nested splices are handled] -ref compiler/GHC/Tc/Gen/Splice.hs:532:35: Note [PendingRnSplice] -ref compiler/GHC/Tc/Gen/Splice.hs:656:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/Tc/Gen/Splice.hs:889:11: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:356:16: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:531:35: Note [PendingRnSplice] +ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1120:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics] @@ -46,8 +47,8 @@ ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threa ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] ref testsuite/config/ghc:272:10: Note [WayFlags] -ref testsuite/driver/testlib.py:160:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:164:2: Note [Why is there no stage1 setup function?] +ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] +ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts] ===================================== testsuite/tests/th/T21050.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell, ImpredicativeTypes #-} +module T21050 where + +import Language.Haskell.TH.Syntax + +data T = MkT (forall a. a) + +f x = [|| MkT $$(x) ||] + +g :: Code Q (forall a. a) -> Code Q T +g x = [|| MkT $$(x) ||] ===================================== testsuite/tests/th/T21050.stderr ===================================== @@ -0,0 +1,26 @@ + +T21050.hs:8:18: error: [GHC-25897] + • Couldn't match expected type ‘Code m a1’ with actual type ‘p’ + ‘p’ is a rigid type variable bound by + the inferred type of f :: Quote m => p -> Code m T + at T21050.hs:8:1-23 + • In the expression: x + In the Template Haskell splice $$(x) + In the first argument of ‘MkT’, namely ‘$$(x)’ + • Relevant bindings include + x :: p (bound at T21050.hs:8:3) + f :: p -> Code m T (bound at T21050.hs:8:1) + +T21050.hs:11:18: error: [GHC-91028] + • Couldn't match type ‘a’ with ‘forall a2. a2’ + Expected: Code Q a + Actual: Code Q (forall a. a) + Cannot equate type variable ‘a’ + with a type involving polytypes: forall a2. a2 + ‘a’ is a rigid type variable bound by + a type expected by the context: + forall a. a + at T21050.hs:11:15-19 + • In the expression: x + In the Template Haskell splice $$(x) + In the first argument of ‘MkT’, namely ‘$$(x)’ ===================================== testsuite/tests/th/all.T ===================================== @@ -564,3 +564,4 @@ test('TH_typed2', normal, compile_and_run, ['']) test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed5', normal, compile_and_run, ['']) +test('T21050', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24effc0241d63dffc8f0add3c2092a860187c231...f7c1e9eba9a5597bcee3914637dfe77cedd4dda8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24effc0241d63dffc8f0add3c2092a860187c231...f7c1e9eba9a5597bcee3914637dfe77cedd4dda8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 15:28:29 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 09 May 2023 11:28:29 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] Move "target has RTS linker" out of settings Message-ID: <645a669d8d30f_38ffdab433d57411518f6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: e52cbc96 by Rodrigo Mesquita at 2023-05-09T16:28:18+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4727,8 +4727,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . ===================================== compiler/GHC/Platform.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Platform , platformInIntRange , platformInWordRange , platformCConvNeedsExtension + , platformHasRTSLinker , PlatformMisc(..) , SseVersion (..) , BmiVersion (..) @@ -271,6 +272,23 @@ platformCConvNeedsExtension platform = case platformArch platform of | OSDarwin <- platformOS platform -> True _ -> False +-- | Does this platform have an RTS linker? +platformHasRTSLinker :: Platform -> Bool +-- Note that we've inlined this logic in hadrian's +-- Settings.Builders.RunTest.inTreeCompilerArgs. +-- If you change this, be sure to change it too +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- powerpc + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + -------------------------------------------------- -- Instruction sets ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -451,7 +451,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -126,7 +126,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- For this information, we need to query ghc --info, however, that would + -- require building ghc, which we don't want to do here. Therefore, the + -- logic from `platformHasRTSLinker` is duplicated here. + let rtsLinker = arch `elem` ["powerpc", "powerpc64", "powerpc64le", "s390x", "riscv64", "loongarch64", "javascript", "wasm32"] return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e52cbc969703bd0bfdbb0cb1bb8c8a198e9f005b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e52cbc969703bd0bfdbb0cb1bb8c8a198e9f005b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 15:35:25 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 09 May 2023 11:35:25 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 194 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <645a683dbdaf4_38ffdab58860e811631b2@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - a3c6d8f1 by Rodrigo Mesquita at 2023-05-09T16:34:35+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Closes #23361 - - - - - 2ab7ae0a by Ben Gamari at 2023-05-09T16:34:35+01:00 ghc-toolchain: Initial commit - - - - - 03dd35df by Ben Gamari at 2023-05-09T16:34:35+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - a633f420 by Ben Gamari at 2023-05-09T16:34:35+01:00 Move via-C flags into GHC - - - - - 76e5ed1e by Ben Gamari at 2023-05-09T16:34:35+01:00 Rip out runtime linker/compiler checks - - - - - 94ef73bd by Ben Gamari at 2023-05-09T16:34:35+01:00 configure: Rip out toolchain selection logic - - - - - 27695105 by Ben Gamari at 2023-05-09T16:34:36+01:00 Fixes - - - - - 7dfa1f4e by Rodrigo Mesquita at 2023-05-09T16:34:36+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 06c048f3 by Rodrigo Mesquita at 2023-05-09T16:34:36+01:00 Re-introduce ld-override option - - - - - 80de30b4 by Rodrigo Mesquita at 2023-05-09T16:34:36+01:00 ROMES:WIP - - - - - b8044245 by Rodrigo Mesquita at 2023-05-09T16:35:07+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 449c8888 by Rodrigo Mesquita at 2023-05-09T16:35:08+01:00 ROMES: WIP - - - - - 7332d2b9 by Rodrigo Mesquita at 2023-05-09T16:35:08+01:00 Re-introduce flags in hadrian config - - - - - 331d4ec7 by Rodrigo Mesquita at 2023-05-09T16:35:09+01:00 ROMES WIP - - - - - 48620a41 by Rodrigo Mesquita at 2023-05-09T16:35:09+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1387b26399d0fa2dce2e6948afbab3ba80dfb0a...48620a416e8764beeb69d1fa5f975f6fbf6f0a06 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1387b26399d0fa2dce2e6948afbab3ba80dfb0a...48620a416e8764beeb69d1fa5f975f6fbf6f0a06 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 16:22:03 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 09 May 2023 12:22:03 -0400 Subject: [Git][ghc/ghc][wip/T23025] 67 commits: hadrian: Pass haddock file arguments in a response file Message-ID: <645a732bf011c_38ffdab899e1f81184217@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23025 at Glasgow Haskell Compiler / GHC Commits: f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - 0251e6c4 by Krzysztof Gogolewski at 2023-05-09T18:20:16+02:00 WIP on #23025 - - - - - c6f701a5 by Krzysztof Gogolewski at 2023-05-09T18:20:16+02:00 WIP: fix another bug - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9a5a9b4e27df4d13f4cb44a389f7afef885c5d5...c6f701a57cb22def21ca219e5eee50d4746b4822 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9a5a9b4e27df4d13f4cb44a389f7afef885c5d5...c6f701a57cb22def21ca219e5eee50d4746b4822 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 17:47:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 13:47:42 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] 3 commits: Fix up rules for ghcup-metadata-nightly-push Message-ID: <645a873e185a9_38ffdabc97b3981213130@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - 4e59bbf9 by Ben Gamari at 2023-05-09T13:47:34-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) - - - - - 3d32cad7 by Ben Gamari at 2023-05-09T13:47:34-04:00 compiler: Record original thunk info tables on stack - - - - - 13 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - docs/users_guide/debugging.rst - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - testsuite/tests/driver/T13914/T13914.stdout - utils/deriveConstants/Main.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: rules: - if: $NIGHTLY -# Update the +# Update the ghcup metadata with information about this nightly pipeline ghcup-metadata-nightly-push: stage: deploy image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" @@ -1072,11 +1072,8 @@ ghcup-metadata-nightly-push: - git commit -m "Update metadata" - git push gitlab_origin HEAD:updates -o ci.skip rules: - - if: $NIGHTLY # Only run the update on scheduled nightly pipelines, ie once a day - - if: $CI_PIPELINE_SOURCE == "schedule" - # And only update the metadata for master branch - - if: '$CI_COMMIT_BRANCH == "master"' + - if: $NIGHTLY && $CI_PIPELINE_SOURCE == "schedule" && $CI_COMMIT_BRANCH == "master" ghcup-metadata-release: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -37,6 +37,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -5,6 +5,7 @@ module GHC.Driver.Flags , GeneralFlag(..) , Language(..) , optimisationFlags + , codeGenFlags -- * Warnings , WarningGroup(..) @@ -328,6 +329,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -473,15 +475,11 @@ data GeneralFlag | Opt_G_NoOptCoercion deriving (Eq, Show, Enum) --- Check whether a flag should be considered an "optimisation flag" --- for purposes of recompilation avoidance (see --- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is --- not a guarantee that the flag has no other effect. We could, and --- perhaps should, separate out the flags that have some minor impact on --- program semantics and/or error behavior (e.g., assertions), but --- then we'd need to go to extra trouble (and an additional flag) --- to allow users to ignore the optimisation level even though that --- means ignoring some change. +-- | The set of flags which affect optimisation for the purposes of +-- recompilation avoidance. Specifically, these include flags which +-- affect code generation but not the semantics of the program. +-- +-- See Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags) optimisationFlags :: EnumSet GeneralFlag optimisationFlags = EnumSet.fromList [ Opt_CallArity @@ -503,7 +501,6 @@ optimisationFlags = EnumSet.fromList , Opt_SpecConstr , Opt_SpecConstrKeen , Opt_DoLambdaEtaExpansion - , Opt_IgnoreAsserts , Opt_DoEtaReduction , Opt_CaseMerge , Opt_CaseFolding @@ -513,16 +510,12 @@ optimisationFlags = EnumSet.fromList , Opt_EnableRewriteRules , Opt_RegsGraph , Opt_RegsIterative - , Opt_PedanticBottoms , Opt_LlvmTBAA - , Opt_LlvmFillUndefWithGarbage , Opt_IrrefutableTuples , Opt_CmmSink , Opt_CmmElimCommonBlocks , Opt_AsmShortcutting - , Opt_OmitYields , Opt_FunToThunk - , Opt_DictsStrict , Opt_DmdTxDictSel , Opt_Loopification , Opt_CfgBlocklayout @@ -531,8 +524,47 @@ optimisationFlags = EnumSet.fromList , Opt_WorkerWrapper , Opt_WorkerWrapperUnlift , Opt_SolveConstantDicts + ] + +-- | The set of flags which affect code generation and can change a program's +-- runtime behavior (other than performance). These include flags which affect: +-- +-- * user visible debugging information (e.g. info table provenance) +-- * the ability to catch runtime errors (e.g. -fignore-asserts) +-- * the runtime result of the program (e.g. -fomit-yields) +-- * which code or interface file declarations are emitted +-- +-- We also considered placing flags which affect asympototic space behavior +-- (e.g. -ffull-laziness) however this would mean that changing optimisation +-- levels would trigger recompilation even with -fignore-optim-changes, +-- regressing #13604. +-- +-- Also, arguably Opt_IgnoreAsserts should be here as well; however, we place +-- it instead in 'optimisationFlags' since it is implied by @-O[12]@ and +-- therefore would also break #13604. +-- +codeGenFlags :: EnumSet GeneralFlag +codeGenFlags = EnumSet.fromList + [ -- Flags that affect runtime result + Opt_EagerBlackHoling + , Opt_ExcessPrecision + , Opt_DictsStrict + , Opt_PedanticBottoms + , Opt_OmitYields + + -- Flags that affect generated code + , Opt_ExposeAllUnfoldings + , Opt_NoTypeableBinds + + -- Flags that affect catching of runtime errors , Opt_CatchNonexhaustiveCases - , Opt_IgnoreAsserts + , Opt_LlvmFillUndefWithGarbage + , Opt_DoTagInferenceChecks + + -- Flags that affect debugging information + , Opt_DistinctConstructorTables + , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -66,6 +66,7 @@ module GHC.Driver.Session ( makeDynFlagsConsistent, positionIndependent, optimisationFlags, + codeGenFlags, setFlagsFromEnvFile, pprDynFlagsDiff, flagSpecOf, @@ -3481,6 +3482,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio = ticky = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] - flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters)) + -- Other flags which affect code generation + codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags) + + flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ computeFingerprint nameio flags ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -49,6 +49,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== docs/users_guide/debugging.rst ===================================== @@ -1072,6 +1072,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== testsuite/tests/driver/T13914/T13914.stdout ===================================== @@ -5,11 +5,11 @@ main: Assertion failed CallStack (from HasCallStack): assert, called at main.hs:3:8 in main:Main With -fignore-asserts -[1 of 2] Compiling Main ( main.hs, main.o ) [Optimisation flags changed] +[1 of 2] Compiling Main ( main.hs, main.o ) [Flags changed] [2 of 2] Linking main [Objects changed] OK Without -fignore-asserts -[1 of 2] Compiling Main ( main.hs, main.o ) [Optimisation flags changed] +[1 of 2] Compiling Main ( main.hs, main.o ) [Flags changed] [2 of 2] Linking main [Objects changed] main: Assertion failed CallStack (from HasCallStack): ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09fb21d748fbc5d6805dcf8e260c16b2ef686fcf...3d32cad7947b22dd753200dbce82039ea86db794 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09fb21d748fbc5d6805dcf8e260c16b2ef686fcf...3d32cad7947b22dd753200dbce82039ea86db794 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 18:49:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 14:49:16 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: testsuite: Add test for atomicSwapIORef Message-ID: <645a95ac7300a_38ffdac056ce741240098@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 43bd5308 by doyougnu at 2023-05-09T14:49:08-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 05efe298 by Krzysztof Gogolewski at 2023-05-09T14:49:09-04:00 Add a regression test for #21050 - - - - - d412b167 by Ben Gamari at 2023-05-09T14:49:10-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/ghc.cabal.in - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - + libraries/base/tests/AtomicSwapIORef.stdout - libraries/base/tests/all.T - rts/include/Cmm.h - rts/sm/NonMovingAllocate.c - rts/sm/Storage.c - rts/sm/Storage.h - + testsuite/tests/javascript/opt/all.T - + testsuite/tests/javascript/opt/deadCodeElim.hs - + testsuite/tests/javascript/opt/deadCodeElim.stdout - testsuite/tests/linters/notes.stdout - + testsuite/tests/th/T21050.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7c1e9eba9a5597bcee3914637dfe77cedd4dda8...d412b16742d187ad3e3f3a97dc3e2954c2abbb49 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7c1e9eba9a5597bcee3914637dfe77cedd4dda8...d412b16742d187ad3e3f3a97dc3e2954c2abbb49 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 19:38:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 15:38:38 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 384 commits: Add clangd flag to include generated header files Message-ID: <645aa13eb5ff7_38ffdac43fea201275486@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - 81bbfec7 by Ben Gamari at 2023-05-09T15:38:24-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4e3caf8415d00b0f69716785222068bb37f5b45...81bbfec71cda8254b613fd710fb8f7a4596f1d6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4e3caf8415d00b0f69716785222068bb37f5b45...81bbfec71cda8254b613fd710fb8f7a4596f1d6e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 22:39:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 18:39:39 -0400 Subject: [Git][ghc/ghc][master] 3 commits: testsuite: Add test for atomicSwapIORef Message-ID: <645acbab9cb86_38ffdad6fba1f41384239@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - + libraries/base/tests/AtomicSwapIORef.stdout - libraries/base/tests/all.T - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2604,6 +2604,12 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -297,16 +297,12 @@ emitPrimOp cfg primop = -- MutVar's value. emitPrimCall [] (MO_AtomicWrite (wordWidth platform) MemOrderRelease) [ cmmOffsetW platform mutv (fixedHdrSizeW profile), var ] + emitDirtyMutVar mutv (CmmReg old_val) - platform <- getPlatform - mkdirtyMutVarCCall <- getCode $! emitCCall - [{-no results-}] - (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) - [(baseExpr platform, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)] - emit =<< mkCmmIfThen - (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) - (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv)) - mkdirtyMutVarCCall + AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do + let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile) + emitPrimCall [res] (MO_Xchg (wordWidth platform)) [dst, val] + emitDirtyMutVar mutv (CmmReg (CmmLocal res)) -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes @@ -3331,6 +3327,21 @@ doByteArrayBoundsCheck idx arr idx_ty elem_ty = whenCheckBounds $ do then emitBoundsCheck idx effective_arr_sz -- aligned => simpler check else assert (idx_w == W8) (emitRangeBoundsCheck idx elem_sz arr_sz) +-- | Write barrier for @MUT_VAR@ modification. +emitDirtyMutVar :: CmmExpr -> CmmExpr -> FCode () +emitDirtyMutVar mutvar old_val = do + cfg <- getStgToCmmConfig + platform <- getPlatform + mkdirtyMutVarCCall <- getCode $! emitCCall + [{-no results-}] + (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) + [(baseExpr platform, AddrHint), (mutvar, AddrHint), (old_val, AddrHint)] + + emit =<< mkCmmIfThen + (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) + (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutvar)) + mkdirtyMutVarCCall + --------------------------------------------------------------------------- -- Pushing to the update remembered set --------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -801,6 +801,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,12 +127,7 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. -atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) - -data Box a = Box a +atomicSwapIORef (IORef (STRef ref)) new = IO (atomicSwapMutVar# ref new) -- | A strict version of 'Data.IORef.atomicModifyIORef'. This forces both the -- value stored in the 'IORef' and the value returned. ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,10 @@ +import Data.IORef +import GHC.IORef +import Data.Word + +main :: IO () +main = do + r <- newIORef 42 :: IO (IORef Int) + mapM (atomicSwapIORef r) [0..1000] >>= print + mapM (atomicSwapIORef r) [0..1000000] >>= print . sum . map (fromIntegral :: Int -> Integer) + readIORef r >>= print ===================================== libraries/base/tests/AtomicSwapIORef.stdout ===================================== @@ -0,0 +1,3 @@ +[42,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999] +499999501000 +1000000 ===================================== libraries/base/tests/all.T ===================================== @@ -298,3 +298,4 @@ test('listThreads', normal, compile_and_run, ['']) test('listThreads1', normal, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0e2df4c9ac59a10080bd6e029e83a355ecd01c8b...6b29154de6b63597553c5b69b9974c8838a7a80a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0e2df4c9ac59a10080bd6e029e83a355ecd01c8b...6b29154de6b63597553c5b69b9974c8838a7a80a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 22:40:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 18:40:32 -0400 Subject: [Git][ghc/ghc][master] JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt Message-ID: <645acbe0c98ff_38ffdad6fba1f41388154@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 18 changed files: - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/ghc.cabal.in - + testsuite/tests/javascript/opt/all.T - + testsuite/tests/javascript/opt/deadCodeElim.hs - + testsuite/tests/javascript/opt/deadCodeElim.stdout - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -83,7 +83,7 @@ module GHC.JS.Make -- $intro_funcs , var , jString - , jLam, jVar, jFor, jForIn, jForEachIn, jTryCatchFinally + , jLam, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally -- * Combinators -- $combinators , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!) @@ -253,7 +253,7 @@ jLam f = ValExpr . UnsatVal . IS $ do -- of the enclosed expression. The result is a block statement. -- Usage: -- --- @jVar $ \x y -> mconcat [jVar x ||= one_, jVar y ||= two_, jVar x + jVar y]@ +-- @jVar $ \x y -> mconcat [x ||= one_, y ||= two_, x + y]@ jVar :: ToSat a => a -> JStat jVar f = UnsatBlock . IS $ do (block, is) <- runIdentSupply $ toSat_ f [] @@ -262,6 +262,9 @@ jVar f = UnsatBlock . IS $ do addDecls x = x return $ addDecls block +jFunction :: Ident -> [Ident] -> JStat -> JStat +jFunction name args body = FuncStat name args body + -- | Create a 'for in' statement. -- Usage: -- @@ -279,6 +282,23 @@ jForEachIn e f = UnsatBlock . IS $ do let i = head is return $ decl i `mappend` ForInStat True i e block +-- | Create a 'for' statement given a function for initialization, a predicate +-- to step to, a step and a body +-- Usage: +-- +-- @ jFor (|= zero_) (.<. Int 65536) preIncrS +-- (\j -> ...something with the counter j...)@ +-- +jFor :: (JExpr -> JStat) + -> (JExpr -> JExpr) + -> (JExpr -> JStat) + -> (JExpr -> JStat) + -> JStat +jFor init pred step body = jVar $ \i -> ForStat (init i) (pred i) (step i) (body i) + +jForNoDecl :: Ident -> JExpr -> JExpr -> JStat -> JStat -> JStat +jForNoDecl i initial p step body = ForStat (toJExpr i |= initial) p step body + -- | As with "jForIn" but creating a \"for each in\" statement. jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat jTryCatchFinally s f s2 = UnsatBlock . IS $ do @@ -294,13 +314,6 @@ var = ValExpr . JVar . TxtI jString :: FastString -> JExpr jString = toJExpr --- | Create a 'for' statement -jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat -jFor before p after b = BlockStat [before, WhileStat False (toJExpr p) b'] - where b' = case toStat b of - BlockStat xs -> BlockStat $ xs ++ [after] - x -> BlockStat [x,after] - -- | construct a js declaration with the given identifier decl :: Ident -> JStat decl i = DeclStat i Nothing ===================================== compiler/GHC/JS/Optimizer.hs ===================================== @@ -0,0 +1,271 @@ +{-# LANGUAGE LambdaCase #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.JS.Optimizer +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Jeffrey Young +-- Luite Stegeman +-- Sylvain Henry +-- Josh Meredith +-- Stability : experimental +-- +-- +-- * Domain and Purpose +-- +-- GHC.JS.Optimizer is a shallow embedding of a peephole optimizer. That is, +-- this module defines transformations over the JavaScript IR in +-- 'GHC.JS.Syntax', transforming the IR forms from inefficient, or +-- non-idiomatic, JavaScript to more efficient and idiomatic JavaScript. The +-- optimizer is written in continuation passing style so optimizations +-- compose. +-- +-- * Architecture of the optimizer +-- +-- The design is that each optimization pattern matches on the head of a +-- block by pattern matching onto the head of the stream of nodes in the +-- JavaScript IR. If an optimization gets a successful match then it performs +-- whatever rewrite is necessary and then calls the 'loop' continuation. This +-- ensures that the result of the optimization is subject to the same +-- optimization, /and/ the rest of the optimizations. If there is no match +-- then the optimization should call the 'next' continuation to pass the +-- stream to the next optimization in the optimization chain. We then define +-- the last "optimization" to be @tailLoop@ which selects the next block of +-- code to optimize and begin the optimization pipeline again. +----------------------------------------------------------------------------- +module GHC.JS.Optimizer + ( jsOptimize + ) where + + +import Prelude + +import GHC.JS.Syntax + +import Control.Arrow + +{- +Note [ Unsafe JavaScript Optimizations ] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +There are a number of optimizations that the JavaScript Backend performs that +are not sound with respect to arbritrary JavaScript. We still perform these +optimizations because we are not optimizing arbritrary javascript and under the +assumption that the JavaScript backend will not generate code that violates the +soundness of the optimizer. For example, the @deadCodeElim@ optimization removes +all statements that occur after a 'return' in JavaScript, however this is not +always sound because of hoisting, consider this program: + + function foo() { + var x = 2; + bar(); + return x; + + function bar() { + x = 10; + }} + + which is transformed to: + + function foo() { + var x = 2; + bar(); + return x; + }} + +The optimized form is clearly a program that goes wrong because `bar()` is no +longer defined. But the JavaScript backend will never generate this code, so as +long as that assumption holds we are safe to perform optimizations that would +normally be unsafe. +-} + + +-------------------------------------------------------------------------------- +-- Top level Driver +-------------------------------------------------------------------------------- +jsOptimize :: JStat -> JStat +jsOptimize = go + where + p_opt = jsOptimize + opt = jsOptimize' + e_opt = jExprOptimize + -- base case + go (BlockStat xs) = BlockStat (opt xs) + -- recursive cases + go (ForStat i p s body) = ForStat (go i) (e_opt p) (go s) (p_opt body) + go (ForInStat b i p body) = ForInStat b i p (p_opt body) + go (WhileStat b c body) = WhileStat b (e_opt c) (p_opt body) + go (SwitchStat s ps body) = SwitchStat s (fmap (second go) ps) (p_opt body) + go (FuncStat i args body) = FuncStat i args (p_opt body) + go (IfStat c t e) = IfStat (e_opt c) (p_opt t) (p_opt e) + go (TryStat ths i c f) = TryStat (p_opt ths) i (p_opt c) (p_opt f) + go (LabelStat lbl s) = LabelStat lbl (p_opt s) + -- special case: drive the optimizer into expressions + go (AssignStat id op rhs) = AssignStat (e_opt id) op (e_opt rhs) + go (DeclStat i (Just e)) = DeclStat i (Just $ e_opt e) + go (ReturnStat e) = ReturnStat (e_opt e) + go (UOpStat op e) = UOpStat op (e_opt e) + go (ApplStat f args) = ApplStat (e_opt f) (e_opt <$> args) + -- all else is terminal, we match on these to force a warning in the event + -- another constructor is added + go x at BreakStat{} = x + go x at ContinueStat{} = x + go x at DeclStat{} = x -- match on the nothing case + +jsOptimize' :: [JStat] -> [JStat] +jsOptimize' = runBlockOpt opts . single_pass_opts + where + opts :: BlockOpt + opts = safe_opts + <> unsafe_opts + <> tailLoop -- tailloop must be last, see module description + + unsafe_opts :: BlockOpt + unsafe_opts = mconcat [ deadCodeElim ] + + safe_opts :: BlockOpt + safe_opts = mconcat [ declareAssign, combineOps ] + + single_pass_opts :: BlockTrans + single_pass_opts = runBlockTrans sp_opts + + sp_opts = [flattenBlocks] + +-- | recur over a @JExpr@ and optimize the @JVal at s +jExprOptimize :: JExpr -> JExpr +-- the base case +jExprOptimize (ValExpr val) = ValExpr (jValOptimize val) +-- recursive cases +jExprOptimize (SelExpr obj field) = SelExpr (jExprOptimize obj) field +jExprOptimize (IdxExpr obj ix) = IdxExpr (jExprOptimize obj) (jExprOptimize ix) +jExprOptimize (UOpExpr op exp) = UOpExpr op (jExprOptimize exp) +jExprOptimize (IfExpr c t e) = IfExpr c (jExprOptimize t) (jExprOptimize e) +jExprOptimize (ApplExpr f args ) = ApplExpr (jExprOptimize f) (jExprOptimize <$> args) +jExprOptimize (InfixExpr op l r) = InfixExpr op (jExprOptimize l) (jExprOptimize r) + +-- | drive optimizations to anonymous functions and over expressions +jValOptimize :: JVal -> JVal +-- base case +jValOptimize (JFunc args body) = JFunc args (jsOptimize body) +-- recursive cases +jValOptimize (JList exprs) = JList (jExprOptimize <$> exprs) +jValOptimize (JHash hash) = JHash (jExprOptimize <$> hash) +-- all else is terminal +jValOptimize x at JVar{} = x +jValOptimize x at JDouble{} = x +jValOptimize x at JInt{} = x +jValOptimize x at JStr{} = x +jValOptimize x at JRegEx{} = x + +-- | A block transformation is a function from a stream of syntax to another +-- stream +type BlockTrans = [JStat] -> [JStat] + +-- | A BlockOpt is a function that alters the stream, and a continuation that +-- represents the rest of the stream. The first @BlockTrans@ represents +-- restarting the optimizer after a change has happened. The second @BlockTrans@ +-- represents the rest of the continuation stream. +newtype BlockOpt = BlockOpt (BlockTrans -> BlockTrans -> BlockTrans) + +-- | To merge two BlockOpt we first run the left-hand side optimization and +-- capture the right-hand side in the continuation +instance Semigroup BlockOpt where + BlockOpt opt0 <> BlockOpt opt1 = BlockOpt + $ \loop next -> opt0 loop (opt1 loop next) + +instance Monoid BlockOpt where + -- don't loop, just finalize + mempty = BlockOpt $ \_loop next -> next + +-- | loop until a fixpoint is reached +runBlockOpt :: BlockOpt -> [JStat] -> [JStat] +runBlockOpt (BlockOpt opt) xs = recur xs + where recur = opt recur id + +runBlockTrans :: [BlockTrans] -> [JStat] -> [JStat] +runBlockTrans opts = foldl (.) id opts + +-- | Perform all the optimizations on the tail of a block. +tailLoop :: BlockOpt +tailLoop = BlockOpt $ \loop next -> \case + [] -> next [] + -- this call to jsOptimize is required or else the optimizer will not + -- properly recur down JStat. See the 'deadCodeElim' test for examples which + -- were failing before this change + (x:xs) -> next (jsOptimize x : loop xs) + +-------------------------------------------------------------------------------- +-- Single Slot Optimizations +-------------------------------------------------------------------------------- + +{- | + Catch modify and assign operators: + case 1: + i = i + 1; ==> ++i; + case 2: + i = i - 1; ==> --i; + case 3: + i = i + n; ==> i += n; + case 4: + i = i - n; ==> i -= n; +-} +combineOps :: BlockOpt +combineOps = BlockOpt $ \loop next -> + \case + -- find a op pattern, and rerun the optimizer on its result unless there is + -- nothing to optimize, in which case call the next optimization + (unchanged@(AssignStat + ident@(ValExpr (JVar i)) + AssignOp + (InfixExpr op (ValExpr (JVar i')) e)) : xs) + | i == i' -> case (op, e) of + (AddOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreIncOp ident : xs + (SubOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreDecOp ident : xs + (AddOp, e') -> loop $ AssignStat ident AddAssignOp e' : xs + (SubOp, e') -> loop $ AssignStat ident SubAssignOp e' : xs + _ -> next $ unchanged : xs + -- commutative cases + (unchanged@(AssignStat + ident@(ValExpr (JVar i)) + AssignOp + (InfixExpr op e (ValExpr (JVar i')))) : xs) + | i == i' -> case (op, e) of + (AddOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreIncOp ident : xs + (SubOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreDecOp ident : xs + (AddOp, e') -> loop $ AssignStat ident AddAssignOp e' : xs + (SubOp, e') -> loop $ AssignStat ident SubAssignOp e' : xs + _ -> next $ unchanged : xs + -- general case, we had nothing to optimize in this case so call the next + -- optimization + xs -> next xs + + +-------------------------------------------------------------------------------- +-- Dual Slot Optimizations +-------------------------------------------------------------------------------- +-- | Catch 'var i; i = q;' ==> 'var i = q;' +declareAssign :: BlockOpt +declareAssign = BlockOpt $ + \loop next -> \case + ( (DeclStat i Nothing) + : (AssignStat (ValExpr (JVar i')) AssignOp v) + : xs + ) | i == i' -> loop (DeclStat i (Just v) : xs) + xs -> next xs + +-- | Eliminate all code after a return statement. This is a special case +-- optimization that doesn't need to loop. See Note [Unsafe JavaScript +-- optimizations] +deadCodeElim :: BlockOpt +deadCodeElim = BlockOpt $ + \_loop next -> \case + (x at ReturnStat{}:_) -> next [x] + xs -> next xs + +-- | remove nested blocks +flattenBlocks :: BlockTrans +flattenBlocks (BlockStat y : ys) = flattenBlocks y ++ flattenBlocks ys +flattenBlocks (x:xs) = x : flattenBlocks xs +flattenBlocks [] = [] ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -10,10 +10,46 @@ -- For Outputable instances for JS syntax {-# OPTIONS_GHC -Wno-orphans #-} --- | Pretty-printing JavaScript +----------------------------------------------------------------------------- +-- | +-- Module : GHC.JS.Ppr +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Jeffrey Young +-- Luite Stegeman +-- Sylvain Henry +-- Josh Meredith +-- Stability : experimental +-- +-- +-- * Domain and Purpose +-- +-- GHC.JS.Ppr defines the code generation facilities for the JavaScript +-- backend. That is, this module exports a function from the JS backend IR +-- to JavaScript compliant concrete syntax that can readily be executed by +-- nodejs or called in a browser. +-- +-- * Design +-- +-- This module follows the architecture and style of the other backends in +-- GHC: it intances Outputable for the relevant types, creates a class that +-- describes a morphism from the IR domain to JavaScript concrete Syntax and +-- then generates that syntax on a case by case basis. +-- +-- * How to use +-- +-- The key functions are @renderJS@, @jsToDoc@, and the @RenderJS@ record. +-- Use the @RenderJS@ record and @jsToDoc@ to define a custom renderers for +-- specific parts of the backend, for example in 'GHC.StgToJS.Linker.Opt' a +-- custom renderer ensures all @Ident@ generated by the linker optimization +-- pass are prefixed differently than the default. Use @renderJS@ to +-- generate JavaScript concrete syntax in the general case, suitable for +-- human consumption. +----------------------------------------------------------------------------- + module GHC.JS.Ppr ( renderJs - , renderJs' , renderPrefixJs , renderPrefixJs' , JsToDoc(..) @@ -21,9 +57,10 @@ module GHC.JS.Ppr , RenderJs(..) , jsToDoc , pprStringLit - , flattenBlocks , braceNest , hangBrace + , interSemi + , addSemi ) where @@ -49,9 +86,9 @@ instance Outputable JExpr where instance Outputable JVal where ppr = docToSDoc . renderJs - -($$$) :: Doc -> Doc -> Doc -x $$$ y = nest 2 $ x $+$ y +-------------------------------------------------------------------------------- +-- Top level API +-------------------------------------------------------------------------------- -- | Render a syntax tree as a pretty-printable document -- (simply showing the resultant doc produces a nice, @@ -84,26 +121,17 @@ renderPrefixJs = renderPrefixJs' defaultRenderJs renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc renderPrefixJs' r = jsToDocR r -braceNest :: Doc -> Doc -braceNest x = char '{' <+> nest 2 x $$ char '}' - --- | Hang with braces: --- --- hdr { --- body --- } -hangBrace :: Doc -> Doc -> Doc -hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] +-------------------------------------------------------------------------------- +-- Code Generator +-------------------------------------------------------------------------------- class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc -instance JsToDoc JStat where jsToDocR r = renderJsS r r -instance JsToDoc JExpr where jsToDocR r = renderJsE r r -instance JsToDoc JVal where jsToDocR r = renderJsV r r -instance JsToDoc Ident where jsToDocR r = renderJsI r r -instance JsToDoc [JExpr] where - jsToDocR r = vcat . map ((<> semi) . jsToDocR r) -instance JsToDoc [JStat] where - jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc JStat where jsToDocR r = renderJsS r r +instance JsToDoc JExpr where jsToDocR r = renderJsE r r +instance JsToDoc JVal where jsToDocR r = renderJsV r r +instance JsToDoc Ident where jsToDocR r = renderJsI r r +instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) defRenderJsS :: RenderJs -> JStat -> Doc defRenderJsS r = \case @@ -120,12 +148,16 @@ defRenderJsS r = \case ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s where - printBS (BlockStat ss) = vcat $ interSemi $ flattenBlocks ss + printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - interSemi [x] = [jsToDocR r x] - interSemi [] = [] - interSemi (x:xs) = (jsToDocR r x <> semi) : interSemi xs + ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb) + where + forCond = parens $ hcat $ interSemi + [ jsToDocR r init + , jsToDocR r p + , parens (jsToDocR r s1) + ] ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) where txt | each = "for each" | otherwise = "for" @@ -134,12 +166,15 @@ defRenderJsS r = \case cases = vcat l' ReturnStat e -> text "return" <+> jsToDocR r e ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) + FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i + <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) + (jsToDocR r b) TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally where mbCatch | s1 == BlockStat [] = PP.empty | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) mbFinally | s2 == BlockStat [] = PP.empty | otherwise = hangBrace (text "finally") (jsToDocR r s2) - AssignStat i x -> case x of + AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. -- @@ -148,19 +183,13 @@ defRenderJsS r = \case -- ... -- }); -- - ValExpr (JFunc is b) -> sep [jsToDocR r i <+> text "= function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] - _ -> jsToDocR r i <+> char '=' <+> jsToDocR r x + ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] + _ -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x | isPre op -> ftext (uOpText op) <> optParens r x | otherwise -> optParens r x <> ftext (uOpText op) - BlockStat xs -> jsToDocR r (flattenBlocks xs) - -flattenBlocks :: [JStat] -> [JStat] -flattenBlocks = \case - BlockStat y:ys -> flattenBlocks y ++ flattenBlocks ys - y:ys -> y : flattenBlocks ys - [] -> [] + BlockStat xs -> jsToDocR r xs optParens :: RenderJs -> JExpr -> Doc optParens r x = case x of @@ -204,33 +233,12 @@ defRenderJsV r = \case defRenderJsI :: RenderJs -> Ident -> Doc defRenderJsI _ (TxtI t) = ftext t +aOpText :: AOp -> FastString +aOpText = \case + AssignOp -> "=" + AddAssignOp -> "+=" + SubAssignOp -> "-=" -pprStringLit :: FastString -> Doc -pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] - -encodeJson :: FastString -> Doc -encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) - -encodeJsonChar :: Char -> Doc -encodeJsonChar = \case - '/' -> text "\\/" - '\b' -> text "\\b" - '\f' -> text "\\f" - '\n' -> text "\\n" - '\r' -> text "\\r" - '\t' -> text "\\t" - '"' -> text "\\\"" - '\\' -> text "\\\\" - c - | not (isControl c) && ord c <= 127 -> char c - | ord c <= 0xff -> hexxs "\\x" 2 (ord c) - | ord c <= 0xffff -> hexxs "\\u" 4 (ord c) - | otherwise -> let cp0 = ord c - 0x10000 -- output surrogate pair - in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) <> - hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00) - where hexxs prefix pad cp = - let h = showHex cp "" - in text (prefix ++ replicate (pad - length h) '0' ++ h) uOpText :: UOp -> FastString uOpText = \case @@ -289,3 +297,56 @@ isAlphaOp = \case YieldOp -> True VoidOp -> True _ -> False + +pprStringLit :: FastString -> Doc +pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] + +-------------------------------------------------------------------------------- +-- Utilities +-------------------------------------------------------------------------------- + +encodeJson :: FastString -> Doc +encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) + +encodeJsonChar :: Char -> Doc +encodeJsonChar = \case + '/' -> text "\\/" + '\b' -> text "\\b" + '\f' -> text "\\f" + '\n' -> text "\\n" + '\r' -> text "\\r" + '\t' -> text "\\t" + '"' -> text "\\\"" + '\\' -> text "\\\\" + c + | not (isControl c) && ord c <= 127 -> char c + | ord c <= 0xff -> hexxs "\\x" 2 (ord c) + | ord c <= 0xffff -> hexxs "\\u" 4 (ord c) + | otherwise -> let cp0 = ord c - 0x10000 -- output surrogate pair + in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) <> + hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00) + where hexxs prefix pad cp = + let h = showHex cp "" + in text (prefix ++ replicate (pad - length h) '0' ++ h) + +braceNest :: Doc -> Doc +braceNest x = char '{' <+> nest 2 x $$ char '}' + +interSemi :: [Doc] -> [Doc] +interSemi [] = [] +interSemi [s] = [s] +interSemi (x:xs) = x <> text ";" : interSemi xs + +addSemi :: Doc -> Doc +addSemi x = x <> text ";" + +-- | Hang with braces: +-- +-- hdr { +-- body +-- } +hangBrace :: Doc -> Doc -> Doc +hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] + +($$$) :: Doc -> Doc -> Doc +x $$$ y = nest 2 $ x $+$ y ===================================== compiler/GHC/JS/Syntax.hs ===================================== @@ -58,6 +58,7 @@ module GHC.JS.Syntax , JVal(..) , Op(..) , UOp(..) + , AOp(..) , Ident(..) , JLabel -- * pattern synonyms over JS operators @@ -110,20 +111,22 @@ import GHC.Generics -- Reference](https://tc39.es/ecma262/#sec-ecmascript-language-statements-and-declarations) -- for details data JStat - = DeclStat !Ident !(Maybe JExpr) -- ^ Variable declarations: var foo [= e] - | ReturnStat JExpr -- ^ Return - | IfStat JExpr JStat JStat -- ^ If + = DeclStat !Ident !(Maybe JExpr) -- ^ Variable declarations: var foo [= e] + | ReturnStat JExpr -- ^ Return + | IfStat JExpr JStat JStat -- ^ If | WhileStat Bool JExpr JStat -- ^ While, bool is "do" when True + | ForStat JStat JExpr JStat JStat -- ^ For | ForInStat Bool Ident JExpr JStat -- ^ For-in, bool is "each' when True | SwitchStat JExpr [(JExpr, JStat)] JStat -- ^ Switch | TryStat JStat Ident JStat JStat -- ^ Try - | BlockStat [JStat] -- ^ Blocks - | ApplStat JExpr [JExpr] -- ^ Application - | UOpStat UOp JExpr -- ^ Unary operators - | AssignStat JExpr JExpr -- ^ Binding form: @foo = bar@ - | LabelStat JLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic - | BreakStat (Maybe JLabel) -- ^ Break - | ContinueStat (Maybe JLabel) -- ^ Continue + | BlockStat [JStat] -- ^ Blocks + | ApplStat JExpr [JExpr] -- ^ Application + | UOpStat UOp JExpr -- ^ Unary operators + | AssignStat JExpr AOp JExpr -- ^ Binding form: @ @ + | LabelStat JLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic + | BreakStat (Maybe JLabel) -- ^ Break + | ContinueStat (Maybe JLabel) -- ^ Continue + | FuncStat !Ident [Ident] JStat -- ^ an explicit function definition deriving (Eq, Typeable, Generic) -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of @@ -146,9 +149,9 @@ appendJStat mx my = case (mx,my) of (BlockStat [] , y ) -> y (x , BlockStat []) -> x (BlockStat xs , BlockStat ys) -> BlockStat $! xs ++ ys - (BlockStat xs , ys ) -> BlockStat $! xs ++ [ys] - (xs , BlockStat ys) -> BlockStat $! xs : ys - (xs , ys ) -> BlockStat [xs,ys] + (BlockStat xs , ys ) -> BlockStat $! xs ++ [ys] + (xs , BlockStat ys) -> BlockStat $! xs : ys + (xs , ys ) -> BlockStat [xs,ys] -------------------------------------------------------------------------------- @@ -156,13 +159,13 @@ appendJStat mx my = case (mx,my) of -------------------------------------------------------------------------------- -- | JavaScript Expressions data JExpr - = ValExpr JVal -- ^ All values are trivially expressions - | SelExpr JExpr Ident -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^' - | IdxExpr JExpr JExpr -- ^ Indexing: Obj[foo], see 'GHC.JS.Make..!' - | InfixExpr Op JExpr JExpr -- ^ Infix Expressions, see 'JExpr' pattern synonyms - | UOpExpr UOp JExpr -- ^ Unary Expressions + = ValExpr JVal -- ^ All values are trivially expressions + | SelExpr JExpr Ident -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^' + | IdxExpr JExpr JExpr -- ^ Indexing: Obj[foo], see 'GHC.JS.Make..!' + | InfixExpr Op JExpr JExpr -- ^ Infix Expressions, see 'JExpr' pattern synonyms + | UOpExpr UOp JExpr -- ^ Unary Expressions | IfExpr JExpr JExpr JExpr -- ^ If-expression - | ApplExpr JExpr [JExpr] -- ^ Application + | ApplExpr JExpr [JExpr] -- ^ Application deriving (Eq, Typeable, Generic) -- * Useful pattern synonyms to ease programming with the deeply embedded JS @@ -321,6 +324,15 @@ data UOp instance NFData UOp +-- | JS Unary Operators +data AOp + = AssignOp -- ^ Vanilla Assignment: = + | AddAssignOp -- ^ Addition Assignment: += + | SubAssignOp -- ^ Subtraction Assignment: -= + deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic) + +instance NFData AOp + -- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' -- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on -- Sane-ness @@ -345,10 +357,12 @@ instance Show SaneDouble where -------------------------------------------------------------------------------- jassignAllEqual :: [JExpr] -> [JExpr] -> JStat -jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" AssignStat xs ys) +jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" go xs ys) + where go l r = AssignStat l AssignOp r jassignAll :: [JExpr] -> [JExpr] -> JStat -jassignAll xs ys = mconcat (zipWith AssignStat xs ys) +jassignAll xs ys = mconcat $ zipWith go xs ys + where go l r = AssignStat l AssignOp r jvar :: FastString -> JExpr jvar = ValExpr . JVar . TxtI ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -47,6 +47,7 @@ identsS = \case Sat.ReturnStat e -> identsE e Sat.IfStat e s1 s2 -> identsE e ++ identsS s1 ++ identsS s2 Sat.WhileStat _ e s -> identsE e ++ identsS s + Sat.ForStat init p step body -> identsS init ++ identsE p ++ identsS step ++ identsS body Sat.ForInStat _ i e s -> [i] ++ identsE e ++ identsS s Sat.SwitchStat e xs s -> identsE e ++ concatMap traverseCase xs ++ identsS s where traverseCase (e,s) = identsE e ++ identsS s @@ -54,10 +55,11 @@ identsS = \case Sat.BlockStat xs -> concatMap identsS xs Sat.ApplStat e es -> identsE e ++ concatMap identsE es Sat.UOpStat _op e -> identsE e - Sat.AssignStat e1 e2 -> identsE e1 ++ identsE e2 + Sat.AssignStat e1 _op e2 -> identsE e1 ++ identsE e2 Sat.LabelStat _l s -> identsS s Sat.BreakStat{} -> [] Sat.ContinueStat{} -> [] + Sat.FuncStat i args body -> [i] ++ args ++ identsS body {-# INLINE identsE #-} identsE :: Sat.JExpr -> [Ident] @@ -148,6 +150,8 @@ jmcompos ret app f' v = ReturnStat i -> ret ReturnStat `app` f i IfStat e s s' -> ret IfStat `app` f e `app` f s `app` f s' WhileStat b e s -> ret (WhileStat b) `app` f e `app` f s + ForStat init p step body -> ret ForStat `app` f init `app` f p + `app` f step `app` f body ForInStat b i e s -> ret (ForInStat b) `app` f i `app` f e `app` f s SwitchStat e l d -> ret SwitchStat `app` f e `app` l' `app` f d where l' = mapM' (\(c,s) -> ret (,) `app` f c `app` f s) l @@ -158,6 +162,7 @@ jmcompos ret app f' v = AssignStat e e' -> ret AssignStat `app` f e `app` f e' UnsatBlock _ -> ret v' ContinueStat l -> ret (ContinueStat l) + FuncStat i args body -> ret FuncStat `app` f i `app` mapM' f args `app` f body BreakStat l -> ret (BreakStat l) LabelStat l s -> ret (LabelStat l) `app` f s JMGExpr v' -> ret JMGExpr `app` case v' of @@ -217,7 +222,6 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) -------------------------------------------------------------------------------- -- Translation -- --- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- satJStat :: JStat -> Sat.JStat satJStat = witness . proof @@ -229,6 +233,9 @@ satJStat = witness . proof witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) + witness (ForStat init p step body) = Sat.ForStat + (witness init) (satJExpr p) + (witness step) (witness body) witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i (satJExpr iter) (witness body) @@ -240,12 +247,13 @@ satJStat = witness . proof witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) + witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) Sat.AssignOp (satJExpr rhs) witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) witness (BreakStat Nothing) = Sat.BreakStat Nothing witness (BreakStat (Just l)) = Sat.BreakStat $! Just l witness (ContinueStat Nothing) = Sat.ContinueStat Nothing witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l + witness (FuncStat i args body) = Sat.FuncStat i args (witness body) witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" ===================================== compiler/GHC/JS/Unsat/Syntax.hs ===================================== @@ -146,6 +146,7 @@ data JStat | ReturnStat JExpr -- ^ Return | IfStat JExpr JStat JStat -- ^ If | WhileStat Bool JExpr JStat -- ^ While, bool is "do" when True + | ForStat JStat JExpr JStat JStat -- ^ For | ForInStat Bool Ident JExpr JStat -- ^ For-in, bool is "each' when True | SwitchStat JExpr [(JExpr, JStat)] JStat -- ^ Switch | TryStat JStat Ident JStat JStat -- ^ Try @@ -157,6 +158,7 @@ data JStat | LabelStat JsLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic | BreakStat (Maybe JsLabel) -- ^ Break | ContinueStat (Maybe JsLabel) -- ^ Continue + | FuncStat !Ident [Ident] JStat -- ^ an explicit function definition deriving (Eq, Typeable, Generic) -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -408,17 +408,11 @@ mkApplyArr = mconcat [ TxtI "h$apply" ||= toJExpr (JList []) , TxtI "h$paps" ||= toJExpr (JList []) , ApplStat (var "h$initStatic" .^ "push") - [ ValExpr $ JFunc [] $ jVar \i -> mconcat - [ i |= zero_ - , WhileStat False (i .<. Int 65536) $ mconcat - [ var "h$apply" .! i |= var "h$ap_gen" - , preIncrS i - ] - , i |= zero_ - , WhileStat False (i .<. Int 128) $ mconcat - [ var "h$paps" .! i |= var "h$pap_gen" - , preIncrS i - ] + [ ValExpr $ JFunc [] $ mconcat + [ jFor (|= zero_) (.<. Int 65536) preIncrS + (\j -> var "h$apply" .! j |= var "h$ap_gen") + , jFor (|= zero_) (.<. Int 128) preIncrS + (\j -> var "h$paps" .! j |= var "h$pap_gen") , mconcat (map assignSpec applySpec) , mconcat (map assignPap specPap) ] ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -16,6 +16,7 @@ import GHC.JS.Ppr import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import GHC.JS.Optimizer import GHC.StgToJS.Arg import GHC.StgToJS.Sinker @@ -133,10 +134,10 @@ genUnits m ss spt_entries foreign_stubs = do glbl <- State.gets gsGlobal staticInit <- initStaticPtrs spt_entries - let stat = ( -- O.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m 1) - $ mconcat (reverse glbl) <> staticInit) + let stat = ( jsOptimize + . satJStat + . jsSaturate (Just $ modulePrefix m 1) + $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] let oi = ObjUnit { oiSymbols = syms @@ -208,7 +209,9 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsOptimize + . satJStat + $ jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -245,10 +248,10 @@ genUnits m ss spt_entries foreign_stubs = do let allDeps = collectIds unf decl topDeps = collectTopIds decl required = hasExport decl - stat = -- Opt.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m n) - $ mconcat (reverse extraTl) <> tl + stat = jsOptimize + . satJStat + . jsSaturate (Just $ modulePrefix m n) + $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps let oi = ObjUnit { oiSymbols = syms @@ -308,15 +311,15 @@ genSetConInfo i d l {- srt -} = do (fixedLayout $ map uTypeVt fields) (CICon $ dataConTag d) sr - return (ei ||= mkDataEntry) + return (mkDataEntry ei) where -- dataConRepArgTys sometimes returns unboxed tuples. is that a bug? fields = concatMap (map primRepToType . typePrimRep . unwrapType . scaledThing) (dataConRepArgTys d) -- concatMap (map slotTyToType . repTypeSlots . repType) (dataConRepArgTys d) -mkDataEntry :: JExpr -mkDataEntry = ValExpr $ JFunc [] returnStack +mkDataEntry :: Ident -> JStat +mkDataEntry i = FuncStat i [] returnStack genToplevelRhs :: Id -> CgStgRhs -> G JStat -- general cases: ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -240,7 +240,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) = body <- genBody ctx R1 args body typ ei@(TxtI eii) <- identForEntryId i sr <- genStaticRefsRhs rhs - let f = JFunc [] (bh <> lvs <> body) + let f = (bh <> lvs <> body) emitClosureInfo $ ClosureInfo ei (CIRegs 0 $ concatMap idVt args) @@ -249,7 +249,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) = map (stackSlotType . fst) (ctxLneFrameVars ctx)) CIStackFrame sr - emitToplevel (ei ||= toJExpr f) + emitToplevel (jFunction ei [] f) genEntryLne ctx i (StgRhsCon cc con _mu _ticks args _typ) = resetSlots $ do let payloadSize = ctxLneFrameSize ctx ei@(TxtI _eii) <- identForEntryId i @@ -258,8 +258,7 @@ genEntryLne ctx i (StgRhsCon cc con _mu _ticks args _typ) = resetSlots $ do p <- popLneFrame True payloadSize ctx args' <- concatMapM genArg args ac <- allocCon ii con cc args' - emitToplevel (ei ||= toJExpr (JFunc [] - (mconcat [decl ii, p, ac, r1 |= toJExpr ii, returnStack]))) + emitToplevel (jFunction ei [] (mconcat [decl ii, p, ac, r1 |= toJExpr ii, returnStack])) -- | Generate the entry function for a local closure genEntry :: HasDebugCallStack => ExprCtx -> Id -> CgStgRhs -> G () @@ -283,7 +282,7 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) = (fixedLayout $ map (uTypeVt . idType) live) et sr - emitToplevel (ei ||= toJExpr (JFunc [] (mconcat [ll, llv, upd, setcc, body]))) + emitToplevel (jFunction ei [] (mconcat [ll, llv, upd, setcc, body])) where entryCtx = ctxSetTarget [] (ctxClearLneFrame ctx) @@ -630,7 +629,7 @@ genRet ctx e at as l = freshIdent >>= f ++ if prof then [ObjV] else map stackSlotType lneVars) CIStackFrame sr - emitToplevel $ r ||= toJExpr (JFunc [] fun') + emitToplevel $ jFunction r [] fun' return (pushLne <> saveCCS <> pushRet) fst3 ~(x,_,_) = x ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -30,6 +30,7 @@ import Prelude import GHC.Platform.Host (hostPlatformArchOS) import GHC.JS.Make +import GHC.JS.Optimizer import GHC.JS.Unsat.Syntax import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform @@ -43,11 +44,11 @@ import GHC.Linker.Static.Utils (exeFileName) import GHC.StgToJS.Linker.Types import GHC.StgToJS.Linker.Utils +import GHC.StgToJS.Linker.Opt import GHC.StgToJS.Rts.Rts import GHC.StgToJS.Object import GHC.StgToJS.Types hiding (LinkableUnit) import GHC.StgToJS.Symbols -import GHC.StgToJS.Printer import GHC.StgToJS.Arg import GHC.StgToJS.Closure @@ -332,7 +333,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | --- Module : GHC.StgToJS.Printer +-- Module : GHC.StgToJS.Linker.Opt -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file LICENSE) -- @@ -13,15 +13,14 @@ -- Sylvain Henry -- Stability : experimental -- --- Custom prettyprinter for JS AST uses the JS PPr module for most of --- the work +-- Optimization pass at link time +-- -- -- ----------------------------------------------------------------------------- -module GHC.StgToJS.Printer +module GHC.StgToJS.Linker.Opt ( pretty , ghcjsRenderJs - , prettyBlock ) where @@ -93,8 +92,7 @@ hexDoc v = text $ go v -- attempt to resugar some of the common constructs ghcjsRenderJsS :: RenderJs -> JStat -> Doc -ghcjsRenderJsS r (BlockStat xs) = prettyBlock r (flattenBlocks xs) -ghcjsRenderJsS r s = renderJsS defaultRenderJs r s +ghcjsRenderJsS r s = renderJsS defaultRenderJs r s -- don't quote keys in our object literals, so closure compiler works ghcjsRenderJsV :: RenderJs -> JVal -> Doc @@ -120,97 +118,3 @@ ghcjsRenderJsV r (JHash m) validOtherIdent c = isAlpha c || isDigit c ghcjsRenderJsV r v = renderJsV defaultRenderJs r v - -prettyBlock :: RenderJs -> [JStat] -> Doc -prettyBlock r xs = vcat $ map addSemi (prettyBlock' r xs) - --- recognize common patterns in a block and convert them to more idiomatic/concise javascript -prettyBlock' :: RenderJs -> [JStat] -> [Doc] --- return/... -prettyBlock' r ( x@(ReturnStat _) - : xs - ) - | not (null xs) - = prettyBlock' r [x] --- declare/assign -prettyBlock' r ( (DeclStat i Nothing) - : (AssignStat (ValExpr (JVar i')) v) - : xs - ) - | i == i' - = prettyBlock' r (DeclStat i (Just v) : xs) - --- resugar for loops with/without var declaration -prettyBlock' r ( (DeclStat i (Just v0)) - : (WhileStat False p (BlockStat bs)) - : xs - ) - | not (null flat) && isForUpdStat (last flat) - = mkFor r True i v0 p (last flat) (init flat) : prettyBlock' r xs - where - flat = flattenBlocks bs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) v0) - : (WhileStat False p (BlockStat bs)) - : xs - ) - | not (null flat) && isForUpdStat (last flat) - = mkFor r False i v0 p (last flat) (init flat) : prettyBlock' r xs - where - flat = flattenBlocks bs - --- global function (does not preserve semantics but works for GHCJS) -prettyBlock' r ( (DeclStat i (Just (ValExpr (JFunc is b)))) - : xs - ) - = (hangBrace (text "function" <+> jsToDocR r i <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) - (jsToDocR r b) - ) : prettyBlock' r xs --- modify/assign operators -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) (ValExpr (JInt 1)))) - : xs - ) - | i == i' = (text "++" <> jsToDocR r i) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr SubOp (ValExpr (JVar i')) (ValExpr (JInt 1)))) - : xs - ) - | i == i' = (text "--" <> jsToDocR r i) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) e)) - : xs - ) - | i == i' = (jsToDocR r i <+> text "+=" <+> jsToDocR r e) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr SubOp (ValExpr (JVar i')) e)) - : xs - ) - | i == i' = (jsToDocR r i <+> text "-=" <+> jsToDocR r e) : prettyBlock' r xs - - -prettyBlock' r (x:xs) = jsToDocR r x : prettyBlock' r xs -prettyBlock' _ [] = [] - --- build the for block -mkFor :: RenderJs -> Bool -> Ident -> JExpr -> JExpr -> JStat -> [JStat] -> Doc -mkFor r decl i v0 p s1 sb = hangBrace (text "for" <> forCond) - (jsToDocR r $ BlockStat sb) - where - c0 | decl = text "var" <+> jsToDocR r i <+> char '=' <+> jsToDocR r v0 - | otherwise = jsToDocR r i <+> char '=' <+> jsToDocR r v0 - forCond = parens $ hcat $ interSemi - [ c0 - , jsToDocR r p - , parens (jsToDocR r s1) - ] - --- check if a statement is suitable to be converted to something in the for(;;x) position -isForUpdStat :: JStat -> Bool -isForUpdStat UOpStat {} = True -isForUpdStat AssignStat {} = True -isForUpdStat ApplStat {} = True -isForUpdStat _ = False - -interSemi :: [Doc] -> [Doc] -interSemi [] = [PP.empty] -interSemi [s] = [s] -interSemi (x:xs) = x <> text ";" : interSemi xs - -addSemi :: Doc -> Doc -addSemi x = x <> text ";" ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -408,31 +408,35 @@ instance Binary Sat.JStat where put_ bh (Sat.ReturnStat e) = putByte bh 2 >> put_ bh e put_ bh (Sat.IfStat e s1 s2) = putByte bh 3 >> put_ bh e >> put_ bh s1 >> put_ bh s2 put_ bh (Sat.WhileStat b e s) = putByte bh 4 >> put_ bh b >> put_ bh e >> put_ bh s - put_ bh (Sat.ForInStat b i e s) = putByte bh 5 >> put_ bh b >> put_ bh i >> put_ bh e >> put_ bh s - put_ bh (Sat.SwitchStat e ss s) = putByte bh 6 >> put_ bh e >> put_ bh ss >> put_ bh s - put_ bh (Sat.TryStat s1 i s2 s3) = putByte bh 7 >> put_ bh s1 >> put_ bh i >> put_ bh s2 >> put_ bh s3 - put_ bh (Sat.BlockStat xs) = putByte bh 8 >> put_ bh xs - put_ bh (Sat.ApplStat e es) = putByte bh 9 >> put_ bh e >> put_ bh es - put_ bh (Sat.UOpStat o e) = putByte bh 10 >> put_ bh o >> put_ bh e - put_ bh (Sat.AssignStat e1 e2) = putByte bh 11 >> put_ bh e1 >> put_ bh e2 - put_ bh (Sat.LabelStat l s) = putByte bh 12 >> put_ bh l >> put_ bh s - put_ bh (Sat.BreakStat ml) = putByte bh 13 >> put_ bh ml - put_ bh (Sat.ContinueStat ml) = putByte bh 14 >> put_ bh ml + put_ bh (Sat.ForStat is c s bd) = putByte bh 5 >> put_ bh is >> put_ bh c >> put_ bh s >> put_ bh bd + put_ bh (Sat.ForInStat b i e s) = putByte bh 6 >> put_ bh b >> put_ bh i >> put_ bh e >> put_ bh s + put_ bh (Sat.SwitchStat e ss s) = putByte bh 7 >> put_ bh e >> put_ bh ss >> put_ bh s + put_ bh (Sat.TryStat s1 i s2 s3) = putByte bh 8 >> put_ bh s1 >> put_ bh i >> put_ bh s2 >> put_ bh s3 + put_ bh (Sat.BlockStat xs) = putByte bh 9 >> put_ bh xs + put_ bh (Sat.ApplStat e es) = putByte bh 10 >> put_ bh e >> put_ bh es + put_ bh (Sat.UOpStat o e) = putByte bh 11 >> put_ bh o >> put_ bh e + put_ bh (Sat.AssignStat e1 op e2) = putByte bh 12 >> put_ bh e1 >> put_ bh op >> put_ bh e2 + put_ bh (Sat.LabelStat l s) = putByte bh 13 >> put_ bh l >> put_ bh s + put_ bh (Sat.BreakStat ml) = putByte bh 14 >> put_ bh ml + put_ bh (Sat.ContinueStat ml) = putByte bh 15 >> put_ bh ml + put_ bh (Sat.FuncStat i is b) = putByte bh 16 >> put_ bh i >> put_ bh is >> put_ bh b get bh = getByte bh >>= \case 1 -> Sat.DeclStat <$> get bh <*> get bh 2 -> Sat.ReturnStat <$> get bh 3 -> Sat.IfStat <$> get bh <*> get bh <*> get bh 4 -> Sat.WhileStat <$> get bh <*> get bh <*> get bh - 5 -> Sat.ForInStat <$> get bh <*> get bh <*> get bh <*> get bh - 6 -> Sat.SwitchStat <$> get bh <*> get bh <*> get bh - 7 -> Sat.TryStat <$> get bh <*> get bh <*> get bh <*> get bh - 8 -> Sat.BlockStat <$> get bh - 9 -> Sat.ApplStat <$> get bh <*> get bh - 10 -> Sat.UOpStat <$> get bh <*> get bh - 11 -> Sat.AssignStat <$> get bh <*> get bh - 12 -> Sat.LabelStat <$> get bh <*> get bh - 13 -> Sat.BreakStat <$> get bh - 14 -> Sat.ContinueStat <$> get bh + 5 -> Sat.ForStat <$> get bh <*> get bh <*> get bh <*> get bh + 6 -> Sat.ForInStat <$> get bh <*> get bh <*> get bh <*> get bh + 7 -> Sat.SwitchStat <$> get bh <*> get bh <*> get bh + 8 -> Sat.TryStat <$> get bh <*> get bh <*> get bh <*> get bh + 9 -> Sat.BlockStat <$> get bh + 10 -> Sat.ApplStat <$> get bh <*> get bh + 11 -> Sat.UOpStat <$> get bh <*> get bh + 12 -> Sat.AssignStat <$> get bh <*> get bh <*> get bh + 13 -> Sat.LabelStat <$> get bh <*> get bh + 14 -> Sat.BreakStat <$> get bh + 15 -> Sat.ContinueStat <$> get bh + 16 -> Sat.FuncStat <$> get bh <*> get bh <*> get bh n -> error ("Binary get bh JStat: invalid tag: " ++ show n) @@ -541,6 +545,10 @@ instance Binary Sat.UOp where put_ bh = putEnum bh get bh = getEnum bh +instance Binary Sat.AOp where + put_ bh = putEnum bh + get bh = getEnum bh + -- 16 bit sizes should be enough... instance Binary CILayout where put_ bh CILayoutVariable = putByte bh 1 ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,16 +30,18 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import GHC.JS.Optimizer import GHC.StgToJS.Apply import GHC.StgToJS.Closure import GHC.StgToJS.Heap -import GHC.StgToJS.Printer import GHC.StgToJS.Profiling import GHC.StgToJS.Regs import GHC.StgToJS.Types import GHC.StgToJS.Stack +import GHC.StgToJS.Linker.Opt + import GHC.Data.FastString import GHC.Types.Unique.Map @@ -134,7 +136,7 @@ closureConstructors s = BlockStat | otherwise = mempty mkClosureCon :: Maybe Int -> JStat - mkClosureCon n0 = funName ||= toJExpr fun + mkClosureCon n0 = jFunction funName args funBod where n | Just n' <- n0 = n' | Nothing <- n0 = 0 @@ -142,7 +144,6 @@ closureConstructors s = BlockStat | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] args = TxtI "f" : addCCArg' (map varName [1..n]) - fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- @@ -157,12 +158,12 @@ closureConstructors s = BlockStat ] mkDataFill :: Int -> JStat - mkDataFill n = funName ||= toJExpr fun + mkDataFill n = jFunction funName (map TxtI ds) body where funName = TxtI $ dataName n ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds - fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) + body = (checkD <> returnS extra_args) -- | JS Payload to perform stack manipulation in the RTS stackManip :: JStat @@ -172,10 +173,10 @@ stackManip = mconcat (map mkPush [1..32]) <> mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) as = map varName [1..n] - fun = JFunc as ((sp |= sp + toJExpr n) - <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) - [1..] as)) - in funName ||= toJExpr fun + body = ((sp |= sp + toJExpr n) + <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) + [1..] as)) + in jFunction funName as body -- partial pushes, based on bitmap, increases Sp by highest bit mkPpush :: Integer -> JStat @@ -185,11 +186,10 @@ stackManip = mconcat (map mkPush [1..32]) <> n = length bits h = last bits args = map varName [1..n] - fun = JFunc args $ - mconcat [ sp |= sp + toJExpr (h+1) - , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) - ] - in funName ||= toJExpr fun + body = mconcat [ sp |= sp + toJExpr (h+1) + , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) + ] + in jFunction funName args body bitsIdx :: Integer -> [Int] bitsIdx n | n < 0 = error "bitsIdx: negative" @@ -244,12 +244,12 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map varName [1..n] - assign = zipWith (\a r -> toJExpr r |= toJExpr a) - args (reverse $ take n regsFromR1) - fname = TxtI $ mkFastString ("h$l" ++ show n) - fun = JFunc args (mconcat assign) - in fname ||= toJExpr fun + mkLoad n = let args = map varName [1..n] + body = mconcat $ + zipWith (\a r -> toJExpr r |= toJExpr a) + args (reverse $ take n regsFromR1) + fname = TxtI $ mkFastString ("h$l" ++ show n) + in jFunction fname args body -- | Assign registers R1 ... Rn in descending order, that is assign Rn first. -- This function uses the 'assignRegs'' array to construct functions which set @@ -314,11 +314,11 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . jsOptimize . satJStat . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty . jsOptimize . satJStat $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' rts :: StgToJSConfig -> JStat ===================================== compiler/ghc.cabal.in ===================================== @@ -532,6 +532,7 @@ Library GHC.IfaceToCore GHC.Iface.Type GHC.JS.Make + GHC.JS.Optimizer GHC.JS.Ppr GHC.JS.Syntax GHC.JS.Transform @@ -672,7 +673,6 @@ Library GHC.StgToJS.Object GHC.StgToJS.Prim GHC.StgToJS.Profiling - GHC.StgToJS.Printer GHC.StgToJS.Regs GHC.StgToJS.Rts.Types GHC.StgToJS.Rts.Rts @@ -686,6 +686,7 @@ Library GHC.StgToJS.Linker.Linker GHC.StgToJS.Linker.Types GHC.StgToJS.Linker.Utils + GHC.StgToJS.Linker.Opt GHC.Stg.Unarise GHC.SysTools GHC.SysTools.Ar ===================================== testsuite/tests/javascript/opt/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests for the JS backend optimizer +setTestOpts(when(not(js_arch()),skip)) + +test('deadCodeElim', normal, compile_and_run, ['-package ghc']) ===================================== testsuite/tests/javascript/opt/deadCodeElim.hs ===================================== @@ -0,0 +1,96 @@ + +import GHC.JS.Optimizer +import GHC.JS.Syntax +import GHC.JS.Unsat.Syntax (Ident (..)) + +import GHC.Data.FastString + +double_return :: JStat +double_return = BlockStat [ ReturnStat (SatInt 0) + , ReturnStat (SatInt 1) + ] + +double_return_opt :: JStat +double_return_opt = (BlockStat [ReturnStat (SatInt 0)]) + +in_func :: JStat +in_func = AssignStat (jvar (fsLit "foo")) AssignOp (ValExpr (JFunc [] double_return)) + +in_func_opt :: JStat +in_func_opt = AssignStat (jvar (fsLit "foo")) AssignOp (ValExpr (JFunc [] double_return_opt)) + +nested_blocks :: JStat +nested_blocks = BlockStat [ double_return <> double_return + , double_return + ] <> double_return + +nested_blocks_opt :: JStat +nested_blocks_opt = double_return_opt + +global_func :: JStat +global_func = FuncStat (TxtI (fsLit "bar")) [] double_return + +global_func_opt :: JStat +global_func_opt = FuncStat (TxtI (fsLit "bar")) [] double_return_opt + +func_with_locals :: JStat +func_with_locals = AssignStat (jvar (fsLit "foo")) + AssignOp + (ValExpr (JFunc [] + (BlockStat [ AssignStat (jvar (fsLit "one")) AssignOp (SatInt 2) + , AssignStat (jvar (fsLit "two")) AssignOp (SatInt 3) + , ApplStat (jvar (fsLit "f")) [(SatInt 100)] + , ReturnStat (SatInt 0) + , ReturnStat (SatInt 1) + ]))) + +func_with_locals_opt :: JStat +func_with_locals_opt = AssignStat (jvar (fsLit "foo")) + AssignOp + (ValExpr (JFunc [] + (BlockStat [ AssignStat (jvar (fsLit "one")) AssignOp (SatInt 2) + , AssignStat (jvar (fsLit "two")) AssignOp (SatInt 3) + , ApplStat (jvar (fsLit "f")) [(SatInt 100)] + , ReturnStat (SatInt 0) + ]))) + +-- This one comes straight from MR10260 where we noticed the optimizer was not catching the redundant return +bignum_test :: JStat +bignum_test = DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + , ReturnStat (ApplExpr (jvar $ fsLit "h$rs") [])])) + +bignum_test_opt :: JStat +bignum_test_opt = + DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + ])) + +bignum_test_2 :: JStat +bignum_test_2 = BlockStat [FuncStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99") [] (BlockStat [DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + , ReturnStat (ApplExpr (jvar $ fsLit "h$rs") [])]))])] + +bignum_test_opt_2 :: JStat +bignum_test_opt_2 = BlockStat [FuncStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99") [] (BlockStat [DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + ]))])] + +main :: IO () +main = mapM_ print + [ jsOptimize double_return == double_return_opt + , jsOptimize in_func == in_func_opt + , jsOptimize nested_blocks == nested_blocks_opt + , jsOptimize global_func == global_func_opt + , jsOptimize func_with_locals == func_with_locals_opt + , jsOptimize bignum_test == bignum_test_opt + , jsOptimize bignum_test_2 == bignum_test_opt_2 + ] ===================================== testsuite/tests/javascript/opt/deadCodeElim.stdout ===================================== @@ -0,0 +1,7 @@ +True +True +True +True +True +True +True ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -7,7 +7,7 @@ ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:3993:49: Note [Eta-reduction in -O0] +ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice] ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices] @@ -15,6 +15,7 @@ ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constr ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -25,14 +26,14 @@ ref compiler/GHC/Tc/Gen/HsType.hs:2621:7: Note [Matching a kind signature ref compiler/GHC/Tc/Gen/Pat.hs:176:20: Note [Typing patterns in pattern bindings] ref compiler/GHC/Tc/Gen/Pat.hs:1127:7: Note [Matching polytyped patterns] ref compiler/GHC/Tc/Gen/Sig.hs:81:10: Note [Overview of type signatures] -ref compiler/GHC/Tc/Gen/Splice.hs:357:16: Note [How brackets and nested splices are handled] -ref compiler/GHC/Tc/Gen/Splice.hs:532:35: Note [PendingRnSplice] -ref compiler/GHC/Tc/Gen/Splice.hs:656:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/Tc/Gen/Splice.hs:889:11: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:356:16: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:531:35: Note [PendingRnSplice] +ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1120:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics] @@ -46,8 +47,8 @@ ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threa ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] ref testsuite/config/ghc:272:10: Note [WayFlags] -ref testsuite/driver/testlib.py:160:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:164:2: Note [Why is there no stage1 setup function?] +ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] +ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64064cfee57161bb42ef5c17bbe434185893ee5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64064cfee57161bb42ef5c17bbe434185893ee5f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 22:40:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 18:40:53 -0400 Subject: [Git][ghc/ghc][master] Add a regression test for #21050 Message-ID: <645acbf580692_38ffdad701e3c013914ba@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - 3 changed files: - + testsuite/tests/th/T21050.hs - + testsuite/tests/th/T21050.stderr - testsuite/tests/th/all.T Changes: ===================================== testsuite/tests/th/T21050.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell, ImpredicativeTypes #-} +module T21050 where + +import Language.Haskell.TH.Syntax + +data T = MkT (forall a. a) + +f x = [|| MkT $$(x) ||] + +g :: Code Q (forall a. a) -> Code Q T +g x = [|| MkT $$(x) ||] ===================================== testsuite/tests/th/T21050.stderr ===================================== @@ -0,0 +1,26 @@ + +T21050.hs:8:18: error: [GHC-25897] + • Couldn't match expected type ‘Code m a1’ with actual type ‘p’ + ‘p’ is a rigid type variable bound by + the inferred type of f :: Quote m => p -> Code m T + at T21050.hs:8:1-23 + • In the expression: x + In the Template Haskell splice $$(x) + In the first argument of ‘MkT’, namely ‘$$(x)’ + • Relevant bindings include + x :: p (bound at T21050.hs:8:3) + f :: p -> Code m T (bound at T21050.hs:8:1) + +T21050.hs:11:18: error: [GHC-91028] + • Couldn't match type ‘a’ with ‘forall a2. a2’ + Expected: Code Q a + Actual: Code Q (forall a. a) + Cannot equate type variable ‘a’ + with a type involving polytypes: forall a2. a2 + ‘a’ is a rigid type variable bound by + a type expected by the context: + forall a. a + at T21050.hs:11:15-19 + • In the expression: x + In the Template Haskell splice $$(x) + In the first argument of ‘MkT’, namely ‘$$(x)’ ===================================== testsuite/tests/th/all.T ===================================== @@ -564,3 +564,4 @@ test('TH_typed2', normal, compile_and_run, ['']) test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed5', normal, compile_and_run, ['']) +test('T21050', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6738c01d6175c5701e5c53e2ae6716d1103f7355 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6738c01d6175c5701e5c53e2ae6716d1103f7355 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 22:41:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 18:41:34 -0400 Subject: [Git][ghc/ghc][master] nonmoving: Account for mutator allocations in bytes_allocated Message-ID: <645acc1ec2da5_38ffdad7a59b3c1396669@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 3 changed files: - rts/sm/NonMovingAllocate.c - rts/sm/Storage.c - rts/sm/Storage.h Changes: ===================================== rts/sm/NonMovingAllocate.c ===================================== @@ -253,5 +253,9 @@ void *nonmovingAllocateGC(Capability *cap, StgWord sz) GNUC_ATTR_HOT void *nonmovingAllocate(Capability *cap, StgWord sz) { + // Handle "bytes allocated" accounting in the same way we + // do in Storage.c:allocate. See #23312. + accountAllocation(cap, sz); + cap->total_allocated += sz; return nonmovingAllocate_(SM_LOCK, cap, sz); } ===================================== rts/sm/Storage.c ===================================== @@ -966,7 +966,7 @@ move_STACK (StgStack *src, StgStack *dest) dest->sp = (StgPtr)dest->sp + diff; } -STATIC_INLINE void +void accountAllocation(Capability *cap, W_ n) { TICK_ALLOC_HEAP_NOCTR(WDS(n)); ===================================== rts/sm/Storage.h ===================================== @@ -125,6 +125,8 @@ StgWord genLiveBlocks (generation *gen); StgWord calcTotalLargeObjectsW (void); StgWord calcTotalCompactW (void); +void accountAllocation(Capability *cap, W_ n); + /* ---------------------------------------------------------------------------- Storage manager internal APIs and globals ------------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2cdb7dacc095142e29c0f28a956b7fa97cdb4b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2cdb7dacc095142e29c0f28a956b7fa97cdb4b1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 23:12:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 19:12:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt Message-ID: <645ad37a4decc_38ffdadb5191b4141430@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - c6673873 by Sven Tennie at 2023-05-09T19:12:30-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - d137ce9c by konsumlamm at 2023-05-09T19:12:34-04:00 Make `(&)` representation polymorphic in the return type - - - - - 27 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/ghc.cabal.in - libraries/base/Data/Function.hs - libraries/base/changelog.md - rts/sm/NonMovingAllocate.c - rts/sm/Storage.c - rts/sm/Storage.h - + testsuite/tests/javascript/opt/all.T - + testsuite/tests/javascript/opt/deadCodeElim.hs - + testsuite/tests/javascript/opt/deadCodeElim.stdout - testsuite/tests/linters/notes.stdout - + testsuite/tests/th/T21050.hs - + testsuite/tests/th/T21050.stderr - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -32,9 +32,9 @@ import Data.Maybe (fromMaybe) import GHC.Stack --- | TODO: verify this! -stackFrameHeaderSize :: Platform -> Int -stackFrameHeaderSize _ = 64 +-- | LR and FP (8 byte each) are the prologue of each stack frame +stackFrameHeaderSize :: Int +stackFrameHeaderSize = 2 * 8 -- | All registers are 8 byte wide. spillSlotSize :: Int @@ -49,14 +49,13 @@ stackAlign = 16 maxSpillSlots :: NCGConfig -> Int maxSpillSlots config -- = 0 -- set to zero, to see when allocMoreStack has to fire. - = let platform = ncgPlatform config - in ((ncgSpillPreallocSize config - stackFrameHeaderSize platform) + = ((ncgSpillPreallocSize config - stackFrameHeaderSize) `div` spillSlotSize) - 1 -- | Convert a spill slot number to a *byte* offset, with no sign. spillSlotToOffset :: NCGConfig -> Int -> Int -spillSlotToOffset config slot - = stackFrameHeaderSize (ncgPlatform config) + spillSlotSize * slot +spillSlotToOffset _ slot + = stackFrameHeaderSize + spillSlotSize * slot -- | Get the registers that are being used by this instruction. -- regUsage doesn't need to do any trickery for jumps and such. ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -83,7 +83,7 @@ module GHC.JS.Make -- $intro_funcs , var , jString - , jLam, jVar, jFor, jForIn, jForEachIn, jTryCatchFinally + , jLam, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally -- * Combinators -- $combinators , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!) @@ -253,7 +253,7 @@ jLam f = ValExpr . UnsatVal . IS $ do -- of the enclosed expression. The result is a block statement. -- Usage: -- --- @jVar $ \x y -> mconcat [jVar x ||= one_, jVar y ||= two_, jVar x + jVar y]@ +-- @jVar $ \x y -> mconcat [x ||= one_, y ||= two_, x + y]@ jVar :: ToSat a => a -> JStat jVar f = UnsatBlock . IS $ do (block, is) <- runIdentSupply $ toSat_ f [] @@ -262,6 +262,9 @@ jVar f = UnsatBlock . IS $ do addDecls x = x return $ addDecls block +jFunction :: Ident -> [Ident] -> JStat -> JStat +jFunction name args body = FuncStat name args body + -- | Create a 'for in' statement. -- Usage: -- @@ -279,6 +282,23 @@ jForEachIn e f = UnsatBlock . IS $ do let i = head is return $ decl i `mappend` ForInStat True i e block +-- | Create a 'for' statement given a function for initialization, a predicate +-- to step to, a step and a body +-- Usage: +-- +-- @ jFor (|= zero_) (.<. Int 65536) preIncrS +-- (\j -> ...something with the counter j...)@ +-- +jFor :: (JExpr -> JStat) + -> (JExpr -> JExpr) + -> (JExpr -> JStat) + -> (JExpr -> JStat) + -> JStat +jFor init pred step body = jVar $ \i -> ForStat (init i) (pred i) (step i) (body i) + +jForNoDecl :: Ident -> JExpr -> JExpr -> JStat -> JStat -> JStat +jForNoDecl i initial p step body = ForStat (toJExpr i |= initial) p step body + -- | As with "jForIn" but creating a \"for each in\" statement. jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat jTryCatchFinally s f s2 = UnsatBlock . IS $ do @@ -294,13 +314,6 @@ var = ValExpr . JVar . TxtI jString :: FastString -> JExpr jString = toJExpr --- | Create a 'for' statement -jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat -jFor before p after b = BlockStat [before, WhileStat False (toJExpr p) b'] - where b' = case toStat b of - BlockStat xs -> BlockStat $ xs ++ [after] - x -> BlockStat [x,after] - -- | construct a js declaration with the given identifier decl :: Ident -> JStat decl i = DeclStat i Nothing ===================================== compiler/GHC/JS/Optimizer.hs ===================================== @@ -0,0 +1,271 @@ +{-# LANGUAGE LambdaCase #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.JS.Optimizer +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Jeffrey Young +-- Luite Stegeman +-- Sylvain Henry +-- Josh Meredith +-- Stability : experimental +-- +-- +-- * Domain and Purpose +-- +-- GHC.JS.Optimizer is a shallow embedding of a peephole optimizer. That is, +-- this module defines transformations over the JavaScript IR in +-- 'GHC.JS.Syntax', transforming the IR forms from inefficient, or +-- non-idiomatic, JavaScript to more efficient and idiomatic JavaScript. The +-- optimizer is written in continuation passing style so optimizations +-- compose. +-- +-- * Architecture of the optimizer +-- +-- The design is that each optimization pattern matches on the head of a +-- block by pattern matching onto the head of the stream of nodes in the +-- JavaScript IR. If an optimization gets a successful match then it performs +-- whatever rewrite is necessary and then calls the 'loop' continuation. This +-- ensures that the result of the optimization is subject to the same +-- optimization, /and/ the rest of the optimizations. If there is no match +-- then the optimization should call the 'next' continuation to pass the +-- stream to the next optimization in the optimization chain. We then define +-- the last "optimization" to be @tailLoop@ which selects the next block of +-- code to optimize and begin the optimization pipeline again. +----------------------------------------------------------------------------- +module GHC.JS.Optimizer + ( jsOptimize + ) where + + +import Prelude + +import GHC.JS.Syntax + +import Control.Arrow + +{- +Note [ Unsafe JavaScript Optimizations ] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +There are a number of optimizations that the JavaScript Backend performs that +are not sound with respect to arbritrary JavaScript. We still perform these +optimizations because we are not optimizing arbritrary javascript and under the +assumption that the JavaScript backend will not generate code that violates the +soundness of the optimizer. For example, the @deadCodeElim@ optimization removes +all statements that occur after a 'return' in JavaScript, however this is not +always sound because of hoisting, consider this program: + + function foo() { + var x = 2; + bar(); + return x; + + function bar() { + x = 10; + }} + + which is transformed to: + + function foo() { + var x = 2; + bar(); + return x; + }} + +The optimized form is clearly a program that goes wrong because `bar()` is no +longer defined. But the JavaScript backend will never generate this code, so as +long as that assumption holds we are safe to perform optimizations that would +normally be unsafe. +-} + + +-------------------------------------------------------------------------------- +-- Top level Driver +-------------------------------------------------------------------------------- +jsOptimize :: JStat -> JStat +jsOptimize = go + where + p_opt = jsOptimize + opt = jsOptimize' + e_opt = jExprOptimize + -- base case + go (BlockStat xs) = BlockStat (opt xs) + -- recursive cases + go (ForStat i p s body) = ForStat (go i) (e_opt p) (go s) (p_opt body) + go (ForInStat b i p body) = ForInStat b i p (p_opt body) + go (WhileStat b c body) = WhileStat b (e_opt c) (p_opt body) + go (SwitchStat s ps body) = SwitchStat s (fmap (second go) ps) (p_opt body) + go (FuncStat i args body) = FuncStat i args (p_opt body) + go (IfStat c t e) = IfStat (e_opt c) (p_opt t) (p_opt e) + go (TryStat ths i c f) = TryStat (p_opt ths) i (p_opt c) (p_opt f) + go (LabelStat lbl s) = LabelStat lbl (p_opt s) + -- special case: drive the optimizer into expressions + go (AssignStat id op rhs) = AssignStat (e_opt id) op (e_opt rhs) + go (DeclStat i (Just e)) = DeclStat i (Just $ e_opt e) + go (ReturnStat e) = ReturnStat (e_opt e) + go (UOpStat op e) = UOpStat op (e_opt e) + go (ApplStat f args) = ApplStat (e_opt f) (e_opt <$> args) + -- all else is terminal, we match on these to force a warning in the event + -- another constructor is added + go x at BreakStat{} = x + go x at ContinueStat{} = x + go x at DeclStat{} = x -- match on the nothing case + +jsOptimize' :: [JStat] -> [JStat] +jsOptimize' = runBlockOpt opts . single_pass_opts + where + opts :: BlockOpt + opts = safe_opts + <> unsafe_opts + <> tailLoop -- tailloop must be last, see module description + + unsafe_opts :: BlockOpt + unsafe_opts = mconcat [ deadCodeElim ] + + safe_opts :: BlockOpt + safe_opts = mconcat [ declareAssign, combineOps ] + + single_pass_opts :: BlockTrans + single_pass_opts = runBlockTrans sp_opts + + sp_opts = [flattenBlocks] + +-- | recur over a @JExpr@ and optimize the @JVal at s +jExprOptimize :: JExpr -> JExpr +-- the base case +jExprOptimize (ValExpr val) = ValExpr (jValOptimize val) +-- recursive cases +jExprOptimize (SelExpr obj field) = SelExpr (jExprOptimize obj) field +jExprOptimize (IdxExpr obj ix) = IdxExpr (jExprOptimize obj) (jExprOptimize ix) +jExprOptimize (UOpExpr op exp) = UOpExpr op (jExprOptimize exp) +jExprOptimize (IfExpr c t e) = IfExpr c (jExprOptimize t) (jExprOptimize e) +jExprOptimize (ApplExpr f args ) = ApplExpr (jExprOptimize f) (jExprOptimize <$> args) +jExprOptimize (InfixExpr op l r) = InfixExpr op (jExprOptimize l) (jExprOptimize r) + +-- | drive optimizations to anonymous functions and over expressions +jValOptimize :: JVal -> JVal +-- base case +jValOptimize (JFunc args body) = JFunc args (jsOptimize body) +-- recursive cases +jValOptimize (JList exprs) = JList (jExprOptimize <$> exprs) +jValOptimize (JHash hash) = JHash (jExprOptimize <$> hash) +-- all else is terminal +jValOptimize x at JVar{} = x +jValOptimize x at JDouble{} = x +jValOptimize x at JInt{} = x +jValOptimize x at JStr{} = x +jValOptimize x at JRegEx{} = x + +-- | A block transformation is a function from a stream of syntax to another +-- stream +type BlockTrans = [JStat] -> [JStat] + +-- | A BlockOpt is a function that alters the stream, and a continuation that +-- represents the rest of the stream. The first @BlockTrans@ represents +-- restarting the optimizer after a change has happened. The second @BlockTrans@ +-- represents the rest of the continuation stream. +newtype BlockOpt = BlockOpt (BlockTrans -> BlockTrans -> BlockTrans) + +-- | To merge two BlockOpt we first run the left-hand side optimization and +-- capture the right-hand side in the continuation +instance Semigroup BlockOpt where + BlockOpt opt0 <> BlockOpt opt1 = BlockOpt + $ \loop next -> opt0 loop (opt1 loop next) + +instance Monoid BlockOpt where + -- don't loop, just finalize + mempty = BlockOpt $ \_loop next -> next + +-- | loop until a fixpoint is reached +runBlockOpt :: BlockOpt -> [JStat] -> [JStat] +runBlockOpt (BlockOpt opt) xs = recur xs + where recur = opt recur id + +runBlockTrans :: [BlockTrans] -> [JStat] -> [JStat] +runBlockTrans opts = foldl (.) id opts + +-- | Perform all the optimizations on the tail of a block. +tailLoop :: BlockOpt +tailLoop = BlockOpt $ \loop next -> \case + [] -> next [] + -- this call to jsOptimize is required or else the optimizer will not + -- properly recur down JStat. See the 'deadCodeElim' test for examples which + -- were failing before this change + (x:xs) -> next (jsOptimize x : loop xs) + +-------------------------------------------------------------------------------- +-- Single Slot Optimizations +-------------------------------------------------------------------------------- + +{- | + Catch modify and assign operators: + case 1: + i = i + 1; ==> ++i; + case 2: + i = i - 1; ==> --i; + case 3: + i = i + n; ==> i += n; + case 4: + i = i - n; ==> i -= n; +-} +combineOps :: BlockOpt +combineOps = BlockOpt $ \loop next -> + \case + -- find a op pattern, and rerun the optimizer on its result unless there is + -- nothing to optimize, in which case call the next optimization + (unchanged@(AssignStat + ident@(ValExpr (JVar i)) + AssignOp + (InfixExpr op (ValExpr (JVar i')) e)) : xs) + | i == i' -> case (op, e) of + (AddOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreIncOp ident : xs + (SubOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreDecOp ident : xs + (AddOp, e') -> loop $ AssignStat ident AddAssignOp e' : xs + (SubOp, e') -> loop $ AssignStat ident SubAssignOp e' : xs + _ -> next $ unchanged : xs + -- commutative cases + (unchanged@(AssignStat + ident@(ValExpr (JVar i)) + AssignOp + (InfixExpr op e (ValExpr (JVar i')))) : xs) + | i == i' -> case (op, e) of + (AddOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreIncOp ident : xs + (SubOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreDecOp ident : xs + (AddOp, e') -> loop $ AssignStat ident AddAssignOp e' : xs + (SubOp, e') -> loop $ AssignStat ident SubAssignOp e' : xs + _ -> next $ unchanged : xs + -- general case, we had nothing to optimize in this case so call the next + -- optimization + xs -> next xs + + +-------------------------------------------------------------------------------- +-- Dual Slot Optimizations +-------------------------------------------------------------------------------- +-- | Catch 'var i; i = q;' ==> 'var i = q;' +declareAssign :: BlockOpt +declareAssign = BlockOpt $ + \loop next -> \case + ( (DeclStat i Nothing) + : (AssignStat (ValExpr (JVar i')) AssignOp v) + : xs + ) | i == i' -> loop (DeclStat i (Just v) : xs) + xs -> next xs + +-- | Eliminate all code after a return statement. This is a special case +-- optimization that doesn't need to loop. See Note [Unsafe JavaScript +-- optimizations] +deadCodeElim :: BlockOpt +deadCodeElim = BlockOpt $ + \_loop next -> \case + (x at ReturnStat{}:_) -> next [x] + xs -> next xs + +-- | remove nested blocks +flattenBlocks :: BlockTrans +flattenBlocks (BlockStat y : ys) = flattenBlocks y ++ flattenBlocks ys +flattenBlocks (x:xs) = x : flattenBlocks xs +flattenBlocks [] = [] ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -10,10 +10,46 @@ -- For Outputable instances for JS syntax {-# OPTIONS_GHC -Wno-orphans #-} --- | Pretty-printing JavaScript +----------------------------------------------------------------------------- +-- | +-- Module : GHC.JS.Ppr +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Jeffrey Young +-- Luite Stegeman +-- Sylvain Henry +-- Josh Meredith +-- Stability : experimental +-- +-- +-- * Domain and Purpose +-- +-- GHC.JS.Ppr defines the code generation facilities for the JavaScript +-- backend. That is, this module exports a function from the JS backend IR +-- to JavaScript compliant concrete syntax that can readily be executed by +-- nodejs or called in a browser. +-- +-- * Design +-- +-- This module follows the architecture and style of the other backends in +-- GHC: it intances Outputable for the relevant types, creates a class that +-- describes a morphism from the IR domain to JavaScript concrete Syntax and +-- then generates that syntax on a case by case basis. +-- +-- * How to use +-- +-- The key functions are @renderJS@, @jsToDoc@, and the @RenderJS@ record. +-- Use the @RenderJS@ record and @jsToDoc@ to define a custom renderers for +-- specific parts of the backend, for example in 'GHC.StgToJS.Linker.Opt' a +-- custom renderer ensures all @Ident@ generated by the linker optimization +-- pass are prefixed differently than the default. Use @renderJS@ to +-- generate JavaScript concrete syntax in the general case, suitable for +-- human consumption. +----------------------------------------------------------------------------- + module GHC.JS.Ppr ( renderJs - , renderJs' , renderPrefixJs , renderPrefixJs' , JsToDoc(..) @@ -21,9 +57,10 @@ module GHC.JS.Ppr , RenderJs(..) , jsToDoc , pprStringLit - , flattenBlocks , braceNest , hangBrace + , interSemi + , addSemi ) where @@ -49,9 +86,9 @@ instance Outputable JExpr where instance Outputable JVal where ppr = docToSDoc . renderJs - -($$$) :: Doc -> Doc -> Doc -x $$$ y = nest 2 $ x $+$ y +-------------------------------------------------------------------------------- +-- Top level API +-------------------------------------------------------------------------------- -- | Render a syntax tree as a pretty-printable document -- (simply showing the resultant doc produces a nice, @@ -84,26 +121,17 @@ renderPrefixJs = renderPrefixJs' defaultRenderJs renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc renderPrefixJs' r = jsToDocR r -braceNest :: Doc -> Doc -braceNest x = char '{' <+> nest 2 x $$ char '}' - --- | Hang with braces: --- --- hdr { --- body --- } -hangBrace :: Doc -> Doc -> Doc -hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] +-------------------------------------------------------------------------------- +-- Code Generator +-------------------------------------------------------------------------------- class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc -instance JsToDoc JStat where jsToDocR r = renderJsS r r -instance JsToDoc JExpr where jsToDocR r = renderJsE r r -instance JsToDoc JVal where jsToDocR r = renderJsV r r -instance JsToDoc Ident where jsToDocR r = renderJsI r r -instance JsToDoc [JExpr] where - jsToDocR r = vcat . map ((<> semi) . jsToDocR r) -instance JsToDoc [JStat] where - jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc JStat where jsToDocR r = renderJsS r r +instance JsToDoc JExpr where jsToDocR r = renderJsE r r +instance JsToDoc JVal where jsToDocR r = renderJsV r r +instance JsToDoc Ident where jsToDocR r = renderJsI r r +instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) defRenderJsS :: RenderJs -> JStat -> Doc defRenderJsS r = \case @@ -120,12 +148,16 @@ defRenderJsS r = \case ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s where - printBS (BlockStat ss) = vcat $ interSemi $ flattenBlocks ss + printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - interSemi [x] = [jsToDocR r x] - interSemi [] = [] - interSemi (x:xs) = (jsToDocR r x <> semi) : interSemi xs + ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb) + where + forCond = parens $ hcat $ interSemi + [ jsToDocR r init + , jsToDocR r p + , parens (jsToDocR r s1) + ] ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) where txt | each = "for each" | otherwise = "for" @@ -134,12 +166,15 @@ defRenderJsS r = \case cases = vcat l' ReturnStat e -> text "return" <+> jsToDocR r e ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) + FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i + <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) + (jsToDocR r b) TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally where mbCatch | s1 == BlockStat [] = PP.empty | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) mbFinally | s2 == BlockStat [] = PP.empty | otherwise = hangBrace (text "finally") (jsToDocR r s2) - AssignStat i x -> case x of + AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. -- @@ -148,19 +183,13 @@ defRenderJsS r = \case -- ... -- }); -- - ValExpr (JFunc is b) -> sep [jsToDocR r i <+> text "= function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] - _ -> jsToDocR r i <+> char '=' <+> jsToDocR r x + ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] + _ -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x | isPre op -> ftext (uOpText op) <> optParens r x | otherwise -> optParens r x <> ftext (uOpText op) - BlockStat xs -> jsToDocR r (flattenBlocks xs) - -flattenBlocks :: [JStat] -> [JStat] -flattenBlocks = \case - BlockStat y:ys -> flattenBlocks y ++ flattenBlocks ys - y:ys -> y : flattenBlocks ys - [] -> [] + BlockStat xs -> jsToDocR r xs optParens :: RenderJs -> JExpr -> Doc optParens r x = case x of @@ -204,33 +233,12 @@ defRenderJsV r = \case defRenderJsI :: RenderJs -> Ident -> Doc defRenderJsI _ (TxtI t) = ftext t +aOpText :: AOp -> FastString +aOpText = \case + AssignOp -> "=" + AddAssignOp -> "+=" + SubAssignOp -> "-=" -pprStringLit :: FastString -> Doc -pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] - -encodeJson :: FastString -> Doc -encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) - -encodeJsonChar :: Char -> Doc -encodeJsonChar = \case - '/' -> text "\\/" - '\b' -> text "\\b" - '\f' -> text "\\f" - '\n' -> text "\\n" - '\r' -> text "\\r" - '\t' -> text "\\t" - '"' -> text "\\\"" - '\\' -> text "\\\\" - c - | not (isControl c) && ord c <= 127 -> char c - | ord c <= 0xff -> hexxs "\\x" 2 (ord c) - | ord c <= 0xffff -> hexxs "\\u" 4 (ord c) - | otherwise -> let cp0 = ord c - 0x10000 -- output surrogate pair - in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) <> - hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00) - where hexxs prefix pad cp = - let h = showHex cp "" - in text (prefix ++ replicate (pad - length h) '0' ++ h) uOpText :: UOp -> FastString uOpText = \case @@ -289,3 +297,56 @@ isAlphaOp = \case YieldOp -> True VoidOp -> True _ -> False + +pprStringLit :: FastString -> Doc +pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] + +-------------------------------------------------------------------------------- +-- Utilities +-------------------------------------------------------------------------------- + +encodeJson :: FastString -> Doc +encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) + +encodeJsonChar :: Char -> Doc +encodeJsonChar = \case + '/' -> text "\\/" + '\b' -> text "\\b" + '\f' -> text "\\f" + '\n' -> text "\\n" + '\r' -> text "\\r" + '\t' -> text "\\t" + '"' -> text "\\\"" + '\\' -> text "\\\\" + c + | not (isControl c) && ord c <= 127 -> char c + | ord c <= 0xff -> hexxs "\\x" 2 (ord c) + | ord c <= 0xffff -> hexxs "\\u" 4 (ord c) + | otherwise -> let cp0 = ord c - 0x10000 -- output surrogate pair + in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) <> + hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00) + where hexxs prefix pad cp = + let h = showHex cp "" + in text (prefix ++ replicate (pad - length h) '0' ++ h) + +braceNest :: Doc -> Doc +braceNest x = char '{' <+> nest 2 x $$ char '}' + +interSemi :: [Doc] -> [Doc] +interSemi [] = [] +interSemi [s] = [s] +interSemi (x:xs) = x <> text ";" : interSemi xs + +addSemi :: Doc -> Doc +addSemi x = x <> text ";" + +-- | Hang with braces: +-- +-- hdr { +-- body +-- } +hangBrace :: Doc -> Doc -> Doc +hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] + +($$$) :: Doc -> Doc -> Doc +x $$$ y = nest 2 $ x $+$ y ===================================== compiler/GHC/JS/Syntax.hs ===================================== @@ -58,6 +58,7 @@ module GHC.JS.Syntax , JVal(..) , Op(..) , UOp(..) + , AOp(..) , Ident(..) , JLabel -- * pattern synonyms over JS operators @@ -110,20 +111,22 @@ import GHC.Generics -- Reference](https://tc39.es/ecma262/#sec-ecmascript-language-statements-and-declarations) -- for details data JStat - = DeclStat !Ident !(Maybe JExpr) -- ^ Variable declarations: var foo [= e] - | ReturnStat JExpr -- ^ Return - | IfStat JExpr JStat JStat -- ^ If + = DeclStat !Ident !(Maybe JExpr) -- ^ Variable declarations: var foo [= e] + | ReturnStat JExpr -- ^ Return + | IfStat JExpr JStat JStat -- ^ If | WhileStat Bool JExpr JStat -- ^ While, bool is "do" when True + | ForStat JStat JExpr JStat JStat -- ^ For | ForInStat Bool Ident JExpr JStat -- ^ For-in, bool is "each' when True | SwitchStat JExpr [(JExpr, JStat)] JStat -- ^ Switch | TryStat JStat Ident JStat JStat -- ^ Try - | BlockStat [JStat] -- ^ Blocks - | ApplStat JExpr [JExpr] -- ^ Application - | UOpStat UOp JExpr -- ^ Unary operators - | AssignStat JExpr JExpr -- ^ Binding form: @foo = bar@ - | LabelStat JLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic - | BreakStat (Maybe JLabel) -- ^ Break - | ContinueStat (Maybe JLabel) -- ^ Continue + | BlockStat [JStat] -- ^ Blocks + | ApplStat JExpr [JExpr] -- ^ Application + | UOpStat UOp JExpr -- ^ Unary operators + | AssignStat JExpr AOp JExpr -- ^ Binding form: @ @ + | LabelStat JLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic + | BreakStat (Maybe JLabel) -- ^ Break + | ContinueStat (Maybe JLabel) -- ^ Continue + | FuncStat !Ident [Ident] JStat -- ^ an explicit function definition deriving (Eq, Typeable, Generic) -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of @@ -146,9 +149,9 @@ appendJStat mx my = case (mx,my) of (BlockStat [] , y ) -> y (x , BlockStat []) -> x (BlockStat xs , BlockStat ys) -> BlockStat $! xs ++ ys - (BlockStat xs , ys ) -> BlockStat $! xs ++ [ys] - (xs , BlockStat ys) -> BlockStat $! xs : ys - (xs , ys ) -> BlockStat [xs,ys] + (BlockStat xs , ys ) -> BlockStat $! xs ++ [ys] + (xs , BlockStat ys) -> BlockStat $! xs : ys + (xs , ys ) -> BlockStat [xs,ys] -------------------------------------------------------------------------------- @@ -156,13 +159,13 @@ appendJStat mx my = case (mx,my) of -------------------------------------------------------------------------------- -- | JavaScript Expressions data JExpr - = ValExpr JVal -- ^ All values are trivially expressions - | SelExpr JExpr Ident -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^' - | IdxExpr JExpr JExpr -- ^ Indexing: Obj[foo], see 'GHC.JS.Make..!' - | InfixExpr Op JExpr JExpr -- ^ Infix Expressions, see 'JExpr' pattern synonyms - | UOpExpr UOp JExpr -- ^ Unary Expressions + = ValExpr JVal -- ^ All values are trivially expressions + | SelExpr JExpr Ident -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^' + | IdxExpr JExpr JExpr -- ^ Indexing: Obj[foo], see 'GHC.JS.Make..!' + | InfixExpr Op JExpr JExpr -- ^ Infix Expressions, see 'JExpr' pattern synonyms + | UOpExpr UOp JExpr -- ^ Unary Expressions | IfExpr JExpr JExpr JExpr -- ^ If-expression - | ApplExpr JExpr [JExpr] -- ^ Application + | ApplExpr JExpr [JExpr] -- ^ Application deriving (Eq, Typeable, Generic) -- * Useful pattern synonyms to ease programming with the deeply embedded JS @@ -321,6 +324,15 @@ data UOp instance NFData UOp +-- | JS Unary Operators +data AOp + = AssignOp -- ^ Vanilla Assignment: = + | AddAssignOp -- ^ Addition Assignment: += + | SubAssignOp -- ^ Subtraction Assignment: -= + deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic) + +instance NFData AOp + -- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' -- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on -- Sane-ness @@ -345,10 +357,12 @@ instance Show SaneDouble where -------------------------------------------------------------------------------- jassignAllEqual :: [JExpr] -> [JExpr] -> JStat -jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" AssignStat xs ys) +jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" go xs ys) + where go l r = AssignStat l AssignOp r jassignAll :: [JExpr] -> [JExpr] -> JStat -jassignAll xs ys = mconcat (zipWith AssignStat xs ys) +jassignAll xs ys = mconcat $ zipWith go xs ys + where go l r = AssignStat l AssignOp r jvar :: FastString -> JExpr jvar = ValExpr . JVar . TxtI ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -47,6 +47,7 @@ identsS = \case Sat.ReturnStat e -> identsE e Sat.IfStat e s1 s2 -> identsE e ++ identsS s1 ++ identsS s2 Sat.WhileStat _ e s -> identsE e ++ identsS s + Sat.ForStat init p step body -> identsS init ++ identsE p ++ identsS step ++ identsS body Sat.ForInStat _ i e s -> [i] ++ identsE e ++ identsS s Sat.SwitchStat e xs s -> identsE e ++ concatMap traverseCase xs ++ identsS s where traverseCase (e,s) = identsE e ++ identsS s @@ -54,10 +55,11 @@ identsS = \case Sat.BlockStat xs -> concatMap identsS xs Sat.ApplStat e es -> identsE e ++ concatMap identsE es Sat.UOpStat _op e -> identsE e - Sat.AssignStat e1 e2 -> identsE e1 ++ identsE e2 + Sat.AssignStat e1 _op e2 -> identsE e1 ++ identsE e2 Sat.LabelStat _l s -> identsS s Sat.BreakStat{} -> [] Sat.ContinueStat{} -> [] + Sat.FuncStat i args body -> [i] ++ args ++ identsS body {-# INLINE identsE #-} identsE :: Sat.JExpr -> [Ident] @@ -148,6 +150,8 @@ jmcompos ret app f' v = ReturnStat i -> ret ReturnStat `app` f i IfStat e s s' -> ret IfStat `app` f e `app` f s `app` f s' WhileStat b e s -> ret (WhileStat b) `app` f e `app` f s + ForStat init p step body -> ret ForStat `app` f init `app` f p + `app` f step `app` f body ForInStat b i e s -> ret (ForInStat b) `app` f i `app` f e `app` f s SwitchStat e l d -> ret SwitchStat `app` f e `app` l' `app` f d where l' = mapM' (\(c,s) -> ret (,) `app` f c `app` f s) l @@ -158,6 +162,7 @@ jmcompos ret app f' v = AssignStat e e' -> ret AssignStat `app` f e `app` f e' UnsatBlock _ -> ret v' ContinueStat l -> ret (ContinueStat l) + FuncStat i args body -> ret FuncStat `app` f i `app` mapM' f args `app` f body BreakStat l -> ret (BreakStat l) LabelStat l s -> ret (LabelStat l) `app` f s JMGExpr v' -> ret JMGExpr `app` case v' of @@ -217,7 +222,6 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) -------------------------------------------------------------------------------- -- Translation -- --- This will be moved after GHC.JS.Syntax is removed -------------------------------------------------------------------------------- satJStat :: JStat -> Sat.JStat satJStat = witness . proof @@ -229,6 +233,9 @@ satJStat = witness . proof witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) + witness (ForStat init p step body) = Sat.ForStat + (witness init) (satJExpr p) + (witness step) (witness body) witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i (satJExpr iter) (witness body) @@ -240,12 +247,13 @@ satJStat = witness . proof witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) (satJExpr rhs) + witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) Sat.AssignOp (satJExpr rhs) witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) witness (BreakStat Nothing) = Sat.BreakStat Nothing witness (BreakStat (Just l)) = Sat.BreakStat $! Just l witness (ContinueStat Nothing) = Sat.ContinueStat Nothing witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l + witness (FuncStat i args body) = Sat.FuncStat i args (witness body) witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" ===================================== compiler/GHC/JS/Unsat/Syntax.hs ===================================== @@ -146,6 +146,7 @@ data JStat | ReturnStat JExpr -- ^ Return | IfStat JExpr JStat JStat -- ^ If | WhileStat Bool JExpr JStat -- ^ While, bool is "do" when True + | ForStat JStat JExpr JStat JStat -- ^ For | ForInStat Bool Ident JExpr JStat -- ^ For-in, bool is "each' when True | SwitchStat JExpr [(JExpr, JStat)] JStat -- ^ Switch | TryStat JStat Ident JStat JStat -- ^ Try @@ -157,6 +158,7 @@ data JStat | LabelStat JsLabel JStat -- ^ Statement Labels, makes me nostalgic for qbasic | BreakStat (Maybe JsLabel) -- ^ Break | ContinueStat (Maybe JsLabel) -- ^ Continue + | FuncStat !Ident [Ident] JStat -- ^ an explicit function definition deriving (Eq, Typeable, Generic) -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -408,17 +408,11 @@ mkApplyArr = mconcat [ TxtI "h$apply" ||= toJExpr (JList []) , TxtI "h$paps" ||= toJExpr (JList []) , ApplStat (var "h$initStatic" .^ "push") - [ ValExpr $ JFunc [] $ jVar \i -> mconcat - [ i |= zero_ - , WhileStat False (i .<. Int 65536) $ mconcat - [ var "h$apply" .! i |= var "h$ap_gen" - , preIncrS i - ] - , i |= zero_ - , WhileStat False (i .<. Int 128) $ mconcat - [ var "h$paps" .! i |= var "h$pap_gen" - , preIncrS i - ] + [ ValExpr $ JFunc [] $ mconcat + [ jFor (|= zero_) (.<. Int 65536) preIncrS + (\j -> var "h$apply" .! j |= var "h$ap_gen") + , jFor (|= zero_) (.<. Int 128) preIncrS + (\j -> var "h$paps" .! j |= var "h$pap_gen") , mconcat (map assignSpec applySpec) , mconcat (map assignPap specPap) ] ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -16,6 +16,7 @@ import GHC.JS.Ppr import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import GHC.JS.Optimizer import GHC.StgToJS.Arg import GHC.StgToJS.Sinker @@ -133,10 +134,10 @@ genUnits m ss spt_entries foreign_stubs = do glbl <- State.gets gsGlobal staticInit <- initStaticPtrs spt_entries - let stat = ( -- O.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m 1) - $ mconcat (reverse glbl) <> staticInit) + let stat = ( jsOptimize + . satJStat + . jsSaturate (Just $ modulePrefix m 1) + $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] let oi = ObjUnit { oiSymbols = syms @@ -208,7 +209,9 @@ genUnits m ss spt_entries foreign_stubs = do _extraTl <- State.gets (ggsToplevelStats . gsGroup) si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 - let stat = satJStat $ jsSaturate (Just $ modulePrefix m n) body + let stat = jsOptimize + . satJStat + $ jsSaturate (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -245,10 +248,10 @@ genUnits m ss spt_entries foreign_stubs = do let allDeps = collectIds unf decl topDeps = collectTopIds decl required = hasExport decl - stat = -- Opt.optimize . - satJStat . - jsSaturate (Just $ modulePrefix m n) - $ mconcat (reverse extraTl) <> tl + stat = jsOptimize + . satJStat + . jsSaturate (Just $ modulePrefix m n) + $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps let oi = ObjUnit { oiSymbols = syms @@ -308,15 +311,15 @@ genSetConInfo i d l {- srt -} = do (fixedLayout $ map uTypeVt fields) (CICon $ dataConTag d) sr - return (ei ||= mkDataEntry) + return (mkDataEntry ei) where -- dataConRepArgTys sometimes returns unboxed tuples. is that a bug? fields = concatMap (map primRepToType . typePrimRep . unwrapType . scaledThing) (dataConRepArgTys d) -- concatMap (map slotTyToType . repTypeSlots . repType) (dataConRepArgTys d) -mkDataEntry :: JExpr -mkDataEntry = ValExpr $ JFunc [] returnStack +mkDataEntry :: Ident -> JStat +mkDataEntry i = FuncStat i [] returnStack genToplevelRhs :: Id -> CgStgRhs -> G JStat -- general cases: ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -240,7 +240,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) = body <- genBody ctx R1 args body typ ei@(TxtI eii) <- identForEntryId i sr <- genStaticRefsRhs rhs - let f = JFunc [] (bh <> lvs <> body) + let f = (bh <> lvs <> body) emitClosureInfo $ ClosureInfo ei (CIRegs 0 $ concatMap idVt args) @@ -249,7 +249,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) = map (stackSlotType . fst) (ctxLneFrameVars ctx)) CIStackFrame sr - emitToplevel (ei ||= toJExpr f) + emitToplevel (jFunction ei [] f) genEntryLne ctx i (StgRhsCon cc con _mu _ticks args _typ) = resetSlots $ do let payloadSize = ctxLneFrameSize ctx ei@(TxtI _eii) <- identForEntryId i @@ -258,8 +258,7 @@ genEntryLne ctx i (StgRhsCon cc con _mu _ticks args _typ) = resetSlots $ do p <- popLneFrame True payloadSize ctx args' <- concatMapM genArg args ac <- allocCon ii con cc args' - emitToplevel (ei ||= toJExpr (JFunc [] - (mconcat [decl ii, p, ac, r1 |= toJExpr ii, returnStack]))) + emitToplevel (jFunction ei [] (mconcat [decl ii, p, ac, r1 |= toJExpr ii, returnStack])) -- | Generate the entry function for a local closure genEntry :: HasDebugCallStack => ExprCtx -> Id -> CgStgRhs -> G () @@ -283,7 +282,7 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) = (fixedLayout $ map (uTypeVt . idType) live) et sr - emitToplevel (ei ||= toJExpr (JFunc [] (mconcat [ll, llv, upd, setcc, body]))) + emitToplevel (jFunction ei [] (mconcat [ll, llv, upd, setcc, body])) where entryCtx = ctxSetTarget [] (ctxClearLneFrame ctx) @@ -630,7 +629,7 @@ genRet ctx e at as l = freshIdent >>= f ++ if prof then [ObjV] else map stackSlotType lneVars) CIStackFrame sr - emitToplevel $ r ||= toJExpr (JFunc [] fun') + emitToplevel $ jFunction r [] fun' return (pushLne <> saveCCS <> pushRet) fst3 ~(x,_,_) = x ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -30,6 +30,7 @@ import Prelude import GHC.Platform.Host (hostPlatformArchOS) import GHC.JS.Make +import GHC.JS.Optimizer import GHC.JS.Unsat.Syntax import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform @@ -43,11 +44,11 @@ import GHC.Linker.Static.Utils (exeFileName) import GHC.StgToJS.Linker.Types import GHC.StgToJS.Linker.Utils +import GHC.StgToJS.Linker.Opt import GHC.StgToJS.Rts.Rts import GHC.StgToJS.Object import GHC.StgToJS.Types hiding (LinkableUnit) import GHC.StgToJS.Symbols -import GHC.StgToJS.Printer import GHC.StgToJS.Arg import GHC.StgToJS.Closure @@ -332,7 +333,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | --- Module : GHC.StgToJS.Printer +-- Module : GHC.StgToJS.Linker.Opt -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file LICENSE) -- @@ -13,15 +13,14 @@ -- Sylvain Henry -- Stability : experimental -- --- Custom prettyprinter for JS AST uses the JS PPr module for most of --- the work +-- Optimization pass at link time +-- -- -- ----------------------------------------------------------------------------- -module GHC.StgToJS.Printer +module GHC.StgToJS.Linker.Opt ( pretty , ghcjsRenderJs - , prettyBlock ) where @@ -93,8 +92,7 @@ hexDoc v = text $ go v -- attempt to resugar some of the common constructs ghcjsRenderJsS :: RenderJs -> JStat -> Doc -ghcjsRenderJsS r (BlockStat xs) = prettyBlock r (flattenBlocks xs) -ghcjsRenderJsS r s = renderJsS defaultRenderJs r s +ghcjsRenderJsS r s = renderJsS defaultRenderJs r s -- don't quote keys in our object literals, so closure compiler works ghcjsRenderJsV :: RenderJs -> JVal -> Doc @@ -120,97 +118,3 @@ ghcjsRenderJsV r (JHash m) validOtherIdent c = isAlpha c || isDigit c ghcjsRenderJsV r v = renderJsV defaultRenderJs r v - -prettyBlock :: RenderJs -> [JStat] -> Doc -prettyBlock r xs = vcat $ map addSemi (prettyBlock' r xs) - --- recognize common patterns in a block and convert them to more idiomatic/concise javascript -prettyBlock' :: RenderJs -> [JStat] -> [Doc] --- return/... -prettyBlock' r ( x@(ReturnStat _) - : xs - ) - | not (null xs) - = prettyBlock' r [x] --- declare/assign -prettyBlock' r ( (DeclStat i Nothing) - : (AssignStat (ValExpr (JVar i')) v) - : xs - ) - | i == i' - = prettyBlock' r (DeclStat i (Just v) : xs) - --- resugar for loops with/without var declaration -prettyBlock' r ( (DeclStat i (Just v0)) - : (WhileStat False p (BlockStat bs)) - : xs - ) - | not (null flat) && isForUpdStat (last flat) - = mkFor r True i v0 p (last flat) (init flat) : prettyBlock' r xs - where - flat = flattenBlocks bs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) v0) - : (WhileStat False p (BlockStat bs)) - : xs - ) - | not (null flat) && isForUpdStat (last flat) - = mkFor r False i v0 p (last flat) (init flat) : prettyBlock' r xs - where - flat = flattenBlocks bs - --- global function (does not preserve semantics but works for GHCJS) -prettyBlock' r ( (DeclStat i (Just (ValExpr (JFunc is b)))) - : xs - ) - = (hangBrace (text "function" <+> jsToDocR r i <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) - (jsToDocR r b) - ) : prettyBlock' r xs --- modify/assign operators -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) (ValExpr (JInt 1)))) - : xs - ) - | i == i' = (text "++" <> jsToDocR r i) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr SubOp (ValExpr (JVar i')) (ValExpr (JInt 1)))) - : xs - ) - | i == i' = (text "--" <> jsToDocR r i) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) e)) - : xs - ) - | i == i' = (jsToDocR r i <+> text "+=" <+> jsToDocR r e) : prettyBlock' r xs -prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr SubOp (ValExpr (JVar i')) e)) - : xs - ) - | i == i' = (jsToDocR r i <+> text "-=" <+> jsToDocR r e) : prettyBlock' r xs - - -prettyBlock' r (x:xs) = jsToDocR r x : prettyBlock' r xs -prettyBlock' _ [] = [] - --- build the for block -mkFor :: RenderJs -> Bool -> Ident -> JExpr -> JExpr -> JStat -> [JStat] -> Doc -mkFor r decl i v0 p s1 sb = hangBrace (text "for" <> forCond) - (jsToDocR r $ BlockStat sb) - where - c0 | decl = text "var" <+> jsToDocR r i <+> char '=' <+> jsToDocR r v0 - | otherwise = jsToDocR r i <+> char '=' <+> jsToDocR r v0 - forCond = parens $ hcat $ interSemi - [ c0 - , jsToDocR r p - , parens (jsToDocR r s1) - ] - --- check if a statement is suitable to be converted to something in the for(;;x) position -isForUpdStat :: JStat -> Bool -isForUpdStat UOpStat {} = True -isForUpdStat AssignStat {} = True -isForUpdStat ApplStat {} = True -isForUpdStat _ = False - -interSemi :: [Doc] -> [Doc] -interSemi [] = [PP.empty] -interSemi [s] = [s] -interSemi (x:xs) = x <> text ";" : interSemi xs - -addSemi :: Doc -> Doc -addSemi x = x <> text ";" ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -408,31 +408,35 @@ instance Binary Sat.JStat where put_ bh (Sat.ReturnStat e) = putByte bh 2 >> put_ bh e put_ bh (Sat.IfStat e s1 s2) = putByte bh 3 >> put_ bh e >> put_ bh s1 >> put_ bh s2 put_ bh (Sat.WhileStat b e s) = putByte bh 4 >> put_ bh b >> put_ bh e >> put_ bh s - put_ bh (Sat.ForInStat b i e s) = putByte bh 5 >> put_ bh b >> put_ bh i >> put_ bh e >> put_ bh s - put_ bh (Sat.SwitchStat e ss s) = putByte bh 6 >> put_ bh e >> put_ bh ss >> put_ bh s - put_ bh (Sat.TryStat s1 i s2 s3) = putByte bh 7 >> put_ bh s1 >> put_ bh i >> put_ bh s2 >> put_ bh s3 - put_ bh (Sat.BlockStat xs) = putByte bh 8 >> put_ bh xs - put_ bh (Sat.ApplStat e es) = putByte bh 9 >> put_ bh e >> put_ bh es - put_ bh (Sat.UOpStat o e) = putByte bh 10 >> put_ bh o >> put_ bh e - put_ bh (Sat.AssignStat e1 e2) = putByte bh 11 >> put_ bh e1 >> put_ bh e2 - put_ bh (Sat.LabelStat l s) = putByte bh 12 >> put_ bh l >> put_ bh s - put_ bh (Sat.BreakStat ml) = putByte bh 13 >> put_ bh ml - put_ bh (Sat.ContinueStat ml) = putByte bh 14 >> put_ bh ml + put_ bh (Sat.ForStat is c s bd) = putByte bh 5 >> put_ bh is >> put_ bh c >> put_ bh s >> put_ bh bd + put_ bh (Sat.ForInStat b i e s) = putByte bh 6 >> put_ bh b >> put_ bh i >> put_ bh e >> put_ bh s + put_ bh (Sat.SwitchStat e ss s) = putByte bh 7 >> put_ bh e >> put_ bh ss >> put_ bh s + put_ bh (Sat.TryStat s1 i s2 s3) = putByte bh 8 >> put_ bh s1 >> put_ bh i >> put_ bh s2 >> put_ bh s3 + put_ bh (Sat.BlockStat xs) = putByte bh 9 >> put_ bh xs + put_ bh (Sat.ApplStat e es) = putByte bh 10 >> put_ bh e >> put_ bh es + put_ bh (Sat.UOpStat o e) = putByte bh 11 >> put_ bh o >> put_ bh e + put_ bh (Sat.AssignStat e1 op e2) = putByte bh 12 >> put_ bh e1 >> put_ bh op >> put_ bh e2 + put_ bh (Sat.LabelStat l s) = putByte bh 13 >> put_ bh l >> put_ bh s + put_ bh (Sat.BreakStat ml) = putByte bh 14 >> put_ bh ml + put_ bh (Sat.ContinueStat ml) = putByte bh 15 >> put_ bh ml + put_ bh (Sat.FuncStat i is b) = putByte bh 16 >> put_ bh i >> put_ bh is >> put_ bh b get bh = getByte bh >>= \case 1 -> Sat.DeclStat <$> get bh <*> get bh 2 -> Sat.ReturnStat <$> get bh 3 -> Sat.IfStat <$> get bh <*> get bh <*> get bh 4 -> Sat.WhileStat <$> get bh <*> get bh <*> get bh - 5 -> Sat.ForInStat <$> get bh <*> get bh <*> get bh <*> get bh - 6 -> Sat.SwitchStat <$> get bh <*> get bh <*> get bh - 7 -> Sat.TryStat <$> get bh <*> get bh <*> get bh <*> get bh - 8 -> Sat.BlockStat <$> get bh - 9 -> Sat.ApplStat <$> get bh <*> get bh - 10 -> Sat.UOpStat <$> get bh <*> get bh - 11 -> Sat.AssignStat <$> get bh <*> get bh - 12 -> Sat.LabelStat <$> get bh <*> get bh - 13 -> Sat.BreakStat <$> get bh - 14 -> Sat.ContinueStat <$> get bh + 5 -> Sat.ForStat <$> get bh <*> get bh <*> get bh <*> get bh + 6 -> Sat.ForInStat <$> get bh <*> get bh <*> get bh <*> get bh + 7 -> Sat.SwitchStat <$> get bh <*> get bh <*> get bh + 8 -> Sat.TryStat <$> get bh <*> get bh <*> get bh <*> get bh + 9 -> Sat.BlockStat <$> get bh + 10 -> Sat.ApplStat <$> get bh <*> get bh + 11 -> Sat.UOpStat <$> get bh <*> get bh + 12 -> Sat.AssignStat <$> get bh <*> get bh <*> get bh + 13 -> Sat.LabelStat <$> get bh <*> get bh + 14 -> Sat.BreakStat <$> get bh + 15 -> Sat.ContinueStat <$> get bh + 16 -> Sat.FuncStat <$> get bh <*> get bh <*> get bh n -> error ("Binary get bh JStat: invalid tag: " ++ show n) @@ -541,6 +545,10 @@ instance Binary Sat.UOp where put_ bh = putEnum bh get bh = getEnum bh +instance Binary Sat.AOp where + put_ bh = putEnum bh + get bh = getEnum bh + -- 16 bit sizes should be enough... instance Binary CILayout where put_ bh CILayoutVariable = putByte bh 1 ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -30,16 +30,18 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import GHC.JS.Optimizer import GHC.StgToJS.Apply import GHC.StgToJS.Closure import GHC.StgToJS.Heap -import GHC.StgToJS.Printer import GHC.StgToJS.Profiling import GHC.StgToJS.Regs import GHC.StgToJS.Types import GHC.StgToJS.Stack +import GHC.StgToJS.Linker.Opt + import GHC.Data.FastString import GHC.Types.Unique.Map @@ -134,7 +136,7 @@ closureConstructors s = BlockStat | otherwise = mempty mkClosureCon :: Maybe Int -> JStat - mkClosureCon n0 = funName ||= toJExpr fun + mkClosureCon n0 = jFunction funName args funBod where n | Just n' <- n0 = n' | Nothing <- n0 = 0 @@ -142,7 +144,6 @@ closureConstructors s = BlockStat | Nothing <- n0 = TxtI $ mkFastString "h$c" -- args are: f x1 x2 .. xn [cc] args = TxtI "f" : addCCArg' (map varName [1..n]) - fun = JFunc args funBod -- x1 goes into closureField1. All the other args are bundled into an -- object in closureField2: { d1 = x2, d2 = x3, ... } -- @@ -157,12 +158,12 @@ closureConstructors s = BlockStat ] mkDataFill :: Int -> JStat - mkDataFill n = funName ||= toJExpr fun + mkDataFill n = jFunction funName (map TxtI ds) body where funName = TxtI $ dataName n ds = map dataFieldName [1..n] extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds - fun = JFunc (map TxtI ds) (checkD <> returnS extra_args) + body = (checkD <> returnS extra_args) -- | JS Payload to perform stack manipulation in the RTS stackManip :: JStat @@ -172,10 +173,10 @@ stackManip = mconcat (map mkPush [1..32]) <> mkPush :: Int -> JStat mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n) as = map varName [1..n] - fun = JFunc as ((sp |= sp + toJExpr n) - <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) - [1..] as)) - in funName ||= toJExpr fun + body = ((sp |= sp + toJExpr n) + <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a) + [1..] as)) + in jFunction funName as body -- partial pushes, based on bitmap, increases Sp by highest bit mkPpush :: Integer -> JStat @@ -185,11 +186,10 @@ stackManip = mconcat (map mkPush [1..32]) <> n = length bits h = last bits args = map varName [1..n] - fun = JFunc args $ - mconcat [ sp |= sp + toJExpr (h+1) - , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) - ] - in funName ||= toJExpr fun + body = mconcat [ sp |= sp + toJExpr (h+1) + , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args) + ] + in jFunction funName args body bitsIdx :: Integer -> [Int] bitsIdx n | n < 0 = error "bitsIdx: negative" @@ -244,12 +244,12 @@ loadRegs :: JStat loadRegs = mconcat $ map mkLoad [1..32] where mkLoad :: Int -> JStat - mkLoad n = let args = map varName [1..n] - assign = zipWith (\a r -> toJExpr r |= toJExpr a) - args (reverse $ take n regsFromR1) - fname = TxtI $ mkFastString ("h$l" ++ show n) - fun = JFunc args (mconcat assign) - in fname ||= toJExpr fun + mkLoad n = let args = map varName [1..n] + body = mconcat $ + zipWith (\a r -> toJExpr r |= toJExpr a) + args (reverse $ take n regsFromR1) + fname = TxtI $ mkFastString ("h$l" ++ show n) + in jFunction fname args body -- | Assign registers R1 ... Rn in descending order, that is assign Rn first. -- This function uses the 'assignRegs'' array to construct functions which set @@ -314,11 +314,11 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . satJStat . rts +rtsText = show . pretty . jsOptimize . satJStat . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . satJStat $ rtsDecls +rtsDeclsText = show . pretty . jsOptimize . satJStat $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' rts :: StgToJSConfig -> JStat ===================================== compiler/ghc.cabal.in ===================================== @@ -532,6 +532,7 @@ Library GHC.IfaceToCore GHC.Iface.Type GHC.JS.Make + GHC.JS.Optimizer GHC.JS.Ppr GHC.JS.Syntax GHC.JS.Transform @@ -672,7 +673,6 @@ Library GHC.StgToJS.Object GHC.StgToJS.Prim GHC.StgToJS.Profiling - GHC.StgToJS.Printer GHC.StgToJS.Regs GHC.StgToJS.Rts.Types GHC.StgToJS.Rts.Rts @@ -686,6 +686,7 @@ Library GHC.StgToJS.Linker.Linker GHC.StgToJS.Linker.Types GHC.StgToJS.Linker.Utils + GHC.StgToJS.Linker.Opt GHC.Stg.Unarise GHC.SysTools GHC.SysTools.Ar ===================================== libraries/base/Data/Function.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-} @@ -28,7 +30,7 @@ module Data.Function , applyWhen ) where -import GHC.Base ( ($), (.), id, const, flip ) +import GHC.Base ( TYPE, ($), (.), id, const, flip ) import Data.Bool ( Bool(..) ) infixl 0 `on` @@ -120,7 +122,7 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c -- "6" -- -- @since 4.8.0.0 -(&) :: a -> (a -> b) -> b +(&) :: forall r a (b :: TYPE r). a -> (a -> b) -> b x & f = f x -- | 'applyWhen' applies a function to a value if a condition is true, ===================================== libraries/base/changelog.md ===================================== @@ -21,9 +21,10 @@ ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149)) * Make `($)` representation polymorphic ([CLC proposal #132](https://github.com/haskell/core-libraries-committee/issues/132)) * Implemented [GHC Proposal #433](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0433-unsatisfiable.rst), - adding the class `Unsatisfiable :: ErrorMessage -> TypeError`` to `GHC.TypeError`, + adding the class `Unsatisfiable :: ErrorMessage -> TypeError` to `GHC.TypeError`, which provides a mechanism for custom type errors that reports the errors in - a more predictable behaviour than ``TypeError``. + a more predictable behaviour than `TypeError`. + * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== rts/sm/NonMovingAllocate.c ===================================== @@ -253,5 +253,9 @@ void *nonmovingAllocateGC(Capability *cap, StgWord sz) GNUC_ATTR_HOT void *nonmovingAllocate(Capability *cap, StgWord sz) { + // Handle "bytes allocated" accounting in the same way we + // do in Storage.c:allocate. See #23312. + accountAllocation(cap, sz); + cap->total_allocated += sz; return nonmovingAllocate_(SM_LOCK, cap, sz); } ===================================== rts/sm/Storage.c ===================================== @@ -966,7 +966,7 @@ move_STACK (StgStack *src, StgStack *dest) dest->sp = (StgPtr)dest->sp + diff; } -STATIC_INLINE void +void accountAllocation(Capability *cap, W_ n) { TICK_ALLOC_HEAP_NOCTR(WDS(n)); ===================================== rts/sm/Storage.h ===================================== @@ -125,6 +125,8 @@ StgWord genLiveBlocks (generation *gen); StgWord calcTotalLargeObjectsW (void); StgWord calcTotalCompactW (void); +void accountAllocation(Capability *cap, W_ n); + /* ---------------------------------------------------------------------------- Storage manager internal APIs and globals ------------------------------------------------------------------------- */ ===================================== testsuite/tests/javascript/opt/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests for the JS backend optimizer +setTestOpts(when(not(js_arch()),skip)) + +test('deadCodeElim', normal, compile_and_run, ['-package ghc']) ===================================== testsuite/tests/javascript/opt/deadCodeElim.hs ===================================== @@ -0,0 +1,96 @@ + +import GHC.JS.Optimizer +import GHC.JS.Syntax +import GHC.JS.Unsat.Syntax (Ident (..)) + +import GHC.Data.FastString + +double_return :: JStat +double_return = BlockStat [ ReturnStat (SatInt 0) + , ReturnStat (SatInt 1) + ] + +double_return_opt :: JStat +double_return_opt = (BlockStat [ReturnStat (SatInt 0)]) + +in_func :: JStat +in_func = AssignStat (jvar (fsLit "foo")) AssignOp (ValExpr (JFunc [] double_return)) + +in_func_opt :: JStat +in_func_opt = AssignStat (jvar (fsLit "foo")) AssignOp (ValExpr (JFunc [] double_return_opt)) + +nested_blocks :: JStat +nested_blocks = BlockStat [ double_return <> double_return + , double_return + ] <> double_return + +nested_blocks_opt :: JStat +nested_blocks_opt = double_return_opt + +global_func :: JStat +global_func = FuncStat (TxtI (fsLit "bar")) [] double_return + +global_func_opt :: JStat +global_func_opt = FuncStat (TxtI (fsLit "bar")) [] double_return_opt + +func_with_locals :: JStat +func_with_locals = AssignStat (jvar (fsLit "foo")) + AssignOp + (ValExpr (JFunc [] + (BlockStat [ AssignStat (jvar (fsLit "one")) AssignOp (SatInt 2) + , AssignStat (jvar (fsLit "two")) AssignOp (SatInt 3) + , ApplStat (jvar (fsLit "f")) [(SatInt 100)] + , ReturnStat (SatInt 0) + , ReturnStat (SatInt 1) + ]))) + +func_with_locals_opt :: JStat +func_with_locals_opt = AssignStat (jvar (fsLit "foo")) + AssignOp + (ValExpr (JFunc [] + (BlockStat [ AssignStat (jvar (fsLit "one")) AssignOp (SatInt 2) + , AssignStat (jvar (fsLit "two")) AssignOp (SatInt 3) + , ApplStat (jvar (fsLit "f")) [(SatInt 100)] + , ReturnStat (SatInt 0) + ]))) + +-- This one comes straight from MR10260 where we noticed the optimizer was not catching the redundant return +bignum_test :: JStat +bignum_test = DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + , ReturnStat (ApplExpr (jvar $ fsLit "h$rs") [])])) + +bignum_test_opt :: JStat +bignum_test_opt = + DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + ])) + +bignum_test_2 :: JStat +bignum_test_2 = BlockStat [FuncStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99") [] (BlockStat [DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + , ReturnStat (ApplExpr (jvar $ fsLit "h$rs") [])]))])] + +bignum_test_opt_2 :: JStat +bignum_test_opt_2 = BlockStat [FuncStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99") [] (BlockStat [DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e") + (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2")) + , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"] + , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"]) + ]))])] + +main :: IO () +main = mapM_ print + [ jsOptimize double_return == double_return_opt + , jsOptimize in_func == in_func_opt + , jsOptimize nested_blocks == nested_blocks_opt + , jsOptimize global_func == global_func_opt + , jsOptimize func_with_locals == func_with_locals_opt + , jsOptimize bignum_test == bignum_test_opt + , jsOptimize bignum_test_2 == bignum_test_opt_2 + ] ===================================== testsuite/tests/javascript/opt/deadCodeElim.stdout ===================================== @@ -0,0 +1,7 @@ +True +True +True +True +True +True +True ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -7,7 +7,7 @@ ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:3993:49: Note [Eta-reduction in -O0] +ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice] ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices] @@ -15,6 +15,7 @@ ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constr ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -25,14 +26,14 @@ ref compiler/GHC/Tc/Gen/HsType.hs:2621:7: Note [Matching a kind signature ref compiler/GHC/Tc/Gen/Pat.hs:176:20: Note [Typing patterns in pattern bindings] ref compiler/GHC/Tc/Gen/Pat.hs:1127:7: Note [Matching polytyped patterns] ref compiler/GHC/Tc/Gen/Sig.hs:81:10: Note [Overview of type signatures] -ref compiler/GHC/Tc/Gen/Splice.hs:357:16: Note [How brackets and nested splices are handled] -ref compiler/GHC/Tc/Gen/Splice.hs:532:35: Note [PendingRnSplice] -ref compiler/GHC/Tc/Gen/Splice.hs:656:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/Tc/Gen/Splice.hs:889:11: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:356:16: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:531:35: Note [PendingRnSplice] +ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1120:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics] @@ -46,8 +47,8 @@ ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threa ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] ref testsuite/config/ghc:272:10: Note [WayFlags] -ref testsuite/driver/testlib.py:160:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:164:2: Note [Why is there no stage1 setup function?] +ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] +ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts] ===================================== testsuite/tests/th/T21050.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell, ImpredicativeTypes #-} +module T21050 where + +import Language.Haskell.TH.Syntax + +data T = MkT (forall a. a) + +f x = [|| MkT $$(x) ||] + +g :: Code Q (forall a. a) -> Code Q T +g x = [|| MkT $$(x) ||] ===================================== testsuite/tests/th/T21050.stderr ===================================== @@ -0,0 +1,26 @@ + +T21050.hs:8:18: error: [GHC-25897] + • Couldn't match expected type ‘Code m a1’ with actual type ‘p’ + ‘p’ is a rigid type variable bound by + the inferred type of f :: Quote m => p -> Code m T + at T21050.hs:8:1-23 + • In the expression: x + In the Template Haskell splice $$(x) + In the first argument of ‘MkT’, namely ‘$$(x)’ + • Relevant bindings include + x :: p (bound at T21050.hs:8:3) + f :: p -> Code m T (bound at T21050.hs:8:1) + +T21050.hs:11:18: error: [GHC-91028] + • Couldn't match type ‘a’ with ‘forall a2. a2’ + Expected: Code Q a + Actual: Code Q (forall a. a) + Cannot equate type variable ‘a’ + with a type involving polytypes: forall a2. a2 + ‘a’ is a rigid type variable bound by + a type expected by the context: + forall a. a + at T21050.hs:11:15-19 + • In the expression: x + In the Template Haskell splice $$(x) + In the first argument of ‘MkT’, namely ‘$$(x)’ ===================================== testsuite/tests/th/all.T ===================================== @@ -564,3 +564,4 @@ test('TH_typed2', normal, compile_and_run, ['']) test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed5', normal, compile_and_run, ['']) +test('T21050', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d412b16742d187ad3e3f3a97dc3e2954c2abbb49...d137ce9c9a8fbdac3105167fa039269b2c35e477 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d412b16742d187ad3e3f3a97dc3e2954c2abbb49...d137ce9c9a8fbdac3105167fa039269b2c35e477 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 23:20:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 19:20:58 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] 8 commits: testsuite: Add test for atomicSwapIORef Message-ID: <645ad55a88fb3_38ffdadbd4ac5c143283b@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 428734fc by Ben Gamari at 2023-05-09T19:20:47-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - 40f8200e by Ben Gamari at 2023-05-09T19:20:54-04:00 compiler: Record original thunk info tables on stack - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/ghc.cabal.in - docs/users_guide/debugging.rst - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - + libraries/base/tests/AtomicSwapIORef.stdout - libraries/base/tests/all.T - rts/StgMiscClosures.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d32cad7947b22dd753200dbce82039ea86db794...40f8200ee17575021c336c0aba14b684980415dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d32cad7947b22dd753200dbce82039ea86db794...40f8200ee17575021c336c0aba14b684980415dc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 23:28:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 09 May 2023 19:28:18 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] 90 commits: rts: improve memory ordering and add some comments in the StablePtr implementation Message-ID: <645ad712e457c_38ffdadcbf83e4143635c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - d2744218 by Rodrigo Mesquita at 2023-05-09T21:11:27+01:00 WIP: Anotate provenance and mult or usageenv - - - - - 1abcc625 by Rodrigo Mesquita at 2023-05-09T21:11:29+01:00 More fixes, in particular in bindNonRec... In bindNonRec make sure if we return a case instead of a let we make the idBinding correct - - - - - 3ed87df0 by Rodrigo Mesquita at 2023-05-09T21:11:29+01:00 Lint binding site matches id binding - - - - - 8fbb2acf by Rodrigo Mesquita at 2023-05-10T00:25:54+01:00 ROMES: WIP improvements In particular, we note that in dsUnliftedBind we pass to matchEquations variables which were let bound, which get further down the line used in matchOneConLike (and in bindNonRec too) as case-pattern bound variables! In this situation, where we use originally let-bound variables as case bound variables, we must ensure the case bound variables are set to be `LambdaBound` with the correct multiplicity (which should be some mix of scaling with the constructor annotated multiplicities) TODO: The multiplicity corresponding to the constructor multiplicity scaled by ... - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82d4286bea775c525e5646e8f958aee4c17af607...8fbb2acf526295afdc873b44318c63a9def9026e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82d4286bea775c525e5646e8f958aee4c17af607...8fbb2acf526295afdc873b44318c63a9def9026e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 23:30:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 09 May 2023 19:30:34 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] ROMES: WIP improvements Message-ID: <645ad79a3ab2c_38ffdadd07208c14377c8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 070f7fc1 by Rodrigo Mesquita at 2023-05-10T00:29:24+01:00 ROMES: WIP improvements In particular, we note that in dsUnliftedBind we pass to matchEquations variables which were let bound, which get further down the line used in matchOneConLike (and in bindNonRec too) as case-pattern bound variables! In this situation, where we use originally let-bound variables as case bound variables, we must ensure the case bound variables are set to be `LambdaBound` with the correct multiplicity (which should be some mix of scaling with the constructor annotated multiplicities) TODO: The multiplicity corresponding to the constructor multiplicity scaled by ... This broke through one more wall in the compilation of stage1 caused by incorrect provenences (well, really, by variables being moved around binding types while the provenence isn't updated) - - - - - 19 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Match.hs-boot - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GADTs, StandaloneDeriving #-} -- | GHC.Core holds all the main data types for use by for the Glasgow Haskell Compiler midsection module GHC.Core ( @@ -270,9 +271,12 @@ type Arg b = Expr b -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint -data Alt b - = Alt AltCon [b] (Expr b) - deriving (Data) +-- data Alt b +-- = Alt AltCon [b] (Expr b) +-- deriving (Data) +data Alt b where + Alt :: HasCallStack => AltCon -> [b] -> (Expr b) -> Alt b +deriving instance Data b => Data (Alt b) -- | A case alternative constructor (i.e. pattern match) @@ -2204,7 +2208,7 @@ data AnnExpr' bndr annot | AnnCoercion Coercion -- | A clone of the 'Alt' type but allowing annotation at every tree node -data AnnAlt bndr annot = AnnAlt AltCon [bndr] (AnnExpr bndr annot) +data AnnAlt bndr annot = HasCallStack => AnnAlt AltCon [bndr] (AnnExpr bndr annot) -- | A clone of the 'Bind' type but allowing annotation at every tree node data AnnBind bndr annot ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1693,7 +1693,7 @@ lintIdBndr top_lvl bind_site id thing_inside -- Check that the binding site matches the binding provenance of the id -- (we do this regardless of -dlinear-core-lint as it should always be true?) ; checkL (matchesBindingSite (idBinding id) bind_site) - (text "Core Id binding doesn't match binding site" <+> ppr (idBinding id) <+> ppr bind_site) + (text "Core Id binding doesn't match binding site" <+> ppr (idBinding id) <+> text (show bind_site)) -- Check that if the binder is nested, it is not marked as exported ; checkL (not (isExportedId id) || is_top_lvl) ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -1,5 +1,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# LANGUAGE GADTs #-} + -- | Handy functions for creating much Core syntax module GHC.Core.Make ( -- * Constructing normal syntax @@ -732,7 +734,7 @@ mkSmallTupleCase vars body scrut_var scrut data FloatBind = FloatLet CoreBind - | FloatCase CoreExpr Id AltCon [Var] + | HasCallStack => FloatCase CoreExpr Id AltCon [Var] -- case e of y { C ys -> ... } -- See Note [Floating single-alternative cases] in GHC.Core.Opt.SetLevels @@ -741,7 +743,7 @@ instance Outputable FloatBind where ppr (FloatCase e b c bs) = hang (text "CASE" <+> ppr e <+> text "of" <+> ppr b) 2 (ppr c <+> ppr bs) -wrapFloat :: FloatBind -> CoreExpr -> CoreExpr +wrapFloat :: HasCallStack => FloatBind -> CoreExpr -> CoreExpr wrapFloat (FloatLet defns) body = Let defns body wrapFloat (FloatCase e b con bs) body = mkSingleAltCase e b con bs body ===================================== compiler/GHC/Core/Opt/FloatIn.hs ===================================== @@ -41,11 +41,10 @@ import GHC.Utils.Outputable import Data.List ( mapAccumL ) -{- +{- | Top-level interface function, @floatInwards at . Note that we do not actually float any bindings downwards from the top-level. -} - floatInwards :: Platform -> CoreProgram -> CoreProgram floatInwards platform binds = map (fi_top_bind platform) binds where @@ -144,7 +143,7 @@ instance Outputable FloatInBind where ppr (FB bvs fvs _) = text "FB" <> braces (sep [ text "bndrs =" <+> ppr bvs , text "fvs =" <+> ppr fvs ]) -fiExpr :: Platform +fiExpr :: HasCallStack => Platform -> RevFloatInBinds -- Binds we're trying to drop -- as far "inwards" as possible -> CoreExprWithFVs -- Input expr @@ -806,7 +805,7 @@ floatedBindsFVs binds = mapUnionDVarSet fbFVs binds fbFVs :: FloatInBind -> DVarSet fbFVs (FB _ fvs _) = fvs -wrapFloats :: RevFloatInBinds -> CoreExpr -> CoreExpr +wrapFloats :: HasCallStack => RevFloatInBinds -> CoreExpr -> CoreExpr -- Remember RevFloatInBinds is in *reverse* dependency order wrapFloats [] e = e wrapFloats (FB _ _ fl : bs) e = wrapFloats bs (wrapFloat fl e) ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -229,8 +229,9 @@ tidyExpr env (Lam b e) ------------ Case alternatives -------------- tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt -tidyAlt env (Alt con vs rhs) - = tidyBndrs env vs =: \ (env', vs) -> +tidyAlt env a@(Alt con vs rhs) + = pprTrace "tidyAlt" (ppr a $$ ppr (map (\x -> (idBinding x, x)) vs) $$ callStackDoc) $ + tidyBndrs env vs =: \ (env', vs) -> (Alt con vs (tidyExpr env' rhs)) ------------ Tickish -------------- @@ -277,16 +278,16 @@ tidyVarOcc :: TidyEnv -> Var -> Var tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v -- tidyBndr is used for lambda and case binders -tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var) +tidyBndr :: HasCallStack => TidyEnv -> Var -> (TidyEnv, Var) tidyBndr env var | isTyCoVar var = tidyVarBndr env var | otherwise = tidyIdBndr env var -tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var]) +tidyBndrs :: HasCallStack => TidyEnv -> [Var] -> (TidyEnv, [Var]) tidyBndrs env vars = mapAccumL tidyBndr env vars -- Non-top-level variables, not covars -tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id) +tidyIdBndr :: HasCallStack => TidyEnv -> Id -> (TidyEnv, Id) tidyIdBndr env@(tidy_env, var_env) id = -- Do this pattern match strictly, otherwise we end up holding on to -- stuff in the OccName. ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -507,6 +507,10 @@ bindNonRec :: HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr -- that give Core Lint a heart attack, although actually -- the simplifier deals with them perfectly well. See -- also 'GHC.Core.Make.mkCoreLet' +-- +-- We must be careful about the idBinding of the binder. If we make the let +-- binder into a case binder, we must update the idBinding to reflect that, +-- since it must change from LetBound to CaseBound bindNonRec bndr rhs body | isTyVar bndr = let_bind | isCoVar bndr = if isCoArg rhs then let_bind @@ -515,7 +519,7 @@ bindNonRec bndr rhs body | needsCaseBinding (idType bndr) rhs = pprTrace "bindNonRec:needsCaseBinding:" (ppr bndr <+> ppr (idBinding bndr)) case_bind | otherwise = let_bind where - case_bind = mkDefaultCase rhs (setIdBinding bndr (LambdaBound ManyTy)) body + case_bind = mkDefaultCase rhs (setIdBinding bndr (maybe (LambdaBound ManyTy) LambdaBound (varMultMaybe bndr))) body -- ROMES:TODO: Explain let_bind = Let (NonRec bndr rhs) body -- | Tests whether we have to use a @case@ rather than @let@ binding for this @@ -543,11 +547,10 @@ mkAltExpr DEFAULT _ _ = panic "mkAltExpr DEFAULT" mkDefaultCase :: CoreExpr -> Id -> CoreExpr -> CoreExpr -- Make (case x of y { DEFAULT -> e } mkDefaultCase scrut case_bndr body - = pprTrace "mkDefaultCase bndr is LambdaBound?" (ppr $ isJust (varMultMaybe case_bndr)) $ - assertPpr (isJust (varMultMaybe case_bndr)) (text "mkDefaultCase:Case binder is marked LetBound!") $ + = assertPpr (isJust (varMultMaybe case_bndr)) (text "mkDefaultCase:Case binder is marked LetBound!") $ Case scrut case_bndr (exprType body) [Alt DEFAULT [] body] -mkSingleAltCase :: CoreExpr -> Id -> AltCon -> [Var] -> CoreExpr -> CoreExpr +mkSingleAltCase :: HasCallStack => CoreExpr -> Id -> AltCon -> [Var] -> CoreExpr -> CoreExpr -- Use this function if possible, when building a case, -- because it ensures that the type on the Case itself -- doesn't mention variables bound by the case ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -197,19 +197,26 @@ dsUnliftedBind (FunBind { fun_id = L l fun { let rhs' = core_wrap (mkOptTickBox tick rhs) ; return (bindNonRec fun rhs' body) } } -dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss +dsUnliftedBind p@(PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = (ty, _) }) body = -- let C x# y# = rhs in body -- ==> case rhs of C x# y# -> body do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], + eqn = pprTrace "dsUnliftedBind" (ppr p $$ ppr upat) $ EqnInfo { eqn_pats = [upat], eqn_orig = FromSource, eqn_rhs = cantFailMatchResult body } ; var <- selectMatchVar ManyTy upat -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. + -- + -- romes: Why in a let binder? Sometimes it will end up in a + -- case binder (see bindNonRec and matchOneConLike). + + -- ROMES:TODO: I will need to make this correct here... this transformation seems suspicious + -- Matching will turn a group of equations and matching ids into a group of case expressions? + -- It seems really weird for the eqn to have let bound variables, if they're patterns...? ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ; return (bindNonRec var rhs result) } ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -85,7 +85,7 @@ import qualified Data.Map as Map ************************************************************************ The function @match@ is basically the same as in the Wadler chapter -from "The Implementation of Functional Programming Languages", +from "The Implementation of Functional Programming Languages" (Chapter 5), except it is monadised, to carry around the name supply, info about annotations, etc. @@ -180,7 +180,8 @@ See also Note [Localise pattern binders] in GHC.HsToCore.Utils type MatchId = Id -- See Note [Match Ids] -match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with +-- | Described by the comment block above +match :: HasCallStack => [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with -- ^ See Note [Match Ids] -- -- ^ Note that the Match Ids carry not only a name, but @@ -824,7 +825,22 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches $ replicate (length (grhssGRHSs m)) initNablas -matchEquations :: HsMatchContext GhcRn +-- | Matching will turn a group of pattern-matching equations and MatchId's +-- into a group of case expressions +-- +-- For example: +-- +-- mappairs f [] ys = [] +-- mappairs f (x:xs) [] = [] +-- mappairs f (x:xs) (y:ys) = f x y : mappairs f xs ys +-- ==> +-- mappairs = \f -> \xs' -> \ys' -> +-- case xs' of +-- [] -> [] +-- (x:xs) -> case ys' of +-- [] -> [] +-- (y:ys) -> f x y : mappairs f xs ys +matchEquations :: HasCallStack => HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr matchEquations ctxt vars eqns_info rhs_ty ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -8,7 +8,9 @@ import GHC.Core ( CoreExpr ) import GHC.Hs ( LPat, HsMatchContext, MatchGroup, LHsExpr ) import GHC.Hs.Extension ( GhcTc, GhcRn ) -match :: [Id] +import GHC.Stack (HasCallStack) + +match :: HasCallStack => [Id] -> Type -> [EquationInfo] -> DsM (MatchResult CoreExpr) ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -29,6 +29,7 @@ import GHC.Core ( CoreExpr ) import GHC.Core.Make ( mkCoreLets ) import GHC.Utils.Misc import GHC.Types.Id +import GHC.Types.Var (pprIdWithBinding) import GHC.Types.Name.Env import GHC.Types.FieldLabel ( flSelector ) import GHC.Types.SrcLoc @@ -92,7 +93,7 @@ have-we-used-all-the-constructors? question; the local function @match_cons_used@ does all the real work. -} -matchConFamily :: NonEmpty Id +matchConFamily :: HasCallStack => NonEmpty Id -> Type -> NonEmpty (NonEmpty EquationInfo) -> DsM (MatchResult CoreExpr) @@ -126,7 +127,7 @@ matchPatSyn (var :| vars) ty eqns type ConArgPats = HsConPatDetails GhcTc -matchOneConLike :: [Id] +matchOneConLike :: HasCallStack => [Id] -> Type -> Mult -> NonEmpty EquationInfo @@ -190,8 +191,16 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; match_results <- mapM (match_group arg_vars) groups + ; pprTraceM "matchOneConLike" (text "Dicts:" <+> ppr (map pprIdWithBinding dicts1) $$ text "Args:" <+> ppr (map pprIdWithBinding arg_vars)) + -- ROMES:TODO: Understand better if we could determine this elsewhere, but: + -- + -- The provenence of the variables put in the alt_bndrs is not + -- necessarily correct, as it may come from a variable which was + -- originally let bound and will now be lambda bound. + -- See comments in dsUnliftedBind too. + ; let arg_vars' = map (const $ setIdBinding (LambdaBound ManyTy)) arg_vars -- ROMES:TODO: Not ManyTy!! It depends on the constructor! ; return $ MkCaseAlt{ alt_pat = con1, - alt_bndrs = tvs1 ++ dicts1 ++ arg_vars, + alt_bndrs = tvs1 ++ dicts1 ++ arg_vars', -- these arg_vars contain variables that were originally let bound alt_wrapper = wrapper1, alt_result = foldr1 combineMatchResults match_results } } where @@ -243,12 +252,12 @@ same_fields flds1 flds2 ----------------- -selectConMatchVars :: [Scaled Type] -> ConArgPats -> DsM [Id] +selectConMatchVars :: HasCallStack => [Scaled Type] -> ConArgPats -> DsM [Id] selectConMatchVars arg_tys con = case con of RecCon {} -> newSysLocalsDs arg_tys - PrefixCon _ ps -> selectMatchVars (zipMults arg_tys ps) - InfixCon p1 p2 -> selectMatchVars (zipMults arg_tys [p1, p2]) + PrefixCon _ ps -> pprTrace "selectConMatchVars:InfixCon" (ppr ps) $ selectMatchVars (zipMults arg_tys ps) + InfixCon p1 p2 -> pprTrace "selectConMatchVars:InfixCon" (ppr p1 <+> ppr p2) $ selectMatchVars (zipMults arg_tys [p1, p2]) where zipMults = zipWithEqual "selectConMatchVar" (\a b -> (scaledMult a, unLoc b)) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} {- (c) The University of Glasgow 2006 @@ -60,6 +61,7 @@ import GHC.Core.Utils import GHC.Core.Make import GHC.Types.Id.Make import GHC.Types.Id +import GHC.Types.Var (pprIdWithBinding) import GHC.Types.Literal import GHC.Core.TyCon import GHC.Core.DataCon @@ -124,16 +126,16 @@ selectSimpleMatchVarL w pat = selectMatchVar w (unLoc pat) -- Then we must not choose (x::Int) as the matching variable! -- And nowadays we won't, because the (x::Int) will be wrapped in a CoPat -selectMatchVars :: [(Mult, Pat GhcTc)] -> DsM [Id] +selectMatchVars :: HasCallStack => [(Mult, Pat GhcTc)] -> DsM [Id] -- Postcondition: the returned Ids have Internal Names selectMatchVars ps = mapM (uncurry selectMatchVar) ps -selectMatchVar :: Mult -> Pat GhcTc -> DsM Id +selectMatchVar :: HasCallStack => Mult -> Pat GhcTc -> DsM Id -- Postcondition: the returned Id has an Internal Name selectMatchVar w (BangPat _ pat) = selectMatchVar w (unLoc pat) selectMatchVar w (LazyPat _ pat) = selectMatchVar w (unLoc pat) selectMatchVar w (ParPat _ _ pat _) = selectMatchVar w (unLoc pat) -selectMatchVar _w (VarPat _ var) = return (localiseId (unLoc var)) +selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWithBinding (unLoc var)) $ return (localiseId (unLoc var)) -- Note [Localise pattern binders] -- -- Remark: when the pattern is a variable (or @@ -284,7 +286,7 @@ mkCoPrimCaseMatchResult var ty match_alts do body <- runMatchResult fail mr return (Alt (LitAlt lit) [] body) -data CaseAlt a = MkCaseAlt{ alt_pat :: a, +data CaseAlt a = HasCallStack => MkCaseAlt{ alt_pat :: a, alt_bndrs :: [Var], alt_wrapper :: HsWrapper, alt_result :: MatchResult CoreExpr } @@ -367,7 +369,7 @@ mkDataConCase var ty alts@(alt1 :| _) , alt_result = match_result } = flip adjustMatchResultDs match_result $ \body -> do case dataConBoxer con of - Nothing -> return (Alt (DataAlt con) args body) + Nothing -> pprTrace "mk_alt" (ppr (map (\x -> (idBinding x, x)) args)) $ return (Alt (DataAlt con) args body) Just (DCB boxer) -> do us <- newUniqueSupply let (rep_ids, binds) = initUs_ us (boxer ty_args args) ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -253,8 +253,9 @@ tcLocalBinds (EmptyLocalBinds x) thing_inside = do { thing <- thing_inside ; return (EmptyLocalBinds x, thing) } -tcLocalBinds (HsValBinds x (XValBindsLR (NValBinds binds sigs))) thing_inside - = do { (binds', thing) <- tcValBinds NotTopLevel binds sigs thing_inside +tcLocalBinds h@(HsValBinds x (XValBindsLR (NValBinds binds sigs))) thing_inside + = pprTrace "tcLocalBinds:HsValBinds" (ppr h) $ + do { (binds', thing) <- tcValBinds NotTopLevel binds sigs thing_inside ; return (HsValBinds x (XValBindsLR (NValBinds binds' sigs)), thing) } tcLocalBinds (HsValBinds _ (ValBinds {})) _ = panic "tcLocalBinds" @@ -434,6 +435,7 @@ recursivePatSynErr recursivePatSynErr loc binds = failAt loc $ TcRnRecursivePatternSynonym binds +-- | ROMES:TODO: Document tc_single :: forall thing. HasCallStack => TopLevelFlag -> TcSigFun -> TcPragEnv -> LHsBind GhcRn -> IsGroupClosed -> TcM thing @@ -704,6 +706,7 @@ it's all cool; each signature has distinct type variables from the renamer.) * * ********************************************************************* -} +-- | ROMES:TODO: Document... tcPolyInfer :: HasCallStack => RecFlag -- Whether it's recursive after breaking -- dependencies based on type signatures @@ -711,7 +714,8 @@ tcPolyInfer -> [LHsBind GhcRn] -> TcM (LHsBinds GhcTc, [TcId]) tcPolyInfer rec_tc prag_fn tc_sig_fn bind_list - = do { (tclvl, wanted, (binds', mono_infos)) + = pprTrace "tcPolyInfer" (ppr bind_list) $ + do { (tclvl, wanted, (binds', mono_infos)) <- pushLevelAndCaptureConstraints $ tcMonoBinds rec_tc tc_sig_fn LetLclBndr bind_list @@ -1695,6 +1699,7 @@ We typecheck pattern bindings as follows. First tcLhs does this: Result: the type of the binder is always at pc_lvl. This is crucial. + ROMES:TODO: Update note, they're not all let bound, for our definition of let bound 4. Throughout, when we are making up an Id for the pattern-bound variables (newLetBndr), we have two cases: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -94,7 +94,7 @@ is used in error messages. It checks that all the equations have the same number of arguments before using @tcMatches@ to do the work. -} -tcMatchesFun :: LocatedN Name -- MatchContext Id +tcMatchesFun :: HasCallStack => LocatedN Name -- MatchContext Id -> MatchGroup GhcRn (LHsExpr GhcRn) -> ExpRhoType -- Expected type of function -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc)) @@ -209,7 +209,7 @@ type AnnoBody body ) -- | Type-check a MatchGroup. -tcMatches :: (AnnoBody body ) => TcMatchCtxt body +tcMatches :: HasCallStack => (AnnoBody body ) => TcMatchCtxt body -> [Scaled ExpSigmaTypeFRR] -- ^ Expected pattern types. -> ExpRhoType -- ^ Expected result-type of the Match. -> MatchGroup GhcRn (LocatedA (body GhcRn)) @@ -239,7 +239,7 @@ tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches }) } ------------- -tcMatch :: (AnnoBody body) => TcMatchCtxt body +tcMatch :: HasCallStack => (AnnoBody body) => TcMatchCtxt body -> [Scaled ExpSigmaType] -- Expected pattern types -> ExpRhoType -- Expected result-type of the Match. -> LMatch GhcRn (LocatedA (body GhcRn)) @@ -265,7 +265,7 @@ tcMatch ctxt pat_tys rhs_ty match _ -> addErrCtxt (pprMatchInCtxt match) thing_inside ------------- -tcGRHSs :: AnnoBody body +tcGRHSs :: HasCallStack => AnnoBody body => TcMatchCtxt body -> GRHSs GhcRn (LocatedA (body GhcRn)) -> ExpRhoType -> TcM (GRHSs GhcTc (LocatedA (body GhcTc))) ===================================== compiler/GHC/Tc/Gen/Match.hs-boot ===================================== @@ -7,11 +7,13 @@ import GHC.Hs.Extension ( GhcRn, GhcTc ) import GHC.Parser.Annotation ( LocatedN ) import GHC.Types.Name (Name) +import GHC.Stack + tcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn) -> ExpRhoType -> TcM (GRHSs GhcTc (LHsExpr GhcTc)) -tcMatchesFun :: LocatedN Name +tcMatchesFun :: HasCallStack => LocatedN Name -> MatchGroup GhcRn (LHsExpr GhcRn) -> ExpSigmaType -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc)) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -87,7 +87,11 @@ import Data.List( partition ) ************************************************************************ -} -tcLetPat :: (Name -> Maybe TcId) +-- The issue being we're incorrectly calling tcLetPat for case bound variables... +-- ROMES:TODO:! Document that we don't consider case binder variables to be Let +-- bound, we consider them lambda bound, or Case bound. (this is also in the +-- definition of PatCtxt) +tcLetPat :: HasCallStack => (Name -> Maybe TcId) -> LetBndrSpec -> LPat GhcRn -> Scaled ExpSigmaTypeFRR -> TcM a @@ -104,7 +108,7 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside ; tc_lpat pat_ty penv pat thing_inside } ----------------- -tcPats :: HsMatchContext GhcTc +tcPats :: HasCallStack => HsMatchContext GhcTc -> [LPat GhcRn] -- ^ atterns -> [Scaled ExpSigmaTypeFRR] -- ^ types of the patterns -> TcM a -- ^ checker for the body @@ -212,7 +216,7 @@ inPatBind (PE { pe_ctxt = LamPat {} }) = False * * ********************************************************************* -} -tcPatBndr :: PatEnv -> Name -> Scaled ExpSigmaTypeFRR -> TcM (HsWrapper, TcId) +tcPatBndr :: HasCallStack => PatEnv -> Name -> Scaled ExpSigmaTypeFRR -> TcM (HsWrapper, TcId) -- (coi, xp) = tcPatBndr penv x pat_ty -- Then coi : pat_ty ~ typeof(xp) -- @@ -239,7 +243,8 @@ tcPatBndr penv@(PE { pe_ctxt = LetPat { pc_lvl = bind_lvl do { bndr_ty <- inferResultToType infer_res ; return (mkNomReflCo bndr_ty, bndr_ty) } ; let bndr_mult = scaledMult exp_pat_ty - ; bndr_id <- newLetBndr no_gen bndr_name (unitUE bndr_name bndr_mult) bndr_ty -- ROMES:TODO: Likely incorrect + -- ; massert (isOneTy bndr_mult) -- ROMES:It's not necessary, it's just that we won't add it to the usage environment in case it is ManyTy. Do this in a helper UsageEnv "builder" + ; bndr_id <- newLetBndr no_gen bndr_name zeroUE bndr_ty -- ROMES:TODO: UE is incorrect here, we were previously doing unitUE bndr_name bndr_mult. What now? -- Keep zeroUE until it compiles ; traceTc "tcPatBndr(nosig)" (vcat [ ppr bind_lvl , ppr exp_pat_ty, ppr bndr_ty, ppr co , ppr bndr_id ]) @@ -249,7 +254,7 @@ tcPatBndr _ bndr_name pat_ty = do { let pat_mult = scaledMult pat_ty ; pat_ty <- expTypeToType (scaledThing pat_ty) ; traceTc "tcPatBndr(not let)" (ppr bndr_name $$ ppr pat_ty) - ; return (idHsWrapper, mkLocalIdOrCoVar bndr_name (LambdaBound pat_mult) pat_ty) } -- ROMES:TODO: Pat Mult Lambda bound? + ; return (idHsWrapper, mkLocalIdOrCoVar bndr_name (LambdaBound pat_mult) pat_ty) } -- ROMES:TODO: Pat Mult Lambda bound, rather should really be binder of binding Pattern? PatCtxt agrees this is LambdaBound -- We should not have "OrCoVar" here, this is a bug (#17545) -- Whether or not there is a sig is irrelevant, -- as this is local @@ -344,7 +349,7 @@ tcMultiple tc_pat penv args thing_inside ; loop penv args } -------------------- -tc_lpat :: Scaled ExpSigmaTypeFRR +tc_lpat :: HasCallStack => Scaled ExpSigmaTypeFRR -> Checker (LPat GhcRn) (LPat GhcTc) tc_lpat pat_ty penv (L span pat) thing_inside = setSrcSpanA span $ @@ -352,7 +357,7 @@ tc_lpat pat_ty penv (L span pat) thing_inside thing_inside ; return (L span pat', res) } -tc_lpats :: [Scaled ExpSigmaTypeFRR] +tc_lpats :: HasCallStack => [Scaled ExpSigmaTypeFRR] -> Checker [LPat GhcRn] [LPat GhcTc] tc_lpats tys penv pats = assertPpr (equalLength pats tys) (ppr pats $$ ppr tys) $ @@ -365,7 +370,7 @@ tc_lpats tys penv pats checkManyPattern :: Scaled a -> TcM HsWrapper checkManyPattern pat_ty = tcSubMult NonLinearPatternOrigin ManyTy (scaledMult pat_ty) -tc_pat :: Scaled ExpSigmaTypeFRR +tc_pat :: HasCallStack => Scaled ExpSigmaTypeFRR -- ^ Fully refined result type -> Checker (Pat GhcRn) (Pat GhcTc) -- ^ Translated pattern ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -637,7 +637,7 @@ unsatisfiableEvExpr (unsat_ev, given_msg) wtd_ty BI_Box { bi_data_con = mkDictBox } -> mkDictBox _ -> pprPanic "unsatisfiableEvExpr: no DictBox!" (ppr wtd_ty) dictBox = dataConTyCon mkDictBox - ; ev_bndr <- mkSysLocalM (fsLit "ct") ManyTy fun_ty + ; ev_bndr <- mkSysLocalM (fsLit "ct") (LambdaBound ManyTy) fun_ty -- Dict ((##) -=> wtd_ty) ; let scrut_ty = mkTyConApp dictBox [fun_ty] -- unsatisfiable @{LiftedRep} @given_msg @(Dict ((##) -=> wtd_ty)) unsat_ev ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -143,7 +143,7 @@ import GHC.Types.Var( Id, CoVar, JoinId, OutId, OutVar, idInfo, idDetails, setIdDetails, globaliseId, isId, isLocalId, isGlobalId, isExportedId, - setIdBinding, -- used to be setIdMult + setIdBinding, updateIdTypeAndMults, updateIdTypeButNotMults, updateIdTypeAndMultsM, IdBinding(..) ) ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -59,7 +59,7 @@ module GHC.Types.Var ( setIdExported, setIdNotExported, setIdBinding, updateIdTypeButNotMults, updateIdTypeAndMults, updateIdTypeAndMultsM, - IdBinding(..), idBinding, + IdBinding(..), idBinding, pprIdWithBinding, -- ** Predicates isId, isTyVar, isTcTyVar, @@ -283,6 +283,9 @@ data IdBinding where -- Removed globalbinding in exchange for LetBound with zero Ue (closed top-level let bound) -- Might no longer make sense to merge with IdScope at all +pprIdWithBinding :: Id -> SDoc +pprIdWithBinding x = ppr x <> text "[" <> ppr (idBinding x) <> text "]" + {- Note the binding sites considered in Core (see lintCoreExpr, lintIdBinder) data BindingSite ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -1208,7 +1208,7 @@ data BindingSite | CaseBind -- ^ The x in case scrut of x { (y,z) -> ... } | CasePatBind -- ^ The y,z in case scrut of x { (y,z) -> ... } | LetBind -- ^ The x in (let x = rhs in e) - deriving Eq + deriving (Eq, Show) -- | When we print a binder, we often want to print its type too. -- The @OutputableBndr@ class encapsulates this idea. class Outputable a => OutputableBndr a where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/070f7fc12fa78440bd9828633f09d234add52c7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/070f7fc12fa78440bd9828633f09d234add52c7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 23:35:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 19:35:03 -0400 Subject: [Git][ghc/ghc][wip/T23163] 194 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <645ad8a7e44_38ffdaddee3cd8144377b@gitlab.mail> Ben Gamari pushed to branch wip/T23163 at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - d17b7edc by Ben Gamari at 2023-05-09T19:34:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/280ac03b3c6e573f98c66c4e4a5255cf34f10c18...d17b7edcadff7493adb27ef5184fb79227f0d496 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/280ac03b3c6e573f98c66c4e4a5255cf34f10c18...d17b7edcadff7493adb27ef5184fb79227f0d496 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 23:38:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 19:38:45 -0400 Subject: [Git][ghc/ghc][wip/T22706] 194 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <645ad985aafe_38ffdadee7785c1450670@gitlab.mail> Ben Gamari pushed to branch wip/T22706 at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 41ddee1a by Ben Gamari at 2023-05-09T19:38:32-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9c348b964b4f26180a1a6262db71cc06af00801...41ddee1aa23014387a944aa34c1a334b13d200fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9c348b964b4f26180a1a6262db71cc06af00801...41ddee1aa23014387a944aa34c1a334b13d200fb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 23:40:25 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 09 May 2023 19:40:25 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Progress Message-ID: <645ad9e958988_38ffdadf1545841451861@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 6279c5c9 by Simon Peyton Jones at 2023-05-10T00:40:05+01:00 Progress - - - - - 8 changed files: - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -51,8 +51,6 @@ import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.FastString -import Control.Monad ( guard ) - -- | A predicate in the solver. The solver tries to prove Wanted predicates -- from Given ones. data Pred @@ -327,12 +325,14 @@ isCallStackTy ty -- | Decomposes a predicate if it is an implicit parameter. Does not look in -- superclasses. See also [Local implicit parameters]. -isIPPred_maybe :: Type -> Maybe (FastString, Type) -isIPPred_maybe ty = - do (tc,[t1,t2]) <- splitTyConApp_maybe ty - guard (isIPTyCon tc) - x <- isStrLitTy t1 - return (x,t2) +isIPPred_maybe :: Class -> [Type] -> Maybe (FastString, Type) +isIPPred_maybe cls tys + | cls `hasKey` ipClassKey + , [t1,t2] <- tys + , Just x <- isStrLitTy t1 + = Just (x,t2) + | otherwise + = Nothing {- Note [Local implicit parameters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -11,37 +11,51 @@ import GHC.Prelude import GHC.Tc.Errors.Types import GHC.Tc.Utils.TcType import GHC.Tc.Instance.FunDeps +import GHC.Tc.Instance.Class( safeOverlap ) import GHC.Tc.Types.Evidence import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin +import GHC.Tc.Types.EvTerm( evCallStack ) import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad import GHC.Tc.Solver.Types -import GHC.Builtin.Names ( coercibleTyConKey, heqTyConKey, eqTyConKey ) +import GHC.Hs.Type( HsIPName(..) ) -import GHC.Core.Type as Type +import GHC.Builtin.Names ( coercibleTyConKey, heqTyConKey, eqTyConKey, ipClassKey ) + +import GHC.Core +import GHC.Core.Type import GHC.Core.InstEnv ( DFunInstType, Coherence(..) ) import GHC.Core.Class import GHC.Core.Predicate +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.Unify ( ruleMatchTyKiX ) +import GHC.Types.Name.Set import GHC.Types.Var +import GHC.Types.Id( mkTemplateLocals ) import GHC.Types.Var.Set import GHC.Types.SrcLoc import GHC.Types.Var.Env import GHC.Types.Unique( hasKey ) -import GHC.Utils.Monad ( foldlM ) +import GHC.Utils.Monad ( concatMapM, foldlM ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc +import GHC.Data.Bag + import GHC.Driver.Session import qualified GHC.LanguageExtensions as LangExt -import Data.Maybe ( listToMaybe, mapMaybe ) +import Data.Maybe ( listToMaybe, mapMaybe, isJust ) + +import Control.Monad.Trans.Maybe( MaybeT, runMaybeT ) +import Control.Monad.Trans.Class( lift ) +import Control.Monad( mzero ) {- ********************************************************************* @@ -50,23 +64,23 @@ import Data.Maybe ( listToMaybe, mapMaybe ) * * ********************************************************************* -} +solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage Ct +-- NC: this comes from CNonCanonical or CIrredCan +-- Precondition: already rewritten by inert set +solveDictNC ev cls tys + = do { dict_ct <- Stage $ mkDictCt ev cls tys + ; solveDict dict_ct } + solveDict :: DictCt -> SolverStage Ct -- Preconditions: `tys` are already rewritten by the inert set -solveDict dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tyargs = tys }) +solveDict dict_ct@(DictCt { di_ev = ev, di_class = cls, di_tyargs = tys }) = assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ - do { tryInertSet dict_ct + do { tryInertDicts dict_ct ; tryInstances dict_ct ; tryFunDeps dict_ct - ; tryLastResortProhibitedSuperclass dict_ct + ; tryLastResortProhibitedSuperClass dict_ct ; return (CDictCan dict_ct) } -solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage Ct --- NC: this comes from CNonCanonical or CIrredCan --- Precondition: already rewritten by inert set -solveDictNC ev cls tys - = do { dict_ct <- Stage $ mkDictCt ev cls tys - ; solveClass dict_ct } - mkDictCt :: CtEvidence -> Class -> [Type] -> SolverStage DictCt -- Once-only processing of Dict constraints: -- * expand superclasses @@ -78,8 +92,8 @@ mkDictCt ev cls tys ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork (listToBag sc_cts) - ; continueWith (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = doNotExpand }) } + ; continueWith (DictCt { di_ev = ev, di_class = cls + , di_tyargs = tys, di_pend_sc = doNotExpand }) } -- doNotExpand: We have already expanded superclasses for /this/ dict -- so set the fuel to doNotExpand to avoid repeating expansion @@ -107,8 +121,8 @@ mkDictCt ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; continueWith (DictCt { di_ev = new_ev, di_cls = cls - , di_tys = tys, di_pend_sc = doNotExpand }) } + ; continueWith (DictCt { di_ev = new_ev, di_class = cls + , di_tyargs = tys, di_pend_sc = doNotExpand }) } -- doNotExpand: No superclasses for class CallStack -- See invariants in CDictCan.cc_pend_sc @@ -117,8 +131,8 @@ mkDictCt ev cls tys ; let fuel | classHasSCs cls = wantedsFuel dflags | otherwise = doNotExpand -- See Invariants in `CCDictCan.cc_pend_sc` - ; continueWith (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = fuel }) } + ; continueWith (DictCt { di_ev = ev, di_class = cls + , di_tyargs = tys, di_pend_sc = fuel }) } where loc = ctEvLoc ev orig = ctLocOrigin loc @@ -415,10 +429,10 @@ tryInertDicts dict_ct = Stage $ do { inerts <- getInertCans ; try_inert_dicts inerts dict_ct } -try_inert_dicts :: InertCans -> DicCt -> TcS (StopOrContinue ()) -try_inert_dicts inerts ct_w@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs = tys }) - | Just ct_i <- lookupInertDict inerts (ctEvLoc ev_w) cls tys - , let ev_i = ctEvidence ct_i +try_inert_dicts :: InertCans -> DictCt -> TcS (StopOrContinue ()) +try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs = tys }) + | Just dict_i <- lookupInertDict inerts (ctEvLoc ev_w) cls tys + , let ev_i = dictCtEvidence dict_i loc_i = ctEvLoc ev_i loc_w = ctEvLoc ev_w = -- There is a matching dictionary in the inert set @@ -440,18 +454,18 @@ try_inert_dicts inerts ct_w@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs = do { -- The short-cut solver didn't fire, and loopy superclasses -- are dealt with, so we can either solve -- the inert from the work-item or vice-versa. - ; case solveOneFromTheOther ct_i ct_w of - KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr ct_w) + ; case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of + KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) ; setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) - ; return $ Stop ev_w (text "Dict equal" <+> ppr ct_w) } - KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr ct_w) + ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } + KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) ; setEvBindIfWanted ev_i IsCoherent (ctEvTerm ev_w) ; updInertDicts $ \ ds -> delDict ds cls tys ; continueWith () } } } | cls `hasKey` ipClassKey , isGiven ev_w - = interactGivenIP inerts ct_w + = interactGivenIP inerts dict_w | otherwise = continueWith () @@ -567,7 +581,7 @@ shortCutSolver dflags ev_w ev_i ********************************************************************** -} -interactGivenIP :: InertCans -> Ct -> TcS (StopOrContinue a) +interactGivenIP :: InertCans -> DictCt -> TcS (StopOrContinue a) -- Work item is Given (?x:ty) -- See Note [Shadowing of Implicit Parameters] interactGivenIP inerts workItem@(DictCt { di_ev = ev, di_class = cls @@ -581,7 +595,7 @@ interactGivenIP inerts workItem@(DictCt { di_ev = ev, di_class = cls filtered_dicts = addDictsByClass dicts cls other_ip_dicts -- Pick out any Given constraints for the same implicit parameter - is_this_ip (CDictCan { cc_ev = ev, cc_tyargs = ip_str':_ }) + is_this_ip (DictCt { di_ev = ev, di_tyargs = ip_str':_ }) = isGiven ev && ip_str `tcEqType` ip_str' is_this_ip _ = False @@ -646,7 +660,7 @@ I can think of two ways to fix this: 2. Move the shadowing machinery to the location where we nest implications, and add some code here that will produce an error if we get multiple givens for the same implicit parameter. - +-} {- ******************************************************************* * * @@ -1163,7 +1177,7 @@ Test cases: Historical note: a previous solution was to instead pick the local instance with the least superclass depth (see Note [Replacement vs keeping]), but that doesn't work for the example from #22216. - +-} {- ******************************************************************* * * @@ -1171,13 +1185,13 @@ but that doesn't work for the example from #22216. * * **********************************************************************-} -tryLastResortProhibitedSuperclass :: InertSet -> DictCt -> TcS (StopOrContinue Ct) +tryLastResortProhibitedSuperClass :: DictCt -> TcS (StopOrContinue Ct) -- ^ As a last resort, we TEMPORARILY allow a prohibited superclass solve, -- emitting a loud warning when doing so: we might be creating non-terminating -- evidence (as we are in T22912 for example). -- -- See Note [Migrating away from loopy superclass solving] in GHC.Tc.TyCl.Instance. -tryLastResortProhibitedSuperclass dict_ct +tryLastResortProhibitedSuperClass dict_ct = Stage $ do { inerts <- getInertCans ; last_resort inerts dict_ct } @@ -1187,7 +1201,7 @@ last_resort inerts work_item@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs = orig_w = ctLocOrigin loc_w , ScOrigin _ NakedSc <- orig_w -- work_item is definitely Wanted , Just ct_i <- lookupInertDict (inert_cans inerts) loc_w cls xis - , let ev_i = ctEvidence ct_i + , let ev_i = dictCtEvidence ct_i , isGiven ev_i = do { setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) ; ctLocWarnTcS loc_w $ @@ -1197,7 +1211,7 @@ tryLastResortProhibitedSuperclass _ _ = continueWith () -************************************************************************ +{- ********************************************************************* * * * Functional dependencies, instantiation of equations * * @@ -1467,8 +1481,8 @@ doLocalFunDepImprovement (DictCt { di_ev = work_ev, di_class = cls }) work_pred = ctEvPred work_ev work_loc = ctEvLoc work_ev - add_fds :: Bool -> Ct -> TcS Bool - add_fds so_far inert_ct + add_fds :: Bool -> DictCt -> TcS Bool + add_fds so_far (DictCt { di_ev = inert_ev }) | isGiven work_ev && isGiven inert_ev -- Do not create FDs from Given/Given interactions: See Note [No Given/Given fundeps] = return so_far @@ -1485,10 +1499,9 @@ doLocalFunDepImprovement (DictCt { di_ev = work_ev, di_class = cls }) ; return (so_far || unifs) } where - inert_ev = ctEvidence inert_ct inert_pred = ctEvPred inert_ev inert_loc = ctEvLoc inert_ev - inert_rewriters = ctRewriters inert_ct + inert_rewriters = ctEvRewriters inert_ev derived_loc = work_loc { ctl_depth = ctl_depth work_loc `maxSubGoalDepth` ctl_depth inert_loc , ctl_origin = FunDepOrigin1 work_pred @@ -1500,12 +1513,12 @@ doLocalFunDepImprovement (DictCt { di_ev = work_ev, di_class = cls }) doLocalFunDepImprovement work_item = pprPanic "doLocalFunDepImprovement" (ppr work_item) -doTopFunDepImprovement :: Ct -> TcS Bool +doTopFunDepImprovement :: DictCt -> TcS Bool -- Try to functional-dependency improvement between the constraint -- and the top-level instance declarations -- See Note [Fundeps with instances, and equality orientation] -- See also Note [Weird fundeps] -doTopFunDepImprovement work_item@(CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = xis }) +doTopFunDepImprovement work_item@(DictCt { di_ev = ev, di_class = cls, di_tyargs = xis }) = do { traceTcS "try_fundeps" (ppr work_item) ; instEnvs <- getInstEnvs ; let fundep_eqns = improveFromInstEnv instEnvs mk_ct_loc cls xis @@ -1805,7 +1818,7 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + go (CDictCan (DictCt { di_ev = ev, di_class = cls, di_tyargs = tys, di_pend_sc = fuel })) = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always mkStrictSuperClasses fuel ev [] [] cls tys go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) @@ -1987,8 +2000,8 @@ mk_superclasses_of fuel rec_clss ev tvs theta cls tys rec_clss' = rec_clss `extendNameSet` cls_nm mk_this_ct :: ExpansionFuel -> Ct mk_this_ct fuel | null tvs, null theta - = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = fuel } + = CDictCan (DictCt { di_ev = ev, di_class = cls + , di_tyargs = tys, di_pend_sc = fuel }) -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = fuel | otherwise ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -1125,14 +1125,14 @@ data InertCans -- See Note [Detailed InertCans Invariants] for more -- wrt inert_eqs -- Can include both [G] and [W] - , inert_dicts :: DictMap Ct + , inert_dicts :: DictMap DictCt -- Dictionaries only -- All fully rewritten (modulo flavour constraints) -- wrt inert_eqs , inert_insts :: [QCInst] - , inert_safehask :: DictMap Ct + , inert_safehask :: DictMap DictCt -- Failed dictionary resolution due to Safe Haskell overlapping -- instances restriction. We keep this separate from inert_dicts -- as it doesn't cause compilation failure, just safe inference @@ -1371,11 +1371,11 @@ addInertItem tc_lvl addInertItem tc_lvl ics@(IC { inert_irreds = irreds }) ct@(CIrredCan irred) = updateGivenEqs tc_lvl ct $ -- An Irred might turn out to be an - -- equality, so we play safe + -- equality, so we play safe ics { inert_irreds = irreds `snocBag` irred } -addInertItem _ ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) - = ics { inert_dicts = addDict (inert_dicts ics) cls tys item } +addInertItem _ ics (CDictCan dict@(DictCt { di_class = cls, di_tyargs = tys })) + = ics { inert_dicts = addDict (inert_dicts ics) cls tys dict } addInertItem _ _ item = pprPanic "upd_inert set: can't happen! Inserting " $ @@ -1437,14 +1437,14 @@ kickOutRewritableLHS new_fr new_lhs -- constraints, which perhaps may have become soluble after new_lhs -- is substituted; ditto the dictionaries, which may include (a~b) -- or (a~~b) constraints. - kicked_out = (dicts_out `andCts` fmap CIrredCan irs_out) + kicked_out = (fmap CDictCan dicts_out `andCts` fmap CIrredCan irs_out) `extendCtsList` insts_out `extendCtsList` map CEqCan tv_eqs_out `extendCtsList` map CEqCan feqs_out (tv_eqs_out, tv_eqs_in) = partitionInertEqs kick_out_eq tv_eqs (feqs_out, feqs_in) = partitionFunEqs kick_out_eq funeqmap - (dicts_out, dicts_in) = partitionDicts kick_out_ct dictmap + (dicts_out, dicts_in) = partitionDicts (kick_out_ct . CDictCan) dictmap (irs_out, irs_in) = partitionBag (kick_out_ct . CIrredCan) irreds -- Kick out even insolubles: See Note [Rewrite insolubles] -- Of course we must kick out irreducibles like (c a), in case @@ -1677,9 +1677,9 @@ noMatchableGivenDicts inerts@(IS { inert_cans = inert_cans }) loc_w clas tys where pred_w = mkClassPred clas tys - matchable_given :: Ct -> Bool - matchable_given ct - | CtGiven { ctev_loc = loc_g, ctev_pred = pred_g } <- ctEvidence ct + matchable_given :: DictCt -> Bool + matchable_given (DictCt { di_ev = ev }) + | CtGiven { ctev_loc = loc_g, ctev_pred = pred_g } <- ev = isJust $ mightEqualLater inerts pred_g loc_g pred_w loc_w | otherwise ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -157,7 +157,7 @@ solveSimples cts do { sel <- selectNextWorkItem ; case sel of Nothing -> return () - Just ct -> do { runSolverPipeline thePipeline ct + Just ct -> do { runSolverPipeline ct ; solve_loop } } -- | Extract the (inert) givens and invoke the plugins on them. @@ -295,11 +295,9 @@ runTcPluginSolvers solvers all_cts CtWanted {} -> (givens, (ev,ct):wanteds) -runSolverPipeline :: [(String, Ct -> SolverStage Ct)] -- The pipeline - -> Ct -- The work item - -> TcS () +runSolverPipeline :: Ct -> TcS () -- Run this item down the pipeline, leaving behind new work and inerts -runSolverPipeline full_pipeline workItem +runSolverPipeline workItem = do { wl <- getWorkList ; inerts <- getTcSInerts ; tclevel <- getTcLevel @@ -318,7 +316,7 @@ runSolverPipeline full_pipeline workItem solve ct = do { traceTcS "solve {" (text "workitem = " <+> ppr ct) ; res <- runSolverStage (solveCt ct) - ; traceTcS ("end solve }" (ppr res) + ; traceTcS "end solve }" (ppr res) ; case res of StartAgain ct -> do { traceTcS "Go round again" (ppr ct) ; solve ct } @@ -331,7 +329,7 @@ runSolverPipeline full_pipeline workItem -> do { addInertCan ct ; traceFireTcS (ctEvidence ct) (text "Kept as inert") ; traceTcS "End solver pipeline (kept as inert) }" - (text "final_item =" <+> ppr ct) } + (text "final_item =" <+> ppr ct) } } {- Example 1: @@ -358,10 +356,6 @@ React with (a ~ Int) ==> IR (ContinueWith (F Int ~ b)) True [] React with (F Int ~ b) ==> IR Stop True [] -- after substituting we re-canonicalize and get nothing -} -thePipeline :: [(String, Ct -> SolverStage Ct)] -thePipeline = [ ("canonicalization", GHC.Tc.Solver.Canonical.canonicalize) - , ("interact with inerts", interactWithInertsStage) - , ("top-level reactions", topReactionsStage) ] {- ********************************************************************************* ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -371,16 +371,16 @@ maybeKickOut ics ct -- See [Kick out existing binding for implicit parameter] | isGivenCt ct - , CDictCan { cc_class = cls, cc_tyargs = [ip_name_strty, _ip_ty] } <- ct + , CDictCan (DictCt { di_class = cls, di_tyargs = [ip_name_strty, _ip_ty] }) <- ct , isIPClass cls , Just ip_name <- isStrLitTy ip_name_strty -- Would this be more efficient if we used findDictsByClass and then delDict? = let dict_map = inert_dicts ics dict_map' = filterDicts doesn't_match_ip_name dict_map - doesn't_match_ip_name :: Ct -> Bool - doesn't_match_ip_name ct - | Just (inert_ip_name, _inert_ip_ty) <- isIPPred_maybe (ctPred ct) + doesn't_match_ip_name :: DictCt -> Bool + doesn't_match_ip_name (DictCt { di_class = cls, di_tyargs = tys }) + | Just (inert_ip_name, _inert_ip_ty) <- isIPPred_maybe cls tys = inert_ip_name /= ip_name | otherwise @@ -478,24 +478,21 @@ kickOutAfterFillingCoercionHole hole = False -------------- -addInertSafehask :: InertCans -> Ct -> InertCans -addInertSafehask ics item@(CDictCan { cc_class = cls, cc_tyargs = tys }) +addInertSafehask :: InertCans -> DictCt -> InertCans +addInertSafehask ics item@(DictCt { di_class = cls, di_tyargs = tys }) = ics { inert_safehask = addDict (inert_dicts ics) cls tys item } -addInertSafehask _ item - = pprPanic "addInertSafehask: can't happen! Inserting " $ ppr item - -insertSafeOverlapFailureTcS :: InstanceWhat -> Ct -> TcS () +insertSafeOverlapFailureTcS :: InstanceWhat -> DictCt -> TcS () -- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver insertSafeOverlapFailureTcS what item | safeOverlap what = return () | otherwise = updInertCans (\ics -> addInertSafehask ics item) -getSafeOverlapFailures :: TcS Cts +getSafeOverlapFailures :: TcS (Bag DictCt) -- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver getSafeOverlapFailures = do { IC { inert_safehask = safehask } <- getInertCans - ; return $ foldDicts consCts safehask emptyCts } + ; return $ foldDicts consBag safehask emptyBag } -------------- addSolvedDict :: InstanceWhat -> CtEvidence -> Class -> [Type] -> TcS () @@ -551,12 +548,12 @@ updInertCans :: (InertCans -> InertCans) -> TcS () updInertCans upd_fn = updInertTcS $ \ inerts -> inerts { inert_cans = upd_fn (inert_cans inerts) } -updInertDicts :: (DictMap Ct -> DictMap Ct) -> TcS () +updInertDicts :: (DictMap DictCt -> DictMap DictCt) -> TcS () -- Modify the inert set with the supplied function updInertDicts upd_fn = updInertCans $ \ ics -> ics { inert_dicts = upd_fn (inert_dicts ics) } -updInertSafehask :: (DictMap Ct -> DictMap Ct) -> TcS () +updInertSafehask :: (DictMap DictCt -> DictMap DictCt) -> TcS () -- Modify the inert set with the supplied function updInertSafehask upd_fn = updInertCans $ \ ics -> ics { inert_safehask = upd_fn (inert_safehask ics) } @@ -592,14 +589,14 @@ getInertInsols = do { inert <- getInertCans ; let insols = filterBag insolubleIrredCt (inert_irreds inert) unsats = findDictsByTyConKey (inert_dicts inert) unsatisfiableClassNameKey - ; return $ unsats `unionBags` fmap CIrredCan insols } + ; return $ fmap CDictCan unsats `unionBags` fmap CIrredCan insols } getInertGivens :: TcS [Ct] -- Returns the Given constraints in the inert set getInertGivens = do { inerts <- getInertCans ; let all_cts = foldIrreds ((:) . CIrredCan) (inert_irreds inerts) - $ foldDicts (:) (inert_dicts inerts) + $ foldDicts ((:) . CDictCan) (inert_dicts inerts) $ foldFunEqs ((:) . CEqCan) (inert_funeqs inerts) $ foldTyEqs ((:) . CEqCan) (inert_eqs inerts) $ [] @@ -623,28 +620,28 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) -- there are never any Wanteds in the inert set (sc_pending, ic { inert_dicts = dicts', inert_insts = insts' }) where - sc_pending = sc_pend_insts ++ sc_pend_dicts + sc_pending = sc_pend_insts ++ map CDictCan sc_pend_dicts + sc_pend_dicts :: [DictCt] sc_pend_dicts = foldDicts get_pending dicts [] dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 + exhaustAndAdd :: DictCt -> DictMap DictCt -> DictMap DictCt + exhaustAndAdd ct@(DictCt { di_class = cls, di_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {di_pend_sc = doNotExpand}) + + get_pending :: DictCt -> [DictCt] -> [DictCt] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | isPendingScDict dict - , belongs_to_this_level (ctEvidence dict) + | isPendingScDictCt dict + , belongs_to_this_level (dictCtEvidence dict) = dict : dicts | otherwise = dicts - exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct - exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - -- exhaust the fuel for this constraint before adding it as - -- we don't want to expand these constraints again - = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) - exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) - get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci @@ -674,32 +671,31 @@ getUnsolvedInerts , inert_dicts = idicts } <- getInertCans - ; let unsolved_tv_eqs = foldTyEqs add_if_unsolved_eq tv_eqs emptyCts - unsolved_fun_eqs = foldFunEqs add_if_unsolved_eq fun_eqs emptyCts - unsolved_irreds = Bag.filterBag (isWanted . irredCtEvidence) irreds - unsolved_dicts = foldDicts add_if_unsolved idicts emptyCts - unsolved_others = fmap CIrredCan unsolved_irreds `unionBags` - unsolved_dicts + ; let unsolved_tv_eqs = foldTyEqs (add_if_unsolved CEqCan) tv_eqs emptyCts + unsolved_fun_eqs = foldFunEqs (add_if_unsolved CEqCan) fun_eqs emptyCts + unsolved_irreds = foldr (add_if_unsolved CIrredCan) emptyCts irreds + unsolved_dicts = foldDicts (add_if_unsolved CDictCan) idicts emptyCts ; implics <- getWorkListImplics ; traceTcS "getUnsolvedInerts" $ vcat [ text " tv eqs =" <+> ppr unsolved_tv_eqs , text "fun eqs =" <+> ppr unsolved_fun_eqs - , text "others =" <+> ppr unsolved_others + , text "dicts =" <+> ppr unsolved_dicts + , text "irreds =" <+> ppr unsolved_irreds , text "implics =" <+> ppr implics ] ; return ( implics, unsolved_tv_eqs `unionBags` unsolved_fun_eqs `unionBags` - unsolved_others) } + unsolved_irreds `unionBags` + unsolved_dicts ) } where - add_if_unsolved :: Ct -> Cts -> Cts - add_if_unsolved ct cts | isWantedCt ct = ct `consCts` cts - | otherwise = cts - - add_if_unsolved_eq :: EqCt -> Cts -> Cts - add_if_unsolved_eq eq_ct cts | isWanted (eq_ev eq_ct) = CEqCan eq_ct `consCts` cts - | otherwise = cts + add_if_unsolved :: (a -> Ct) -> a -> Cts -> Cts + add_if_unsolved mk_ct thing cts + | isWantedCt ct = ct `consCts` cts + | otherwise = cts + where + ct = mk_ct thing getHasGivenEqs :: TcLevel -- TcLevel of this implication -> TcS ( HasGivenEqs -- are there Given equalities? @@ -743,7 +739,7 @@ removeInertCt :: InertCans -> Ct -> InertCans removeInertCt is ct = case ct of - CDictCan { cc_class = cl, cc_tyargs = tys } -> + CDictCan (DictCt { di_class = cl, di_tyargs = tys }) -> is { inert_dicts = delDict (inert_dicts is) cl tys } CEqCan eq_ct -> delEq is eq_ct @@ -771,7 +767,7 @@ lookupInInerts loc pty | ClassPred cls tys <- classifyPredType pty = do { inerts <- getTcSInerts ; let mb_solved = lookupSolvedDict inerts loc cls tys - mb_inert = fmap ctEvidence (lookupInertDict (inert_cans inerts) loc cls tys) + mb_inert = fmap dictCtEvidence (lookupInertDict (inert_cans inerts) loc cls tys) ; return $ do -- Maybe monad found_ev <- mb_solved `mplus` mb_inert @@ -786,7 +782,7 @@ lookupInInerts loc pty = return Nothing -- | Look up a dictionary inert. -lookupInertDict :: InertCans -> CtLoc -> Class -> [Type] -> Maybe Ct +lookupInertDict :: InertCans -> CtLoc -> Class -> [Type] -> Maybe DictCt lookupInertDict (IC { inert_dicts = dicts }) loc cls tys = case findDict dicts loc cls tys of Just ct -> Just ct ===================================== compiler/GHC/Tc/Solver/Types.hs ===================================== @@ -157,24 +157,21 @@ delDict m cls tys = delTcApp m (classTyCon cls) tys addDict :: DictMap a -> Class -> [Type] -> a -> DictMap a addDict m cls tys item = insertTcApp m (classTyCon cls) tys item -addDictsByClass :: DictMap Ct -> Class -> Bag Ct -> DictMap Ct +addDictsByClass :: DictMap DictCt -> Class -> Bag DictCt -> DictMap DictCt addDictsByClass m cls items = extendDTyConEnv m (classTyCon cls) (foldr add emptyTM items) where - add ct@(CDictCan { cc_tyargs = tys }) tm = insertTM tys ct tm - add ct _ = pprPanic "addDictsByClass" (ppr ct) + add ct@(DictCt { di_tyargs = tys }) tm = insertTM tys ct tm -filterDicts :: (Ct -> Bool) -> DictMap Ct -> DictMap Ct +filterDicts :: (DictCt -> Bool) -> DictMap DictCt -> DictMap DictCt filterDicts f m = filterTcAppMap f m -partitionDicts :: (Ct -> Bool) -> DictMap Ct -> (Bag Ct, DictMap Ct) +partitionDicts :: (DictCt -> Bool) -> DictMap DictCt -> (Bag DictCt, DictMap DictCt) partitionDicts f m = foldTcAppMap k m (emptyBag, emptyDictMap) where k ct (yeses, noes) | f ct = (ct `consBag` yeses, noes) | otherwise = (yeses, add ct noes) - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) m - = addDict m cls tys ct - add ct _ = pprPanic "partitionDicts" (ppr ct) + add ct@(DictCt { di_class = cls, di_tyargs = tys }) m = addDict m cls tys ct dictsToBag :: DictMap a -> Bag a dictsToBag = tcAppMapToBag ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Tc.Types.Constraint ( Xi, Ct(..), EqCt(..), Cts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, emptyCts, andCts, ctsPreds, - isPendingScDict, pendingScDict_maybe, + isPendingScDictCt, isPendingScDict, pendingScDict_maybe, superClassesMightHelp, getPendingWantedScs, isWantedCt, isGivenCt, isTopLevelUserTypeError, containsUserTypeError, getUserTypeErrorMsg, @@ -29,6 +29,7 @@ module GHC.Tc.Types.Constraint ( tyCoVarsOfCt, tyCoVarsOfCts, tyCoVarsOfCtList, tyCoVarsOfCtsList, + DictCt(..), dictCtEvidence, IrredCt(..), mkIrredCt, ctIrredCt, irredCtEvidence, irredCtPred, ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, @@ -203,8 +204,8 @@ data Ct --------------- DictCt -------------- -data DictCt = DictCt { -- e.g. Num ty - = DictCt { di_ev :: CtEvidence, -- See Note [Ct/evidence invariant] +data DictCt -- e.g. Num ty + = DictCt { di_ev :: CtEvidence -- See Note [Ct/evidence invariant] , di_class :: Class , di_tyargs :: [Xi] -- di_tyargs are rewritten w.r.t. inerts, so Xi @@ -217,6 +218,12 @@ data DictCt = DictCt { -- e.g. Num ty -- (b) those superclasses are not yet explored } +dictCtEvidence :: DictCt -> CtEvidence +dictCtEvidence = di_ev + +instance Outputable DictCt where + ppr dict = ppr (CDictCan dict) + --------------- EqCt -------------- {- Note [Canonical equalities] @@ -717,7 +724,7 @@ updCtEvidence upd ct CEqCan eq@(EqCt { eq_ev = ev }) -> CEqCan (eq { eq_ev = upd ev }) CIrredCan ir@(IrredCt { ir_ev = ev }) -> CIrredCan (ir { ir_ev = upd ev }) CNonCanonical ev -> CNonCanonical (upd ev) - CDictCan { cc_ev = ev } -> ct { cc_ev = upd ev } + CDictCan di@(DictCt { di_ev = ev }) -> CDictCan (di { di_ev = upd ev }) ctLoc :: Ct -> CtLoc ctLoc = ctEvLoc . ctEvidence @@ -773,7 +780,7 @@ instance Outputable Ct where pp_sort = case ct of CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" - CDictCan (DictCt { ci_pend_sc = psc }) + CDictCan (DictCt { di_pend_sc = psc }) | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CDictCan" CIrredCan (IrredCt { ir_reason = reason }) -> text "CIrredCan" <> ppr reason @@ -1022,16 +1029,19 @@ isUnsatisfiableCt_maybe t = Nothing isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan (DictCt { di_pend_sc = f })) = pendingFuel f +isPendingScDict (CDictCan dict_ct) = isPendingScDictCt dict_ct +isPendingScDict _ = False + +isPendingScDictCt :: DictCt -> Bool -- Says whether this is a CDictCan with di_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses -isPendingScDict _ = False +isPendingScDictCt (DictCt { di_pend_sc = f }) = pendingFuel f pendingScDict_maybe :: Ct -> Maybe Ct -- Says whether this is a CDictCan with di_pend_sc has fuel left, -- AND if so exhausts the fuel so that they are not expanded again -pendingScDict_maybe ct@(CDictCan (DictCt { di_pend_sc = f })) - | pendingFuel f = Just (ct { di_pend_sc = doNotExpand }) +pendingScDict_maybe (CDictCan dict@(DictCt { di_pend_sc = f })) + | pendingFuel f = Just (CDictCan (dict { di_pend_sc = doNotExpand })) | otherwise = Nothing pendingScDict_maybe _ = Nothing @@ -2156,12 +2166,16 @@ eqCtFlavourRole :: EqCt -> CtFlavourRole eqCtFlavourRole (EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = (ctEvFlavour ev, eq_rel) +dictCtFlavourRole :: DictCt -> CtFlavourRole +dictCtFlavourRole (DictCt { di_ev = ev }) + = (ctEvFlavour ev, NomEq) + -- | Extract the flavour and role from a 'Ct' ctFlavourRole :: Ct -> CtFlavourRole -- Uses short-cuts to role for special cases -ctFlavourRole (CDictCan { cc_ev = ev }) = (ctEvFlavour ev, NomEq) -ctFlavourRole (CEqCan eq_ct) = eqCtFlavourRole eq_ct -ctFlavourRole ct = ctEvFlavourRole (ctEvidence ct) +ctFlavourRole (CDictCan di_ct) = dictCtFlavourRole di_ct +ctFlavourRole (CEqCan eq_ct) = eqCtFlavourRole eq_ct +ctFlavourRole ct = ctEvFlavourRole (ctEvidence ct) {- Note [eqCanRewrite] ~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -2455,10 +2455,10 @@ creates e.g. a CDictCan where the cc_tyars are /not/ fully reduced. zonkCt :: Ct -> TcM Ct -- See Note [zonkCt behaviour] -zonkCt ct@(CDictCan { cc_ev = ev, cc_tyargs = args }) +zonkCt (CDictCan dict@(DictCt { di_ev = ev, di_tyargs = args })) = do { ev' <- zonkCtEvidence ev ; args' <- mapM zonkTcType args - ; return $ ct { cc_ev = ev', cc_tyargs = args' } } + ; return (CDictCan (dict { di_ev = ev', di_tyargs = args' })) } zonkCt (CEqCan (EqCt { eq_ev = ev })) = mkNonCanonical <$> zonkCtEvidence ev @@ -2792,18 +2792,19 @@ naughtyQuantification orig_ty tv escapees zonkCtRewriterSet :: Ct -> TcM Ct zonkCtRewriterSet ct - | isGivenCt ct = return ct + | isGivenCt ct + = return ct | otherwise = case ct of CEqCan eq@(EqCt { eq_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev ; return (CEqCan (eq { eq_ev = ev' })) } CIrredCan ir@(IrredCt { ir_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev ; return (CIrredCan (ir { ir_ev = ev' })) } - CNonCanonical ev -> do { ev' <- zonkCtEvRewriterSet ev - ; return (CNonCanonical ev') } - CDictCan { cc_ev = ev } -> do { ev' <- zonkCtEvRewriterSet ev - ; return (ct { cc_ev = ev' }) } - CQuantCan {} -> return ct + CDictCan di@(DictCt { di_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev + ; return (CDictCan (di { di_ev = ev' })) } + CQuantCan {} -> return ct + CNonCanonical ev -> do { ev' <- zonkCtEvRewriterSet ev + ; return (CNonCanonical ev') } zonkCtEvRewriterSet :: CtEvidence -> TcM CtEvidence zonkCtEvRewriterSet ev@(CtGiven {}) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6279c5c94f427a84b148daf011e397c535125e26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6279c5c94f427a84b148daf011e397c535125e26 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 9 23:42:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 19:42:26 -0400 Subject: [Git][ghc/ghc][wip/export-finaliser-exceptions] 194 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <645ada62748a1_38ffdadf5989d814537e@gitlab.mail> Ben Gamari pushed to branch wip/export-finaliser-exceptions at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 638fe928 by Ben Gamari at 2023-05-09T19:42:16-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6c7acfd3f8325a1e7c67c3a171709926b12b03a...638fe9281a621ffadc9e1e5972538e475b53b144 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6c7acfd3f8325a1e7c67c3a171709926b12b03a...638fe9281a621ffadc9e1e5972538e475b53b144 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 00:40:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 09 May 2023 20:40:21 -0400 Subject: [Git][ghc/ghc][wip/T23163] ghc-prim: Generalize keepAlive#/touch# in state token type Message-ID: <645ae7f543d16_38ffdae44261a4148276b@gitlab.mail> Ben Gamari pushed to branch wip/T23163 at Glasgow Haskell Compiler / GHC Commits: a6e07e03 by Ben Gamari at 2023-05-09T20:40:14-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 2 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/ghc-prim/changelog.md Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3407,7 +3407,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp out_of_line = True primop TouchOp "touch#" GenPrimOp - v -> State# RealWorld -> State# RealWorld + v -> State# s -> State# s with code_size = { 0 } has_side_effects = True @@ -3723,7 +3723,7 @@ section "Controlling object lifetime" -- and "p" is the same as "b" except representation-polymorphic. -- See Note [Levity and representation polymorphic primops] primop KeepAliveOp "keepAlive#" GenPrimOp - v -> State# RealWorld -> (State# RealWorld -> p) -> p + v -> State# s -> (State# s -> p) -> p { @'keepAlive#' x s k@ keeps the value @x@ alive during the execution of the computation @k at . ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -14,6 +14,8 @@ - `sameMutVar#`, `sameTVar#`, `sameMVar#` - `sameIOPort#`, `eqStableName#`. +- `keepAlive#` and `touch#` are now polymorphic in their state token (#23163; [CLC#152](https://github.com/haskell/core-libraries-committee/issues/152)) + - Several new primops were added: - `copyMutableByteArrayNonOverlapping#` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a6e07e0316e2dcfcc2f76b1c5fa0ff04a4ee0e6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a6e07e0316e2dcfcc2f76b1c5fa0ff04a4ee0e6b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 02:23:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 22:23:00 -0400 Subject: [Git][ghc/ghc][master] Adjust AArch64 stackFrameHeaderSize Message-ID: <645b000481cbf_38ffdae72debf41503069@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -32,9 +32,9 @@ import Data.Maybe (fromMaybe) import GHC.Stack --- | TODO: verify this! -stackFrameHeaderSize :: Platform -> Int -stackFrameHeaderSize _ = 64 +-- | LR and FP (8 byte each) are the prologue of each stack frame +stackFrameHeaderSize :: Int +stackFrameHeaderSize = 2 * 8 -- | All registers are 8 byte wide. spillSlotSize :: Int @@ -49,14 +49,13 @@ stackAlign = 16 maxSpillSlots :: NCGConfig -> Int maxSpillSlots config -- = 0 -- set to zero, to see when allocMoreStack has to fire. - = let platform = ncgPlatform config - in ((ncgSpillPreallocSize config - stackFrameHeaderSize platform) + = ((ncgSpillPreallocSize config - stackFrameHeaderSize) `div` spillSlotSize) - 1 -- | Convert a spill slot number to a *byte* offset, with no sign. spillSlotToOffset :: NCGConfig -> Int -> Int -spillSlotToOffset config slot - = stackFrameHeaderSize (ncgPlatform config) + spillSlotSize * slot +spillSlotToOffset _ slot + = stackFrameHeaderSize + spillSlotSize * slot -- | Get the registers that are being used by this instruction. -- regUsage doesn't need to do any trickery for jumps and such. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0657b4820bb0ff2811b27c510204996ec3d31898 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0657b4820bb0ff2811b27c510204996ec3d31898 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 02:23:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 09 May 2023 22:23:39 -0400 Subject: [Git][ghc/ghc][master] Make `(&)` representation polymorphic in the return type Message-ID: <645b002ba9459_38ffdae905ce6015065bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - 2 changed files: - libraries/base/Data/Function.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Data/Function.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-} @@ -28,7 +30,7 @@ module Data.Function , applyWhen ) where -import GHC.Base ( ($), (.), id, const, flip ) +import GHC.Base ( TYPE, ($), (.), id, const, flip ) import Data.Bool ( Bool(..) ) infixl 0 `on` @@ -120,7 +122,7 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c -- "6" -- -- @since 4.8.0.0 -(&) :: a -> (a -> b) -> b +(&) :: forall r a (b :: TYPE r). a -> (a -> b) -> b x & f = f x -- | 'applyWhen' applies a function to a value if a condition is true, ===================================== libraries/base/changelog.md ===================================== @@ -21,9 +21,10 @@ ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149)) * Make `($)` representation polymorphic ([CLC proposal #132](https://github.com/haskell/core-libraries-committee/issues/132)) * Implemented [GHC Proposal #433](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0433-unsatisfiable.rst), - adding the class `Unsatisfiable :: ErrorMessage -> TypeError`` to `GHC.TypeError`, + adding the class `Unsatisfiable :: ErrorMessage -> TypeError` to `GHC.TypeError`, which provides a mechanism for custom type errors that reports the errors in - a more predictable behaviour than ``TypeError``. + a more predictable behaviour than `TypeError`. + * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7788c09c787fce817cf5a44c34ba538a39388c1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7788c09c787fce817cf5a44c34ba538a39388c1c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 06:26:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 May 2023 02:26:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Adjust AArch64 stackFrameHeaderSize Message-ID: <645b392670a0c_38ffdafab9571c15940e6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - 6ddb2302 by Ben Gamari at 2023-05-10T02:26:37-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - ab8d3510 by Cheng Shao at 2023-05-10T02:26:39-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 6 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - libraries/base/Data/Function.hs - libraries/base/changelog.md - libraries/ghc-prim/changelog.md - utils/hsc2hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3407,7 +3407,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp out_of_line = True primop TouchOp "touch#" GenPrimOp - v -> State# RealWorld -> State# RealWorld + v -> State# s -> State# s with code_size = { 0 } has_side_effects = True @@ -3723,7 +3723,7 @@ section "Controlling object lifetime" -- and "p" is the same as "b" except representation-polymorphic. -- See Note [Levity and representation polymorphic primops] primop KeepAliveOp "keepAlive#" GenPrimOp - v -> State# RealWorld -> (State# RealWorld -> p) -> p + v -> State# s -> (State# s -> p) -> p { @'keepAlive#' x s k@ keeps the value @x@ alive during the execution of the computation @k at . ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -32,9 +32,9 @@ import Data.Maybe (fromMaybe) import GHC.Stack --- | TODO: verify this! -stackFrameHeaderSize :: Platform -> Int -stackFrameHeaderSize _ = 64 +-- | LR and FP (8 byte each) are the prologue of each stack frame +stackFrameHeaderSize :: Int +stackFrameHeaderSize = 2 * 8 -- | All registers are 8 byte wide. spillSlotSize :: Int @@ -49,14 +49,13 @@ stackAlign = 16 maxSpillSlots :: NCGConfig -> Int maxSpillSlots config -- = 0 -- set to zero, to see when allocMoreStack has to fire. - = let platform = ncgPlatform config - in ((ncgSpillPreallocSize config - stackFrameHeaderSize platform) + = ((ncgSpillPreallocSize config - stackFrameHeaderSize) `div` spillSlotSize) - 1 -- | Convert a spill slot number to a *byte* offset, with no sign. spillSlotToOffset :: NCGConfig -> Int -> Int -spillSlotToOffset config slot - = stackFrameHeaderSize (ncgPlatform config) + spillSlotSize * slot +spillSlotToOffset _ slot + = stackFrameHeaderSize + spillSlotSize * slot -- | Get the registers that are being used by this instruction. -- regUsage doesn't need to do any trickery for jumps and such. ===================================== libraries/base/Data/Function.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-} @@ -28,7 +30,7 @@ module Data.Function , applyWhen ) where -import GHC.Base ( ($), (.), id, const, flip ) +import GHC.Base ( TYPE, ($), (.), id, const, flip ) import Data.Bool ( Bool(..) ) infixl 0 `on` @@ -120,7 +122,7 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c -- "6" -- -- @since 4.8.0.0 -(&) :: a -> (a -> b) -> b +(&) :: forall r a (b :: TYPE r). a -> (a -> b) -> b x & f = f x -- | 'applyWhen' applies a function to a value if a condition is true, ===================================== libraries/base/changelog.md ===================================== @@ -21,9 +21,10 @@ ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149)) * Make `($)` representation polymorphic ([CLC proposal #132](https://github.com/haskell/core-libraries-committee/issues/132)) * Implemented [GHC Proposal #433](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0433-unsatisfiable.rst), - adding the class `Unsatisfiable :: ErrorMessage -> TypeError`` to `GHC.TypeError`, + adding the class `Unsatisfiable :: ErrorMessage -> TypeError` to `GHC.TypeError`, which provides a mechanism for custom type errors that reports the errors in - a more predictable behaviour than ``TypeError``. + a more predictable behaviour than `TypeError`. + * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -14,6 +14,8 @@ - `sameMutVar#`, `sameTVar#`, `sameMVar#` - `sameIOPort#`, `eqStableName#`. +- `keepAlive#` and `touch#` are now polymorphic in their state token (#23163; [CLC#152](https://github.com/haskell/core-libraries-committee/issues/152)) + - Several new primops were added: - `copyMutableByteArrayNonOverlapping#` ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 1ba092932f86c1fda15091d355ba7975b8554437 +Subproject commit f70b360b295298e4da10afe02ebf022b21342008 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d137ce9c9a8fbdac3105167fa039269b2c35e477...ab8d351049cf3baaa8af8a8d069da21849f4edbe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d137ce9c9a8fbdac3105167fa039269b2c35e477...ab8d351049cf3baaa8af8a8d069da21849f4edbe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 07:36:32 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 10 May 2023 03:36:32 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] Move "target has RTS linker" out of settings Message-ID: <645b498029ee8_38ffda101130ab81637079@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: 2b768e9e by Rodrigo Mesquita at 2023-05-10T08:36:21+01:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4727,8 +4727,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . ===================================== compiler/GHC/Platform.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Platform , platformInIntRange , platformInWordRange , platformCConvNeedsExtension + , platformHasRTSLinker , PlatformMisc(..) , SseVersion (..) , BmiVersion (..) @@ -271,6 +272,23 @@ platformCConvNeedsExtension platform = case platformArch platform of | OSDarwin <- platformOS platform -> True _ -> False +-- | Does this platform have an RTS linker? +platformHasRTSLinker :: Platform -> Bool +-- Note that we've inlined this logic in hadrian's +-- Settings.Builders.RunTest.inTreeCompilerArgs. +-- If you change this, be sure to change it too +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- powerpc + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + -------------------------------------------------- -- Instruction sets ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -451,7 +451,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -126,7 +126,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- For this information, we need to query ghc --info, however, that would + -- require building ghc, which we don't want to do here. Therefore, the + -- logic from `platformHasRTSLinker` is duplicated here. + let rtsLinker = not $ arch `elem` ["powerpc", "powerpc64", "powerpc64le", "s390x", "riscv64", "loongarch64", "javascript", "wasm32"] return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b768e9e1b5e541877df518f6616f9a5463304ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b768e9e1b5e541877df518f6616f9a5463304ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 08:26:17 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 10 May 2023 04:26:17 -0400 Subject: [Git][ghc/ghc][wip/T23333] 18 commits: driver: Use hooks from plugin_hsc_env Message-ID: <645b55299e741_38ffda10590d2f01666565@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23333 at Glasgow Haskell Compiler / GHC Commits: a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - a532f1d9 by Simon Peyton Jones at 2023-05-10T09:28:16+01:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Printer.hs → compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a5c1de9893d7496903989c12353ec903c049ed6c...a532f1d91bddf5d068e125a7885b3eed7a5c0fee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a5c1de9893d7496903989c12353ec903c049ed6c...a532f1d91bddf5d068e125a7885b3eed7a5c0fee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 09:07:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 May 2023 05:07:07 -0400 Subject: [Git][ghc/ghc][master] ghc-prim: Generalize keepAlive#/touch# in state token type Message-ID: <645b5ebb243f4_38ffda1086ed26016958f4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 2 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/ghc-prim/changelog.md Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3407,7 +3407,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp out_of_line = True primop TouchOp "touch#" GenPrimOp - v -> State# RealWorld -> State# RealWorld + v -> State# s -> State# s with code_size = { 0 } has_side_effects = True @@ -3723,7 +3723,7 @@ section "Controlling object lifetime" -- and "p" is the same as "b" except representation-polymorphic. -- See Note [Levity and representation polymorphic primops] primop KeepAliveOp "keepAlive#" GenPrimOp - v -> State# RealWorld -> (State# RealWorld -> p) -> p + v -> State# s -> (State# s -> p) -> p { @'keepAlive#' x s k@ keeps the value @x@ alive during the execution of the computation @k at . ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -14,6 +14,8 @@ - `sameMutVar#`, `sameTVar#`, `sameMVar#` - `sameIOPort#`, `eqStableName#`. +- `keepAlive#` and `touch#` are now polymorphic in their state token (#23163; [CLC#152](https://github.com/haskell/core-libraries-committee/issues/152)) + - Several new primops were added: - `copyMutableByteArrayNonOverlapping#` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b31959221dcf3410f4cc3b7710478e9eaf9ea783 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b31959221dcf3410f4cc3b7710478e9eaf9ea783 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 09:07:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 May 2023 05:07:50 -0400 Subject: [Git][ghc/ghc][master] Bump hsc2hs submodule Message-ID: <645b5ee6969a6_38ffda109044afc1701493@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 1 changed file: - utils/hsc2hs Changes: ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 1ba092932f86c1fda15091d355ba7975b8554437 +Subproject commit f70b360b295298e4da10afe02ebf022b21342008 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e6861dd8612d8f71cc4635c4f73f84f316a6c7e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e6861dd8612d8f71cc4635c4f73f84f316a6c7e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 10:00:13 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 May 2023 06:00:13 -0400 Subject: [Git][ghc/ghc][wip/t22884] 26 commits: Add structured error messages for GHC.Rename.Utils Message-ID: <645b6b2daf61d_38ffda10e6cb5101736923@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - cf9327a5 by Matthew Pickering at 2023-05-10T10:43:09+01:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 84d92184 by Matthew Pickering at 2023-05-10T10:43:09+01:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - 2ce94881 by Matthew Pickering at 2023-05-10T10:55:18+01:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 3dacbdb7 by Matthew Pickering at 2023-05-10T10:55:29+01:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 87299e28 by Matthew Pickering at 2023-05-10T10:59:56+01:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8d121c46fe63cdff2324d09b882978e0b815012...87299e2831abfc6f90475e3d380ea03fd6a3e37f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8d121c46fe63cdff2324d09b882978e0b815012...87299e2831abfc6f90475e3d380ea03fd6a3e37f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 10:21:05 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 10 May 2023 06:21:05 -0400 Subject: [Git][ghc/ghc][wip/compact-sourcetext] testsuite: add test for T22744 Message-ID: <645b701159a6f_38ffda11028367c17566d4@gitlab.mail> Zubin pushed to branch wip/compact-sourcetext at Glasgow Haskell Compiler / GHC Commits: 48435306 by Zubin Duggal at 2023-05-10T15:50:56+05:30 testsuite: add test for T22744 - - - - - 3 changed files: - testsuite/tests/perf/compiler/Makefile - testsuite/tests/perf/compiler/all.T - + testsuite/tests/perf/compiler/genT22744 Changes: ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -32,3 +32,8 @@ MultiLayerModulesTH_OneShot_Prep: MultiLayerModulesTH_Make_Prep InstanceMatching: ./genMatchingTest 0 '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface Defs.hs + +T22744: + ./genT22744 + '$(TEST_HC)' $(TEST_HC_OPTS) T22744.hs + ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -670,3 +670,13 @@ test('RecordUpdPerf', ], multimod_compile, ['RecordUpdPerf', '-fno-code -v0']) + +test('T22744', + [ collect_compiler_stats('peak_megabytes_allocated',20), + pre_cmd('$MAKE -s --no-print-directory T22744'), + extra_files(['genT22744']), + compile_timeout_multiplier(2) + ], + multimod_compile, + ['T22744', '-v0']) + ===================================== testsuite/tests/perf/compiler/genT22744 ===================================== @@ -0,0 +1,28 @@ +#!/usr/bin/env bash + +NUMDEP=10000 +NUMMOD=100 + +seq 1 $NUMDEP | xargs -I{} touch foo{} + +cat > T22744.hs << EOF +module Main where +EOF + +for i in $(seq $NUMMOD); do + cat > M$i.hs << EOF +{-# LANGUAGE TemplateHaskell #-} +module M$i where +import Language.Haskell.TH.Syntax +import Control.Monad + +\$(do forM_ [1..$NUMDEP] $ \i -> addDependentFile $ "foo" ++ show i + return []) +EOF + echo "import M$i" >> T22744.hs +done + +cat >> T22744.hs << EOF +main = pure () +EOF + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48435306f9d518deb11c3641369017df547debb4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48435306f9d518deb11c3641369017df547debb4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 10:30:13 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 May 2023 06:30:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tmpdir Message-ID: <645b72354b6da_38ffda1114d494817636f7@gitlab.mail> Matthew Pickering pushed new branch wip/tmpdir at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tmpdir You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 10:39:06 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 May 2023 06:39:06 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: ghc-prim: Generalize keepAlive#/touch# in state token type Message-ID: <645b744aecc0_38ffda11128bb2817695da@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - c004f052 by Matthew Pickering at 2023-05-10T06:38:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 875d394a by Rodrigo Mesquita at 2023-05-10T06:38:56-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - 16 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/ghc-prim/changelog.md - utils/hsc2hs Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -424,7 +424,7 @@ distroVariables Alpine = mconcat -- T10458, ghcilink002: due to #17869 -- linker_unload_native: due to musl not supporting any means of probing dynlib dependencies -- (see Note [Object unloading]). - , "BROKEN_TESTS" =: "encoding004 T10458 ghcilink002 linker_unload_native" + , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native" ] distroVariables Centos7 = mconcat [ "HADRIAN_ARGS" =: "--docs=no-sphinx" @@ -903,8 +903,11 @@ job_groups = , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) - , standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static) - , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + -- Fully static build, in theory usable on any linux distribution. + , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) + -- Dynamically linked build, suitable for building your own static executables on alpine + , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) + , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") ) @@ -919,6 +922,10 @@ job_groups = ] where + + -- ghcilink002 broken due to #17869 + fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 ") + hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url") tsan_jobs = ===================================== .gitlab/jobs.yaml ===================================== @@ -597,7 +597,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -606,6 +606,68 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-alpine3_12-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "8 weeks", + "paths": [ + "ghc-x86_64-linux-alpine3_12-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--docs=no-sphinx", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -659,7 +721,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -2472,7 +2534,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2535,7 +2597,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2545,6 +2607,69 @@ "XZ_OPT": "-9" } }, + "release-x86_64-linux-alpine3_12-release+no_split_sections": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "release+no_split_sections", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", + "IGNORE_PERF_FAILURES": "all", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", + "XZ_OPT": "-9" + } + }, "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3581,7 +3706,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -30,6 +30,7 @@ def job_triple(job_name): 'release-x86_64-linux-deb9-release': 'x86_64-deb9-linux', 'release-x86_64-linux-centos7-release': 'x86_64-centos7-linux', 'release-x86_64-linux-alpine3_12-release+fully_static': 'x86_64-alpine3_12-linux-static', + 'release-x86_64-linux-alpine3_12-release': 'x86_64-alpine3_12-linux', 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3407,7 +3407,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp out_of_line = True primop TouchOp "touch#" GenPrimOp - v -> State# RealWorld -> State# RealWorld + v -> State# s -> State# s with code_size = { 0 } has_side_effects = True @@ -3723,7 +3723,7 @@ section "Controlling object lifetime" -- and "p" is the same as "b" except representation-polymorphic. -- See Note [Levity and representation polymorphic primops] primop KeepAliveOp "keepAlive#" GenPrimOp - v -> State# RealWorld -> (State# RealWorld -> p) -> p + v -> State# s -> (State# s -> p) -> p { @'keepAlive#' x s k@ keeps the value @x@ alive during the execution of the computation @k at . ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4830,8 +4830,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . ===================================== compiler/GHC/Platform.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Platform , platformInIntRange , platformInWordRange , platformCConvNeedsExtension + , platformHasRTSLinker , PlatformMisc(..) , SseVersion (..) , BmiVersion (..) @@ -271,6 +272,23 @@ platformCConvNeedsExtension platform = case platformArch platform of | OSDarwin <- platformOS platform -> True _ -> False +-- | Does this platform have an RTS linker? +platformHasRTSLinker :: Platform -> Bool +-- Note that we've inlined this logic in hadrian's +-- Settings.Builders.RunTest.inTreeCompilerArgs. +-- If you change this, be sure to change it too +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- powerpc + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + -------------------------------------------------- -- Instruction sets ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -448,7 +448,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -134,7 +134,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- For this information, we need to query ghc --info, however, that would + -- require building ghc, which we don't want to do here. Therefore, the + -- logic from `platformHasRTSLinker` is duplicated here. + let rtsLinker = not $ arch `elem` ["powerpc", "powerpc64", "powerpc64le", "s390x", "riscv64", "loongarch64", "javascript", "wasm32"] return TestCompilerArgs{..} ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -14,6 +14,8 @@ - `sameMutVar#`, `sameTVar#`, `sameMVar#` - `sameIOPort#`, `eqStableName#`. +- `keepAlive#` and `touch#` are now polymorphic in their state token (#23163; [CLC#152](https://github.com/haskell/core-libraries-committee/issues/152)) + - Several new primops were added: - `copyMutableByteArrayNonOverlapping#` ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 1ba092932f86c1fda15091d355ba7975b8554437 +Subproject commit f70b360b295298e4da10afe02ebf022b21342008 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab8d351049cf3baaa8af8a8d069da21849f4edbe...875d394a498dbacc7a6527cbc4c5ebd612c1ab36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab8d351049cf3baaa8af8a8d069da21849f4edbe...875d394a498dbacc7a6527cbc4c5ebd612c1ab36 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 10:50:13 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 10 May 2023 06:50:13 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <645b76e5eeac2_38ffda111602fa417861e3@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: efb8ddf7 by Andrei Borzenkov at 2023-05-10T14:49:53+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - + docs/users_guide/exts/implicit_forall.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/exts/type_signatures.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.stderr - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/efb8ddf7177102885d14e03c799bd5fa5c69b7a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/efb8ddf7177102885d14e03c799bd5fa5c69b7a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 12:15:53 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 10 May 2023 08:15:53 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] 39 commits: Add sized primitive literal syntax Message-ID: <645b8af9b9ddf_38ffda1168ca98018469b1@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 5d03e635 by Josh Meredith at 2023-05-10T12:15:26+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47e635e7b1a24e359ddd914086757b6b6640cc7c...5d03e6358e0be0434bee4c3a9b497c78344f1ce6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47e635e7b1a24e359ddd914086757b6b6640cc7c...5d03e6358e0be0434bee4c3a9b497c78344f1ce6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 13:07:19 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 10 May 2023 09:07:19 -0400 Subject: [Git][ghc/ghc][wip/T23309] 54 commits: ci: update ci.sh to actually run the entire testsuite for wasm backend Message-ID: <645b9707cf132_38ffda11a9bd5f018767a3@gitlab.mail> Ryan Scott pushed to branch wip/T23309 at Glasgow Haskell Compiler / GHC Commits: d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 73dacb83 by Ryan Scott at 2023-05-10T09:02:19-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - d2013f4d by Ryan Scott at 2023-05-10T09:04:07-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08a6c141d9da2c268a561a222b58c7c4db91b6f1...d2013f4dac3890aa67a8ec6b3b9b7999ca61dca8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08a6c141d9da2c268a561a222b58c7c4db91b6f1...d2013f4dac3890aa67a8ec6b3b9b7999ca61dca8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 13:13:38 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 10 May 2023 09:13:38 -0400 Subject: [Git][ghc/ghc][wip/T21278] 66 commits: hadrian: Pass haddock file arguments in a response file Message-ID: <645b9882209e4_38ffda11af75dd01880911@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T21278 at Glasgow Haskell Compiler / GHC Commits: f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - 1d5e550f by Krzysztof Gogolewski at 2023-05-10T15:13:04+02:00 Add a test for #21278 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/899d2b4191eb05f67f46e0ab8a0e793fcd82c225...1d5e550f743855b3f458deffb7a1e7265808ad04 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/899d2b4191eb05f67f46e0ab8a0e793fcd82c225...1d5e550f743855b3f458deffb7a1e7265808ad04 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 14:49:36 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 10 May 2023 10:49:36 -0400 Subject: [Git][ghc/ghc][wip/T23070-unify] 39 commits: Add sized primitive literal syntax Message-ID: <645baf00bf4db_38ffda120be3d101928170@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-unify at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - cc4ff3b8 by Simon Peyton Jones at 2023-05-10T15:51:29+01:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06072d2f547e84af96c07bd21091773135ffc6c9...cc4ff3b8e146f0ed134ae848ddcc4434c47502dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06072d2f547e84af96c07bd21091773135ffc6c9...cc4ff3b8e146f0ed134ae848ddcc4434c47502dc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 14:53:07 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 May 2023 10:53:07 -0400 Subject: [Git][ghc/ghc][wip/t22884] 4 commits: Generalise UnknownDiagnostic to allow embedded diagnostics to access Message-ID: <645bafd356392_38ffda1216cb5e8193149a@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: a68adbe3 by Matthew Pickering at 2023-05-10T15:47:31+01:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - 556bc70b by Matthew Pickering at 2023-05-10T15:47:31+01:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 44b4467d by Matthew Pickering at 2023-05-10T15:47:31+01:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 3635f32f by Matthew Pickering at 2023-05-10T15:47:31+01:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 30 changed files: - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - + testsuite/tests/package/T22884.hs - + testsuite/tests/package/T22884.stderr - + testsuite/tests/package/T22884_interactive.script The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87299e2831abfc6f90475e3d380ea03fd6a3e37f...3635f32fe170a3b4a85d10ba56d576f9bea16df0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87299e2831abfc6f90475e3d380ea03fd6a3e37f...3635f32fe170a3b4a85d10ba56d576f9bea16df0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 15:07:45 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 10 May 2023 11:07:45 -0400 Subject: [Git][ghc/ghc][ghc-9.6] hadrian: Bump index-state to allow building with ghc-9.6 Message-ID: <645bb341dce7d_38ffda122c50bac1940183@gitlab.mail> Matthew Pickering pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: 40293d4e by Matthew Pickering at 2023-05-10T16:07:19+01:00 hadrian: Bump index-state to allow building with ghc-9.6 - - - - - 1 changed file: - hadrian/cabal.project Changes: ===================================== hadrian/cabal.project ===================================== @@ -1,7 +1,7 @@ packages: ./ -- This essentially freezes the build plan for hadrian -index-state: 2022-11-19T22:13:06Z +index-state: 2023-05-10T22:13:06Z -- N.B. Compile with -O0 since this is not a performance-critical executable -- and the Cabal takes nearly twice as long to build with -O1. See #16817. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40293d4eb0d56fff188b7bbdeb1eb55f40a8981b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40293d4eb0d56fff188b7bbdeb1eb55f40a8981b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 15:35:46 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 10 May 2023 11:35:46 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Wibbles Message-ID: <645bb9d2cefc1_38ffda124711e3c1948148@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: f00d264f by Simon Peyton Jones at 2023-05-10T16:37:41+01:00 Wibbles - - - - - 3 changed files: - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -47,7 +47,7 @@ import GHC.Tc.Errors import GHC.Tc.Errors.Types import GHC.Tc.Types.Evidence import GHC.Tc.Solver.Interact -import GHC.Tc.Solver.Canonical ( makeSuperClasses, solveCallStack ) +import GHC.Tc.Solver.Dict ( makeSuperClasses, solveCallStack ) import GHC.Tc.Solver.Rewrite ( rewriteType ) import GHC.Tc.Utils.Unify ( buildTvImplication ) import GHC.Tc.Utils.TcMType as TcM @@ -153,7 +153,7 @@ simplifyTop wanteds ; binds2 <- reportUnsolved final_wc ; traceTc "reportUnsolved (unsafe overlapping) {" empty - ; unless (isEmptyCts unsafe_ol) $ do { + ; unless (isEmptyBag unsafe_ol) $ do { -- grab current error messages and clear, warnAllUnsolved will -- update error messages which we'll grab and then restore saved -- messages. @@ -161,7 +161,7 @@ simplifyTop wanteds ; saved_msg <- TcM.readTcRef errs_var ; TcM.writeTcRef errs_var emptyMessages - ; warnAllUnsolved $ emptyWC { wc_simple = unsafe_ol } + ; warnAllUnsolved $ emptyWC { wc_simple = fmap CDictCan unsafe_ol } ; whyUnsafe <- getWarningMessages <$> TcM.readTcRef errs_var ; TcM.writeTcRef errs_var saved_msg ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -5,8 +5,7 @@ module GHC.Tc.Solver.Canonical( solveCt, - StopOrContinue(..), stopWith, continueWith, andWhenContinue, - solveCallStack -- For GHC.Tc.Solver + StopOrContinue(..), stopWith, continueWith, andWhenContinue ) where import GHC.Prelude @@ -18,6 +17,7 @@ import GHC.Tc.Solver.Rewrite import GHC.Tc.Solver.Monad import GHC.Tc.Solver.Equality( solveEquality ) import GHC.Tc.Solver.Irred( solveIrred ) +import GHC.Tc.Solver.Dict( solveDict, solveDictNC, mkStrictSuperClasses ) import GHC.Tc.Types.Evidence import GHC.Tc.Types.EvTerm @@ -104,8 +104,8 @@ solveCt (CDictCan (DictCt { di_ev = ev, di_pend_sc = pend_sc })) = do { ev <- rewriteEvidence ev ; case classifyPredType (ctEvPred ev) of ClassPred cls tys - -> solveDict (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = pend_sc }) + -> solveDict (DictCt { di_ev = ev, di_class = cls + , di_tyargs = tys, di_pend_sc = pend_sc }) _ -> pprPanic "solveCt" (ppr ev) } solveNC :: CtEvidence -> SolverStage Ct ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -1,9 +1,10 @@ -- | Solving Class constraints CDictCan module GHC.Tc.Solver.Dict ( - doTopReactDict, + solveDict, solveDictNC, checkInstanceOK, - matchLocalInst, chooseInstance - + matchLocalInst, chooseInstance, + makeSuperClasses, mkStrictSuperClasses, + solveCallStack -- For GHC.Tc.Solver ) where import GHC.Prelude @@ -81,7 +82,7 @@ solveDict dict_ct@(DictCt { di_ev = ev, di_class = cls, di_tyargs = tys }) ; tryLastResortProhibitedSuperClass dict_ct ; return (CDictCan dict_ct) } -mkDictCt :: CtEvidence -> Class -> [Type] -> SolverStage DictCt +mkDictCt :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue DictCt) -- Once-only processing of Dict constraints: -- * expand superclasses -- * deal with CallStack @@ -470,8 +471,6 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs | otherwise = continueWith () -interactDict _ wi = pprPanic "interactDict" (ppr wi) - -- See Note [Shortcut solving] shortCutSolver :: DynFlags -> CtEvidence -- Work item @@ -585,7 +584,7 @@ interactGivenIP :: InertCans -> DictCt -> TcS (StopOrContinue a) -- Work item is Given (?x:ty) -- See Note [Shadowing of Implicit Parameters] interactGivenIP inerts workItem@(DictCt { di_ev = ev, di_class = cls - , di_tyargs = tys@(ip_str:_) }) + , di_tyargs = tys }) = do { updInertCans $ \cans -> cans { inert_dicts = addDict filtered_dicts cls tys workItem } ; stopWith ev "Given IP" } where @@ -594,6 +593,10 @@ interactGivenIP inerts workItem@(DictCt { di_ev = ev, di_class = cls other_ip_dicts = filterBag (not . is_this_ip) ip_dicts filtered_dicts = addDictsByClass dicts cls other_ip_dicts + ip_str = case tys of + ip_str:_ -> ip_str + [] -> pprPanic "interactGivenIP" (ppr workItem) + -- Pick out any Given constraints for the same implicit parameter is_this_ip (DictCt { di_ev = ev, di_tyargs = ip_str':_ }) = isGiven ev && ip_str `tcEqType` ip_str' @@ -670,10 +673,10 @@ I can think of two ways to fix this: tryInstances :: DictCt -> SolverStage () tryInstances dict_ct - = Stage $ do { inerts <- getInertCans + = Stage $ do { inerts <- getTcSInerts ; try_instances inerts dict_ct } -try_instances :: InertSet -> DictCt -> TcS (StopOrContinue Ct) +try_instances :: InertSet -> DictCt -> TcS (StopOrContinue ()) -- Try to use type-class instance declarations to simplify the constraint try_instances inerts work_item@(DictCt { di_ev = ev, di_class = cls , di_tyargs = xis }) @@ -1185,18 +1188,18 @@ but that doesn't work for the example from #22216. * * **********************************************************************-} -tryLastResortProhibitedSuperClass :: DictCt -> TcS (StopOrContinue Ct) +tryLastResortProhibitedSuperClass :: DictCt -> SolverStage () -- ^ As a last resort, we TEMPORARILY allow a prohibited superclass solve, -- emitting a loud warning when doing so: we might be creating non-terminating -- evidence (as we are in T22912 for example). -- -- See Note [Migrating away from loopy superclass solving] in GHC.Tc.TyCl.Instance. tryLastResortProhibitedSuperClass dict_ct - = Stage $ do { inerts <- getInertCans + = Stage $ do { inerts <- getTcSInerts ; last_resort inerts dict_ct } last_resort :: InertSet -> DictCt -> TcS (StopOrContinue ()) -last_resort inerts work_item@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs = xis }) +last_resort inerts (DictCt { di_ev = ev_w, di_class = cls, di_tyargs = xis }) | let loc_w = ctEvLoc ev_w orig_w = ctLocOrigin loc_w , ScOrigin _ NakedSc <- orig_w -- work_item is definitely Wanted @@ -1205,9 +1208,9 @@ last_resort inerts work_item@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs = , isGiven ev_i = do { setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) ; ctLocWarnTcS loc_w $ - TcRnLoopySuperclassSolve loc_w (ctPred work_item) + TcRnLoopySuperclassSolve loc_w (ctEvPred ev_w) ; return $ Stop ev_w (text "Loopy superclass") } -tryLastResortProhibitedSuperclass _ _ + | otherwise = continueWith () @@ -1511,8 +1514,6 @@ doLocalFunDepImprovement (DictCt { di_ev = work_ev, di_class = cls }) (ctLocOrigin inert_loc) (ctLocSpan inert_loc) } -doLocalFunDepImprovement work_item = pprPanic "doLocalFunDepImprovement" (ppr work_item) - doTopFunDepImprovement :: DictCt -> TcS Bool -- Try to functional-dependency improvement between the constraint -- and the top-level instance declarations @@ -1536,8 +1537,6 @@ doTopFunDepImprovement work_item@(DictCt { di_ev = ev, di_class = cls, di_tyargs inst_pred inst_loc } , emptyRewriterSet ) -doTopFunDepImprovement work_item = pprPanic "doTopFunDepImprovement" (ppr work_item) - {- ********************************************************************* * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f00d264feac7ec5ddbece201fd3f32c37d0be5b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f00d264feac7ec5ddbece201fd3f32c37d0be5b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 16:01:56 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 10 May 2023 12:01:56 -0400 Subject: [Git][ghc/ghc][wip/T23025] linear lint: Add missing processing of DEFAULT Message-ID: <645bbff416fa7_38ffda125c74af4196025f@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23025 at Glasgow Haskell Compiler / GHC Commits: eda0d0da by Krzysztof Gogolewski at 2023-05-10T16:16:58+02:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - + testsuite/tests/linear/should_compile/T23025.hs - testsuite/tests/linear/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1195,13 +1195,13 @@ checkCanEtaExpand _ _ _ checkLinearity :: UsageEnv -> Var -> LintM UsageEnv checkLinearity body_ue lam_var = case varMultMaybe lam_var of - Just mult -> do ensureSubUsage lhs mult (err_msg mult) - return $ deleteUE body_ue lam_var + Just mult -> do + let (lhs, body_ue') = popUE body_ue lam_var + err_msg = text "Linearity failure in lambda:" <+> ppr lam_var + $$ ppr lhs <+> text "⊈" <+> ppr mult + ensureSubUsage lhs mult err_msg + return body_ue' Nothing -> return body_ue -- A type variable - where - lhs = lookupUE body_ue lam_var - err_msg mult = text "Linearity failure in lambda:" <+> ppr lam_var - $$ ppr lhs <+> text "⊈" <+> ppr mult {- Note [Join points and casts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1552,17 +1552,24 @@ lintCoreAlt :: Var -- Case binder -> LintM UsageEnv -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintCoreAlt _ _ _ alt_ty (Alt DEFAULT args rhs) = +lintCoreAlt case_bndr _ scrut_mult alt_ty (Alt DEFAULT args rhs) = do { lintL (null args) (mkDefaultArgsMsg args) - ; lintAltExpr rhs alt_ty } - -lintCoreAlt _case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) + ; rhs_ue <- lintAltExpr rhs alt_ty + ; let (case_bndr_usage, rhs_ue') = popUE rhs_ue case_bndr + err_msg = text "Linearity failure in the DEFAULT clause:" <+> ppr case_bndr + $$ ppr case_bndr_usage <+> text "⊈" <+> ppr scrut_mult + ; ensureSubUsage case_bndr_usage scrut_mult err_msg + ; return rhs_ue' } + +lintCoreAlt case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) | litIsLifted lit = failWithL integerScrutinisedMsg | otherwise = do { lintL (null args) (mkDefaultArgsMsg args) ; ensureEqTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty) - ; lintAltExpr rhs alt_ty } + ; rhs_ue <- lintAltExpr rhs alt_ty + ; return (deleteUE rhs_ue case_bndr) -- No need for linearity checks + } where lit_ty = literalType lit ===================================== compiler/GHC/Core/UsageEnv.hs ===================================== @@ -6,6 +6,7 @@ module GHC.Core.UsageEnv , bottomUE , deleteUE , lookupUE + , popUE , scaleUE , scaleUsage , supUE @@ -104,5 +105,8 @@ lookupUE (UsageEnv e has_bottom) x = Just w -> MUsage w Nothing -> if has_bottom then Bottom else Zero +popUE :: NamedThing n => UsageEnv -> n -> (Usage, UsageEnv) +popUE ue x = (lookupUE ue x, deleteUE ue x) + instance Outputable UsageEnv where ppr (UsageEnv ne b) = text "UsageEnv:" <+> ppr ne <+> ppr b ===================================== testsuite/tests/linear/should_compile/T23025.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE LinearTypes, BangPatterns #-} +module T23025 where + +import Data.Void + +f :: a %1 -> a +f !x = x + +g :: Void %m -> Maybe () +g a = Just (case a of {}) ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -40,3 +40,4 @@ test('T18731', normal, compile, ['']) test('T19400', unless(compiler_debugged(), skip), compile, ['']) test('T20023', normal, compile, ['']) test('T22546', normal, compile, ['']) +test('T23025', normal, compile, ['-dlinear-core-lint']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eda0d0da324842d5fed390bc04bbda29cd71cde2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eda0d0da324842d5fed390bc04bbda29cd71cde2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 17:05:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 13:05:28 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23373 Message-ID: <645bced89f3ae_38ffda12abc0c3420050a1@gitlab.mail> Ben Gamari pushed new branch wip/T23373 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23373 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 17:18:02 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 13:18:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23210 Message-ID: <645bd1ca66e04_38ffda12aa6157820102ad@gitlab.mail> Ben Gamari pushed new branch wip/T23210 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23210 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 17:27:55 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 13:27:55 -0400 Subject: [Git][ghc/ghc][wip/T13660] Update Internals.hs Message-ID: <645bd41b25589_38ffda12c7709d42022660@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 491005a0 by Ben Gamari at 2023-05-10T17:27:53+00:00 Update Internals.hs - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -34,7 +34,6 @@ import System.Posix.Types import Foreign import Foreign.C -import Data.OldList (elem) import Data.Maybe #if !defined(HTYPE_TCFLAG_T) @@ -52,6 +51,8 @@ import GHC.IO.Device #if !defined(mingw32_HOST_OS) import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC +#else +import Data.OldList (elem) #endif -- --------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/491005a0478ff1f03c3dd3c75536a56747d5fffc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/491005a0478ff1f03c3dd3c75536a56747d5fffc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 17:28:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 13:28:49 -0400 Subject: [Git][ghc/ghc][wip/T13660] Update Internals.hs Message-ID: <645bd451c3ff9_38ffda12c76cca820233a0@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: ad350887 by Ben Gamari at 2023-05-10T17:28:48+00:00 Update Internals.hs - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -42,7 +42,6 @@ import System.IO.Error import GHC.Base import GHC.Num -import GHC.Ptr import GHC.Real import GHC.IO import GHC.IO.IOMode @@ -51,6 +50,7 @@ import GHC.IO.Device #if !defined(mingw32_HOST_OS) import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC +import GHC.Ptr #else import Data.OldList (elem) #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad350887fa437f57b85b32128655ea548e7ae908 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad350887fa437f57b85b32128655ea548e7ae908 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 17:53:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 13:53:49 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] 6 commits: Adjust AArch64 stackFrameHeaderSize Message-ID: <645bda2d7d7c7_38ffda12dd3d64020303fa@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 37f7aaa8 by Ben Gamari at 2023-05-10T13:53:40-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - a02756b5 by Ben Gamari at 2023-05-10T13:53:40-04:00 compiler: Record original thunk info tables on stack - - - - - 17 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - docs/users_guide/debugging.rst - libraries/base/Data/Function.hs - libraries/base/changelog.md - libraries/ghc-prim/changelog.md - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - utils/deriveConstants/Main.hs - utils/hsc2hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3407,7 +3407,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp out_of_line = True primop TouchOp "touch#" GenPrimOp - v -> State# RealWorld -> State# RealWorld + v -> State# s -> State# s with code_size = { 0 } has_side_effects = True @@ -3723,7 +3723,7 @@ section "Controlling object lifetime" -- and "p" is the same as "b" except representation-polymorphic. -- See Note [Levity and representation polymorphic primops] primop KeepAliveOp "keepAlive#" GenPrimOp - v -> State# RealWorld -> (State# RealWorld -> p) -> p + v -> State# s -> (State# s -> p) -> p { @'keepAlive#' x s k@ keeps the value @x@ alive during the execution of the computation @k at . ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -32,9 +32,9 @@ import Data.Maybe (fromMaybe) import GHC.Stack --- | TODO: verify this! -stackFrameHeaderSize :: Platform -> Int -stackFrameHeaderSize _ = 64 +-- | LR and FP (8 byte each) are the prologue of each stack frame +stackFrameHeaderSize :: Int +stackFrameHeaderSize = 2 * 8 -- | All registers are 8 byte wide. spillSlotSize :: Int @@ -49,14 +49,13 @@ stackAlign = 16 maxSpillSlots :: NCGConfig -> Int maxSpillSlots config -- = 0 -- set to zero, to see when allocMoreStack has to fire. - = let platform = ncgPlatform config - in ((ncgSpillPreallocSize config - stackFrameHeaderSize platform) + = ((ncgSpillPreallocSize config - stackFrameHeaderSize) `div` spillSlotSize) - 1 -- | Convert a spill slot number to a *byte* offset, with no sign. spillSlotToOffset :: NCGConfig -> Int -> Int -spillSlotToOffset config slot - = stackFrameHeaderSize (ncgPlatform config) + spillSlotSize * slot +spillSlotToOffset _ slot + = stackFrameHeaderSize + spillSlotSize * slot -- | Get the registers that are being used by this instruction. -- regUsage doesn't need to do any trickery for jumps and such. ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -37,6 +37,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -5,6 +5,7 @@ module GHC.Driver.Flags , GeneralFlag(..) , Language(..) , optimisationFlags + , codeGenFlags -- * Warnings , WarningGroup(..) @@ -328,6 +329,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -473,15 +475,11 @@ data GeneralFlag | Opt_G_NoOptCoercion deriving (Eq, Show, Enum) --- Check whether a flag should be considered an "optimisation flag" --- for purposes of recompilation avoidance (see --- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is --- not a guarantee that the flag has no other effect. We could, and --- perhaps should, separate out the flags that have some minor impact on --- program semantics and/or error behavior (e.g., assertions), but --- then we'd need to go to extra trouble (and an additional flag) --- to allow users to ignore the optimisation level even though that --- means ignoring some change. +-- | The set of flags which affect optimisation for the purposes of +-- recompilation avoidance. Specifically, these include flags which +-- affect code generation but not the semantics of the program. +-- +-- See Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags) optimisationFlags :: EnumSet GeneralFlag optimisationFlags = EnumSet.fromList [ Opt_CallArity @@ -513,16 +511,12 @@ optimisationFlags = EnumSet.fromList , Opt_EnableRewriteRules , Opt_RegsGraph , Opt_RegsIterative - , Opt_PedanticBottoms , Opt_LlvmTBAA - , Opt_LlvmFillUndefWithGarbage , Opt_IrrefutableTuples , Opt_CmmSink , Opt_CmmElimCommonBlocks , Opt_AsmShortcutting - , Opt_OmitYields , Opt_FunToThunk - , Opt_DictsStrict , Opt_DmdTxDictSel , Opt_Loopification , Opt_CfgBlocklayout @@ -531,8 +525,48 @@ optimisationFlags = EnumSet.fromList , Opt_WorkerWrapper , Opt_WorkerWrapperUnlift , Opt_SolveConstantDicts + ] + +-- | The set of flags which affect code generation and can change a program's +-- runtime behavior (other than performance). These include flags which affect: +-- +-- * user visible debugging information (e.g. info table provenance) +-- * the ability to catch runtime errors (e.g. -fignore-asserts) +-- * the runtime result of the program (e.g. -fomit-yields) +-- * which code or interface file declarations are emitted +-- +-- We also considered placing flags which affect asympototic space behavior +-- (e.g. -ffull-laziness) however this would mean that changing optimisation +-- levels would trigger recompilation even with -fignore-optim-changes, +-- regressing #13604. +-- +-- Also, arguably Opt_IgnoreAsserts should be here as well; however, we place +-- it instead in 'optimisationFlags' since it is implied by @-O[12]@ and +-- therefore would also break #13604. +-- +-- See #23369. +codeGenFlags :: EnumSet GeneralFlag +codeGenFlags = EnumSet.fromList + [ -- Flags that affect runtime result + Opt_EagerBlackHoling + , Opt_ExcessPrecision + , Opt_DictsStrict + , Opt_PedanticBottoms + , Opt_OmitYields + + -- Flags that affect generated code + , Opt_ExposeAllUnfoldings + , Opt_NoTypeableBinds + + -- Flags that affect catching of runtime errors , Opt_CatchNonexhaustiveCases - , Opt_IgnoreAsserts + , Opt_LlvmFillUndefWithGarbage + , Opt_DoTagInferenceChecks + + -- Flags that affect debugging information + , Opt_DistinctConstructorTables + , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -66,6 +66,7 @@ module GHC.Driver.Session ( makeDynFlagsConsistent, positionIndependent, optimisationFlags, + codeGenFlags, setFlagsFromEnvFile, pprDynFlagsDiff, flagSpecOf, @@ -3481,6 +3482,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio = ticky = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] - flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters)) + -- Other flags which affect code generation + codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags) + + flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ computeFingerprint nameio flags ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -49,6 +49,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== docs/users_guide/debugging.rst ===================================== @@ -1072,6 +1072,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== libraries/base/Data/Function.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-} @@ -28,7 +30,7 @@ module Data.Function , applyWhen ) where -import GHC.Base ( ($), (.), id, const, flip ) +import GHC.Base ( TYPE, ($), (.), id, const, flip ) import Data.Bool ( Bool(..) ) infixl 0 `on` @@ -120,7 +122,7 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c -- "6" -- -- @since 4.8.0.0 -(&) :: a -> (a -> b) -> b +(&) :: forall r a (b :: TYPE r). a -> (a -> b) -> b x & f = f x -- | 'applyWhen' applies a function to a value if a condition is true, ===================================== libraries/base/changelog.md ===================================== @@ -21,9 +21,10 @@ ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149)) * Make `($)` representation polymorphic ([CLC proposal #132](https://github.com/haskell/core-libraries-committee/issues/132)) * Implemented [GHC Proposal #433](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0433-unsatisfiable.rst), - adding the class `Unsatisfiable :: ErrorMessage -> TypeError`` to `GHC.TypeError`, + adding the class `Unsatisfiable :: ErrorMessage -> TypeError` to `GHC.TypeError`, which provides a mechanism for custom type errors that reports the errors in - a more predictable behaviour than ``TypeError``. + a more predictable behaviour than `TypeError`. + * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -14,6 +14,8 @@ - `sameMutVar#`, `sameTVar#`, `sameMVar#` - `sameIOPort#`, `eqStableName#`. +- `keepAlive#` and `touch#` are now polymorphic in their state token (#23163; [CLC#152](https://github.com/haskell/core-libraries-committee/issues/152)) + - Several new primops were added: - `copyMutableByteArrayNonOverlapping#` ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 1ba092932f86c1fda15091d355ba7975b8554437 +Subproject commit f70b360b295298e4da10afe02ebf022b21342008 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40f8200ee17575021c336c0aba14b684980415dc...a02756b537b75acba0942381789850662ed6eab3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40f8200ee17575021c336c0aba14b684980415dc...a02756b537b75acba0942381789850662ed6eab3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 18:23:12 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 14:23:12 -0400 Subject: [Git][ghc/ghc][wip/export-finaliser-exceptions] 6 commits: Adjust AArch64 stackFrameHeaderSize Message-ID: <645be1109c51c_38ffda130dcbdac20515c9@gitlab.mail> Ben Gamari pushed to branch wip/export-finaliser-exceptions at Glasgow Haskell Compiler / GHC Commits: 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - f839c815 by Ben Gamari at 2023-05-10T14:21:47-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 3fa0ea83 by Ben Gamari at 2023-05-10T14:22:59-04:00 base: Add printToStderrFinalizerExceptionHandler - - - - - 12 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - libraries/base/Data/Function.hs - libraries/base/GHC/Weak.hs - libraries/base/GHC/Weak/Finalize.hs - + libraries/base/GHC/Weak/FinalizeIO.hs - + libraries/base/GHC/Weak/FinalizeIO.hs-boot - libraries/base/System/Mem/Weak.hs - libraries/base/base.cabal - libraries/base/changelog.md - libraries/ghc-prim/changelog.md - utils/hsc2hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3407,7 +3407,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp out_of_line = True primop TouchOp "touch#" GenPrimOp - v -> State# RealWorld -> State# RealWorld + v -> State# s -> State# s with code_size = { 0 } has_side_effects = True @@ -3723,7 +3723,7 @@ section "Controlling object lifetime" -- and "p" is the same as "b" except representation-polymorphic. -- See Note [Levity and representation polymorphic primops] primop KeepAliveOp "keepAlive#" GenPrimOp - v -> State# RealWorld -> (State# RealWorld -> p) -> p + v -> State# s -> (State# s -> p) -> p { @'keepAlive#' x s k@ keeps the value @x@ alive during the execution of the computation @k at . ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -32,9 +32,9 @@ import Data.Maybe (fromMaybe) import GHC.Stack --- | TODO: verify this! -stackFrameHeaderSize :: Platform -> Int -stackFrameHeaderSize _ = 64 +-- | LR and FP (8 byte each) are the prologue of each stack frame +stackFrameHeaderSize :: Int +stackFrameHeaderSize = 2 * 8 -- | All registers are 8 byte wide. spillSlotSize :: Int @@ -49,14 +49,13 @@ stackAlign = 16 maxSpillSlots :: NCGConfig -> Int maxSpillSlots config -- = 0 -- set to zero, to see when allocMoreStack has to fire. - = let platform = ncgPlatform config - in ((ncgSpillPreallocSize config - stackFrameHeaderSize platform) + = ((ncgSpillPreallocSize config - stackFrameHeaderSize) `div` spillSlotSize) - 1 -- | Convert a spill slot number to a *byte* offset, with no sign. spillSlotToOffset :: NCGConfig -> Int -> Int -spillSlotToOffset config slot - = stackFrameHeaderSize (ncgPlatform config) + spillSlotSize * slot +spillSlotToOffset _ slot + = stackFrameHeaderSize + spillSlotSize * slot -- | Get the registers that are being used by this instruction. -- regUsage doesn't need to do any trickery for jumps and such. ===================================== libraries/base/Data/Function.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-} @@ -28,7 +30,7 @@ module Data.Function , applyWhen ) where -import GHC.Base ( ($), (.), id, const, flip ) +import GHC.Base ( TYPE, ($), (.), id, const, flip ) import Data.Bool ( Bool(..) ) infixl 0 `on` @@ -120,7 +122,7 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c -- "6" -- -- @since 4.8.0.0 -(&) :: a -> (a -> b) -> b +(&) :: forall r a (b :: TYPE r). a -> (a -> b) -> b x & f = f x -- | 'applyWhen' applies a function to a value if a condition is true, ===================================== libraries/base/GHC/Weak.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Weak ( -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by -- this handler will be ignored. setFinalizerExceptionHandler, - getFinalizerExceptionHandler + getFinalizerExceptionHandler, + printToStderrFinalizerExceptionHandler ) where import GHC.Base ===================================== libraries/base/GHC/Weak/Finalize.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Weak.Finalize -- this handler will be ignored. setFinalizerExceptionHandler , getFinalizerExceptionHandler + , printToStderrFinalizerExceptionHandler -- * Internal , runFinalizerBatch ) where @@ -20,6 +21,7 @@ import GHC.Exception import GHC.IORef import {-# SOURCE #-} GHC.Conc.Sync (labelThreadByteArray#, myThreadId) import GHC.IO (catchException, unsafePerformIO) +import {-# SOURCE #-} GHC.Weak.FinalizeIO ( hPutStrLnStderr ) import GHC.Encoding.UTF8 (utf8EncodeByteArray#) data ByteArray = ByteArray ByteArray# @@ -79,3 +81,13 @@ getFinalizerExceptionHandler = readIORef finalizerExceptionHandler -- @since 4.18.0.0 setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO () setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler + +-- | An exception handler for 'Handle' finalization that prints the error to +-- @stderr@, but doesn't rethrow it. +-- +-- @since 4.18.0.0 +printToStderrFinalizerExceptionHandler :: SomeException -> IO () +printToStderrFinalizerExceptionHandler se = + hPutStrStderr msg `catchException` (\(SomeException _) -> return ()) + where + msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n" ===================================== libraries/base/GHC/Weak/FinalizeIO.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This internal module exists solely to allow us to break the cycle introduced +-- by the use of 'Handle' in +-- 'GHC.Weak.Finalize.printToStderrFinalizeExceptionHandler' +module GHC.Weak.FinalizeIO ( hPutStrLnStderr ) where + +import GHC.Base +import System.IO + +hPutStrLnStderr :: String -> IO () +hPutStrLnStderr = hPutStrLn stderr ===================================== libraries/base/GHC/Weak/FinalizeIO.hs-boot ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.Weak.FinalizeIO ( hPutStrLnStderr ) where + +import GHC.Base + +hPutStrLnStderr :: String -> IO () ===================================== libraries/base/System/Mem/Weak.hs ===================================== @@ -64,6 +64,15 @@ module System.Mem.Weak ( mkWeakPair, -- replaceFinaliser + -- * Handling exceptions + -- | When an exception is thrown by a finalizer called by the + -- garbage collector, GHC calls a global handler which can be set with + -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by + -- this handler will be ignored. + setFinalizerExceptionHandler, + getFinalizerExceptionHandler, + printToStderrFinalizerExceptionHandler, + -- * A precise semantics -- $precise ===================================== libraries/base/base.cabal ===================================== @@ -359,6 +359,7 @@ Library GHC.Unicode.Internal.Char.UnicodeData.SimpleTitleCaseMapping GHC.Unicode.Internal.Char.UnicodeData.SimpleUpperCaseMapping GHC.Unicode.Internal.Version + GHC.Weak.FinalizeIO System.Environment.ExecutablePath System.CPUTime.Utils ===================================== libraries/base/changelog.md ===================================== @@ -13,6 +13,8 @@ * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) + * Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) + * Add `System.Mem.Weak.printToStderrFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to `stderr`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. @@ -21,9 +23,10 @@ ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149)) * Make `($)` representation polymorphic ([CLC proposal #132](https://github.com/haskell/core-libraries-committee/issues/132)) * Implemented [GHC Proposal #433](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0433-unsatisfiable.rst), - adding the class `Unsatisfiable :: ErrorMessage -> TypeError`` to `GHC.TypeError`, + adding the class `Unsatisfiable :: ErrorMessage -> TypeError` to `GHC.TypeError`, which provides a mechanism for custom type errors that reports the errors in - a more predictable behaviour than ``TypeError``. + a more predictable behaviour than `TypeError`. + * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -14,6 +14,8 @@ - `sameMutVar#`, `sameTVar#`, `sameMVar#` - `sameIOPort#`, `eqStableName#`. +- `keepAlive#` and `touch#` are now polymorphic in their state token (#23163; [CLC#152](https://github.com/haskell/core-libraries-committee/issues/152)) + - Several new primops were added: - `copyMutableByteArrayNonOverlapping#` ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 1ba092932f86c1fda15091d355ba7975b8554437 +Subproject commit f70b360b295298e4da10afe02ebf022b21342008 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/638fe9281a621ffadc9e1e5972538e475b53b144...3fa0ea83ae1c33fa8812a3aa55682819656ca90a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/638fe9281a621ffadc9e1e5972538e475b53b144...3fa0ea83ae1c33fa8812a3aa55682819656ca90a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 18:24:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 14:24:59 -0400 Subject: [Git][ghc/ghc][wip/T13660] 176 commits: Handle records in the renamer Message-ID: <645be17b3cb89_38ffda130c7d50420524df@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 4a60dded by Ben Gamari at 2023-05-10T14:24:51-04:00 base: Add test for #13660 - - - - - 20455f9d by Ben Gamari at 2023-05-10T14:24:51-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 28640310 by Ben Gamari at 2023-05-10T14:24:51-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - 22a06d2d by Ben Gamari at 2023-05-10T14:24:51-04:00 base: Clean up documentation - - - - - 358fdd93 by Ben Gamari at 2023-05-10T14:24:51-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/ConLike.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad350887fa437f57b85b32128655ea548e7ae908...358fdd93deb94d7c04dcc1f197da1057ff2f2483 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad350887fa437f57b85b32128655ea548e7ae908...358fdd93deb94d7c04dcc1f197da1057ff2f2483 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 19:12:56 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 15:12:56 -0400 Subject: [Git][ghc/ghc][wip/T19146] 44 commits: Add sized primitive literal syntax Message-ID: <645becb81731f_38ffda1338bee88208507f@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - ce078fc3 by Ben Gamari at 2023-05-10T15:02:07-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - 87bf09d5 by Ben Gamari at 2023-05-10T15:02:07-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - c26d2d61 by Ben Gamari at 2023-05-10T15:02:07-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - cbb04cd2 by Ben Gamari at 2023-05-10T15:12:23-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 4acec52b by Ben Gamari at 2023-05-10T15:12:23-04:00 rts: Introduce printGlobalThreads - - - - - a7c3de67 by Ben Gamari at 2023-05-10T15:12:23-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c69e7e6d86c7528d6cb321bb24be52633560acfb...a7c3de6759f4a14a1c51c935dc939cc19ce6904b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c69e7e6d86c7528d6cb321bb24be52633560acfb...a7c3de6759f4a14a1c51c935dc939cc19ce6904b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 19:13:13 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 15:13:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/clear-block-info Message-ID: <645becc95d319_38ffda1341a202c20857a7@gitlab.mail> Ben Gamari pushed new branch wip/clear-block-info at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/clear-block-info You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 19:29:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 15:29:16 -0400 Subject: [Git][ghc/ghc][wip/clear-block-info] rts: Clear block_info when unblocking Message-ID: <645bf08c5c871_38ffda134c32ff020940b5@gitlab.mail> Ben Gamari pushed to branch wip/clear-block-info at Glasgow Haskell Compiler / GHC Commits: a81a4ad1 by Ben Gamari at 2023-05-10T15:28:18-04:00 rts: Clear block_info when unblocking Otherwise we may end up with dangling pointers which may complicate debugging. - - - - - 5 changed files: - rts/RaiseAsync.c - rts/Schedule.c - rts/Threads.c - rts/posix/Select.c - rts/win32/AsyncMIO.c Changes: ===================================== rts/RaiseAsync.c ===================================== @@ -729,6 +729,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) done: tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap, tso); } @@ -1092,6 +1093,7 @@ done: // wake it up if (tso->why_blocked != NotBlocked) { tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); } ===================================== rts/Schedule.c ===================================== @@ -2565,7 +2565,8 @@ resumeThread (void *task_) traceEventRunThread(cap, tso); /* Reset blocking status */ - tso->why_blocked = NotBlocked; + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; if ((tso->flags & TSO_BLOCKEX) == 0) { // avoid locking the TSO if we don't have to ===================================== rts/Threads.c ===================================== @@ -334,6 +334,7 @@ unblock: // just run the thread now, if the BH is not really available, // we'll block again. tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); // We used to set the context switch flag here, which would ===================================== rts/posix/Select.c ===================================== @@ -106,6 +106,7 @@ static bool wakeUpSleepingThreads (Capability *cap, LowResTime now) } iomgr->sleeping_queue = tso->_link; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %" FMT_StgThreadID "\n", tso->id)); @@ -437,6 +438,7 @@ awaitEvent(Capability *cap, bool wait) debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap,tso); break; ===================================== rts/win32/AsyncMIO.c ===================================== @@ -318,14 +318,16 @@ start: : END_TSO_QUEUE; } - // Terminates the run queue + this inner for-loop. - tso->_link = END_TSO_QUEUE; - tso->why_blocked = NotBlocked; // save the StgAsyncIOResult in the // stg_block_async_info stack frame, because // the block_info field will be overwritten by // pushOnRunQueue(). tso->stackobj->sp[1] = (W_)tso->block_info.async_result; + + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; + // Terminates the run queue + this inner for-loop. + tso->_link = END_TSO_QUEUE; pushOnRunQueue(&MainCapability, tso); break; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a81a4ad1e9a222081b2f648d53faac37dfdc9736 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a81a4ad1e9a222081b2f648d53faac37dfdc9736 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 19:46:56 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 15:46:56 -0400 Subject: [Git][ghc/ghc][wip/export-finaliser-exceptions] base: Introduce printToHandleFinalizerExceptionHandler Message-ID: <645bf4b0d6230_38ffda136c285d02105164@gitlab.mail> Ben Gamari pushed to branch wip/export-finaliser-exceptions at Glasgow Haskell Compiler / GHC Commits: b5b3c326 by Ben Gamari at 2023-05-10T15:46:48-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 6 changed files: - + libraries/base/GHC/IO/Handle/Text.hs-boot - + libraries/base/GHC/IO/Handle/Types.hs-boot - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Weak.hs - libraries/base/GHC/Weak/Finalize.hs - libraries/base/System/Mem/Weak.hs Changes: ===================================== libraries/base/GHC/IO/Handle/Text.hs-boot ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Text ( hPutStrLn ) where + +import GHC.Base (String, IO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) + +hPutStrLn :: Handle -> String -> IO () ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Types ( Handle ) where + +data Handle ===================================== libraries/base/GHC/TopHandler.hs ===================================== @@ -84,7 +84,7 @@ runMainIO main = main_thread_id <- myThreadId weak_tid <- mkWeakThreadId main_thread_id - --setFinalizerExceptionHandler printToStderrFinalizerExceptionHandler + --setFinalizerExceptionHandler (printToHandleFinalizerExceptionHandler stderr) -- For the time being, we don't install any exception handler for -- Handle finalization. Instead, the user should set one manually. ===================================== libraries/base/GHC/Weak.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Weak ( -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by -- this handler will be ignored. setFinalizerExceptionHandler, - getFinalizerExceptionHandler + getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler ) where import GHC.Base ===================================== libraries/base/GHC/Weak/Finalize.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Weak.Finalize -- this handler will be ignored. setFinalizerExceptionHandler , getFinalizerExceptionHandler + , printToHandleFinalizerExceptionHandler -- * Internal , runFinalizerBatch ) where @@ -20,6 +21,8 @@ import GHC.Exception import GHC.IORef import {-# SOURCE #-} GHC.Conc.Sync (labelThreadByteArray#, myThreadId) import GHC.IO (catchException, unsafePerformIO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) +import {-# SOURCE #-} GHC.IO.Handle.Text (hPutStrLn) import GHC.Encoding.UTF8 (utf8EncodeByteArray#) data ByteArray = ByteArray ByteArray# @@ -79,3 +82,13 @@ getFinalizerExceptionHandler = readIORef finalizerExceptionHandler -- @since 4.18.0.0 setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO () setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler + +-- | An exception handler for 'Handle' finalization that prints the error to +-- @stderr@, but doesn't rethrow it. +-- +-- @since 4.18.0.0 +printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO () +printToHandleFinalizerExceptionHandler hdl se = + hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ()) + where + msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n" ===================================== libraries/base/System/Mem/Weak.hs ===================================== @@ -71,6 +71,7 @@ module System.Mem.Weak ( -- this handler will be ignored. setFinalizerExceptionHandler, getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler, -- * A precise semantics View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5b3c32648b8d00f7da14766fe84ceac662f6480 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5b3c32648b8d00f7da14766fe84ceac662f6480 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 19:48:52 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 15:48:52 -0400 Subject: [Git][ghc/ghc][wip/export-finaliser-exceptions] base: Introduce printToHandleFinalizerExceptionHandler Message-ID: <645bf524227de_38ffda136e65f14210682e@gitlab.mail> Ben Gamari pushed to branch wip/export-finaliser-exceptions at Glasgow Haskell Compiler / GHC Commits: 859f5f81 by Ben Gamari at 2023-05-10T15:48:45-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 7 changed files: - + libraries/base/GHC/IO/Handle/Text.hs-boot - + libraries/base/GHC/IO/Handle/Types.hs-boot - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Weak.hs - libraries/base/GHC/Weak/Finalize.hs - libraries/base/System/Mem/Weak.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/IO/Handle/Text.hs-boot ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Text ( hPutStrLn ) where + +import GHC.Base (String, IO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) + +hPutStrLn :: Handle -> String -> IO () ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Types ( Handle ) where + +data Handle ===================================== libraries/base/GHC/TopHandler.hs ===================================== @@ -84,7 +84,7 @@ runMainIO main = main_thread_id <- myThreadId weak_tid <- mkWeakThreadId main_thread_id - --setFinalizerExceptionHandler printToStderrFinalizerExceptionHandler + --setFinalizerExceptionHandler (printToHandleFinalizerExceptionHandler stderr) -- For the time being, we don't install any exception handler for -- Handle finalization. Instead, the user should set one manually. ===================================== libraries/base/GHC/Weak.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Weak ( -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by -- this handler will be ignored. setFinalizerExceptionHandler, - getFinalizerExceptionHandler + getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler ) where import GHC.Base ===================================== libraries/base/GHC/Weak/Finalize.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Weak.Finalize -- this handler will be ignored. setFinalizerExceptionHandler , getFinalizerExceptionHandler + , printToHandleFinalizerExceptionHandler -- * Internal , runFinalizerBatch ) where @@ -20,6 +21,8 @@ import GHC.Exception import GHC.IORef import {-# SOURCE #-} GHC.Conc.Sync (labelThreadByteArray#, myThreadId) import GHC.IO (catchException, unsafePerformIO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) +import {-# SOURCE #-} GHC.IO.Handle.Text (hPutStrLn) import GHC.Encoding.UTF8 (utf8EncodeByteArray#) data ByteArray = ByteArray ByteArray# @@ -79,3 +82,13 @@ getFinalizerExceptionHandler = readIORef finalizerExceptionHandler -- @since 4.18.0.0 setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO () setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler + +-- | An exception handler for 'Handle' finalization that prints the error to +-- the given 'Handle', but doesn't rethrow it. +-- +-- @since 4.18.0.0 +printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO () +printToHandleFinalizerExceptionHandler hdl se = + hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ()) + where + msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n" ===================================== libraries/base/System/Mem/Weak.hs ===================================== @@ -71,6 +71,7 @@ module System.Mem.Weak ( -- this handler will be ignored. setFinalizerExceptionHandler, getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler, -- * A precise semantics ===================================== libraries/base/changelog.md ===================================== @@ -14,7 +14,7 @@ ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) * Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) - * Add `System.Mem.Weak.printToStderrFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to `stderr`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) + * Add `System.Mem.Weak.printToHandleFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to the given `Handle`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/859f5f8164d81fa185e3903f0570840a1f943a88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/859f5f8164d81fa185e3903f0570840a1f943a88 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 19:53:22 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 10 May 2023 15:53:22 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Remove white space Message-ID: <645bf63271470_38ffda137de9ecc21163ae@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 351cb8ac by Simon Peyton Jones at 2023-05-10T20:53:04+01:00 Remove white space - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Monad.hs Changes: ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -673,7 +673,7 @@ getUnsolvedInerts ; let unsolved_tv_eqs = foldTyEqs (add_if_unsolved CEqCan) tv_eqs emptyCts unsolved_fun_eqs = foldFunEqs (add_if_unsolved CEqCan) fun_eqs emptyCts - unsolved_irreds = foldr (add_if_unsolved CIrredCan) emptyCts irreds + unsolved_irreds = foldr (add_if_unsolved CIrredCan) emptyCts irreds unsolved_dicts = foldDicts (add_if_unsolved CDictCan) idicts emptyCts ; implics <- getWorkListImplics View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/351cb8aceaa174e50079fe6a9fc9168af309b755 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/351cb8aceaa174e50079fe6a9fc9168af309b755 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 20:00:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 10 May 2023 16:00:20 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <645bf7d45dd68_38ffda138aae18021245c1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0de6eb02 by Ben Gamari at 2023-05-10T15:59:52-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - c60d702d by Matthew Pickering at 2023-05-10T15:59:52-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - cb1d09e7 by Simon Peyton Jones at 2023-05-10T15:59:53-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - d40d3736 by Rodrigo Mesquita at 2023-05-10T15:59:54-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - f6882ef1 by Krzysztof Gogolewski at 2023-05-10T15:59:55-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - c2efebb7 by Bodigrim at 2023-05-10T15:59:58-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 27 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/Data/Fixed.hs - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/Float.hs - libraries/base/changelog.md - + testsuite/tests/quantified-constraints/T23333.hs - testsuite/tests/quantified-constraints/all.T - + testsuite/tests/typecheck/should_fail/T17284.hs - + testsuite/tests/typecheck/should_fail/T17284.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -424,7 +424,7 @@ distroVariables Alpine = mconcat -- T10458, ghcilink002: due to #17869 -- linker_unload_native: due to musl not supporting any means of probing dynlib dependencies -- (see Note [Object unloading]). - , "BROKEN_TESTS" =: "encoding004 T10458 ghcilink002 linker_unload_native" + , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native" ] distroVariables Centos7 = mconcat [ "HADRIAN_ARGS" =: "--docs=no-sphinx" @@ -903,8 +903,11 @@ job_groups = , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) - , standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static) - , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + -- Fully static build, in theory usable on any linux distribution. + , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) + -- Dynamically linked build, suitable for building your own static executables on alpine + , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) + , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") ) @@ -919,6 +922,10 @@ job_groups = ] where + + -- ghcilink002 broken due to #17869 + fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 ") + hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url") tsan_jobs = ===================================== .gitlab/jobs.yaml ===================================== @@ -597,7 +597,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -606,6 +606,68 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-alpine3_12-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "8 weeks", + "paths": [ + "ghc-x86_64-linux-alpine3_12-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--docs=no-sphinx", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -659,7 +721,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -2472,7 +2534,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2535,7 +2597,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2545,6 +2607,69 @@ "XZ_OPT": "-9" } }, + "release-x86_64-linux-alpine3_12-release+no_split_sections": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "release+no_split_sections", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", + "IGNORE_PERF_FAILURES": "all", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", + "XZ_OPT": "-9" + } + }, "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3581,7 +3706,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -30,6 +30,7 @@ def job_triple(job_name): 'release-x86_64-linux-deb9-release': 'x86_64-deb9-linux', 'release-x86_64-linux-centos7-release': 'x86_64-centos7-linux', 'release-x86_64-linux-alpine3_12-release+fully_static': 'x86_64-alpine3_12-linux-static', + 'release-x86_64-linux-alpine3_12-release': 'x86_64-alpine3_12-linux', 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4830,8 +4830,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . ===================================== compiler/GHC/Platform.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Platform , platformInIntRange , platformInWordRange , platformCConvNeedsExtension + , platformHasRTSLinker , PlatformMisc(..) , SseVersion (..) , BmiVersion (..) @@ -271,6 +272,23 @@ platformCConvNeedsExtension platform = case platformArch platform of | OSDarwin <- platformOS platform -> True _ -> False +-- | Does this platform have an RTS linker? +platformHasRTSLinker :: Platform -> Bool +-- Note that we've inlined this logic in hadrian's +-- Settings.Builders.RunTest.inTreeCompilerArgs. +-- If you change this, be sure to change it too +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- powerpc + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + -------------------------------------------------- -- Instruction sets ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -67,7 +67,7 @@ doTopReactDict inerts work_item@(CDictCan { cc_ev = ev, cc_class = cls OneInst { cir_what = what } -> do { insertSafeOverlapFailureTcS what work_item ; addSolvedDict what ev cls xis - ; chooseInstance work_item lkup_res } + ; chooseInstance ev lkup_res } _ -> -- NoInstance or NotSure -- We didn't solve it; so try functional dependencies with -- the instance environment @@ -100,28 +100,24 @@ tryLastResortProhibitedSuperclass inerts tryLastResortProhibitedSuperclass _ work_item = continueWith work_item -chooseInstance :: Ct -> ClsInstResult -> TcS (StopOrContinue Ct) +chooseInstance :: CtEvidence -> ClsInstResult -> TcS (StopOrContinue Ct) chooseInstance work_item (OneInst { cir_new_theta = theta , cir_what = what , cir_mk_ev = mk_ev , cir_coherence = coherence }) - = do { traceTcS "doTopReact/found instance for" $ ppr ev + = do { traceTcS "doTopReact/found instance for" $ ppr work_item ; deeper_loc <- checkInstanceOK loc what pred ; checkReductionDepth deeper_loc pred - ; evb <- getTcEvBindsVar - ; if isCoEvBindsVar evb - then continueWith work_item - -- See Note [Instances in no-evidence implications] - else - do { evc_vars <- mapM (newWanted deeper_loc (ctRewriters work_item)) theta - ; setEvBindIfWanted ev coherence (mk_ev (map getEvExpr evc_vars)) - ; emitWorkNC (freshGoals evc_vars) - ; stopWith ev "Dict/Top (solved wanted)" }} + ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar) + (ppr work_item) + ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta + ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars)) + ; emitWorkNC (freshGoals evc_vars) + ; stopWith work_item "Dict/Top (solved wanted)" } where - ev = ctEvidence work_item - pred = ctEvPred ev - loc = ctEvLoc ev + pred = ctEvPred work_item + loc = ctEvLoc work_item chooseInstance work_item lookup_res = pprPanic "chooseInstance" (ppr work_item $$ ppr lookup_res) @@ -147,27 +143,6 @@ checkInstanceOK loc what pred | otherwise = loc -{- Note [Instances in no-evidence implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In #15290 we had - [G] forall p q. Coercible p q => Coercible (m p) (m q)) - [W] forall a. m (Int, IntStateT m a) - ~R# - m (Int, StateT Int m a) - -The Given is an ordinary quantified constraint; the Wanted is an implication -equality that arises from - [W] (forall a. t1) ~R# (forall a. t2) - -But because the (t1 ~R# t2) is solved "inside a type" (under that forall a) -we can't generate any term evidence. So we can't actually use that -lovely quantified constraint. Alas! - -This test arranges to ignore the instance-based solution under these -(rare) circumstances. It's sad, but I really don't see what else we can do. --} - - matchClassInst :: DynFlags -> InertSet -> Class -> [Type] -> CtLoc -> TcS ClsInstResult ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -2647,23 +2647,45 @@ finishEqCt work_item@(EqCt { eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel }) final_qci_check :: Ct -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct) -- The "final QCI check" checks to see if we have -- [W] t1 ~# t2 --- and a Given quantified contraint like (forall a b. blah => a :~: b) +-- and a Given quantified contraint like (forall a b. blah => a ~ b) -- Why? See Note [Looking up primitive equalities in quantified constraints] final_qci_check work_ct eq_rel lhs rhs - | isWanted ev - , Just (cls, tys) <- boxEqPred eq_rel lhs rhs - = do { res <- matchLocalInst (mkClassPred cls tys) loc - ; case res of - OneInst { cir_mk_ev = mk_ev } - -> chooseInstance work_ct - (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) - _ -> continueWith work_ct } - - | otherwise - = continueWith work_ct + = do { ev_binds_var <- getTcEvBindsVar + ; ics <- getInertCans + ; if isWanted ev -- Never look up Givens in quantified constraints + && not (null (inert_insts ics)) -- Shortcut common case + && not (isCoEvBindsVar ev_binds_var) -- See Note [Instances in no-evidence implications] + then try_for_qci + else continueWith work_ct } where ev = ctEvidence work_ct loc = ctEvLoc ev + role = eqRelRole eq_rel + + try_for_qci -- First try looking for (lhs ~ rhs) + | Just (cls, tys) <- boxEqPred eq_rel lhs rhs + = do { res <- matchLocalInst (mkClassPred cls tys) loc + ; traceTcS "final_qci_check:1" (ppr (mkClassPred cls tys)) + ; case res of + OneInst { cir_mk_ev = mk_ev } + -> chooseInstance ev (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) + _ -> try_swapping } + | otherwise + = continueWith work_ct + + try_swapping -- Now try looking for (rhs ~ lhs) (see #23333) + | Just (cls, tys) <- boxEqPred eq_rel rhs lhs + = do { res <- matchLocalInst (mkClassPred cls tys) loc + ; traceTcS "final_qci_check:2" (ppr (mkClassPred cls tys)) + ; case res of + OneInst { cir_mk_ev = mk_ev } + -> do { ev' <- rewriteEqEvidence emptyRewriterSet ev IsSwapped + (mkReflRedn role rhs) (mkReflRedn role lhs) + ; chooseInstance ev' (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) } + _ -> do { traceTcS "final_qci_check:3" (ppr work_ct) + ; continueWith work_ct }} + | otherwise + = continueWith work_ct mk_eq_ev cls tys mk_ev evs | sc_id : rest <- classSCSelIds cls -- Just one superclass for this @@ -2672,6 +2694,27 @@ final_qci_check work_ct eq_rel lhs rhs ev -> pprPanic "mk_eq_ev" (ppr ev) | otherwise = pprPanic "finishEqCt" (ppr work_ct) +{- Note [Instances in no-evidence implications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #15290 we had + [G] forall p q. Coercible p q => Coercible (m p) (m q)) -- Quantified + [W] forall a. m (Int, IntStateT m a) + ~R# + m (Int, StateT Int m a) + +The Given is an ordinary quantified constraint; the Wanted is an implication +equality that arises from + [W] (forall a. t1) ~R# (forall a. t2) + +But because the (t1 ~R# t2) is solved "inside a type" (under that forall a) +we can't generate any term evidence. So we can't actually use that +lovely quantified constraint. Alas! + +This test arranges to ignore the instance-based solution under these +(rare) circumstances. It's sad, but I really don't see what else we can do. +-} + + {- ********************************************************************** * * ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -1303,7 +1303,7 @@ doTopReactOther work_item | otherwise = do { res <- matchLocalInst pred loc ; case res of - OneInst {} -> chooseInstance work_item res + OneInst {} -> chooseInstance ev res _ -> continueWith work_item } where ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1713,8 +1713,8 @@ just a coercion? i.e. evTermCoercion_maybe returns Nothing. Consider [G] forall a. blah => a ~ T [W] S ~# T -Then doTopReactEqPred carefully looks up the (boxed) constraint (S ~ -T) in the quantified constraints, and wraps the (boxed) evidence it +Then doTopReactEqPred carefully looks up the (boxed) constraint (S ~ T) +in the quantified constraints, and wraps the (boxed) evidence it gets back in an eq_sel to extract the unboxed (S ~# T). We can't put that term into a coercion, so we add a value binding h = eq_sel (...) ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -1592,7 +1592,7 @@ instance Outputable TcIdSigInfo where ppr (CompleteSig { sig_bndr = bndr }) = ppr bndr <+> dcolon <+> ppr (idType bndr) ppr (PartialSig { psig_name = name, psig_hs_ty = hs_ty }) - = text "psig" <+> ppr name <+> dcolon <+> ppr hs_ty + = text "[partial signature]" <+> ppr name <+> dcolon <+> ppr hs_ty instance Outputable TcIdSigInst where ppr (TISI { sig_inst_sig = sig, sig_inst_skols = skols ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -448,7 +448,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -134,7 +134,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- For this information, we need to query ghc --info, however, that would + -- require building ghc, which we don't want to do here. Therefore, the + -- logic from `platformHasRTSLinker` is duplicated here. + let rtsLinker = not $ arch `elem` ["powerpc", "powerpc64", "powerpc64le", "s390x", "riscv64", "loongarch64", "javascript", "wasm32"] return TestCompilerArgs{..} ===================================== libraries/base/Data/Fixed.hs ===================================== @@ -163,6 +163,13 @@ instance Enum (Fixed a) where enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c) -- | @since 2.01 +-- +-- Multiplication is not associative or distributive: +-- +-- >>> (0.2 * 0.6 :: Deci) * 0.9 == 0.2 * (0.6 * 0.9) +-- False +-- >>> (0.1 + 0.1 :: Deci) * 0.5 == 0.1 * 0.5 + 0.1 * 0.5 +-- False instance (HasResolution a) => Num (Fixed a) where (MkFixed a) + (MkFixed b) = MkFixed (a + b) (MkFixed a) - (MkFixed b) = MkFixed (a - b) ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Conc.Sync ( -- * Threads ThreadId(..) + , fromThreadId , showThreadId , myThreadId , killThread @@ -148,11 +149,18 @@ garbage collected until you drop the 'ThreadId'. This misfeature would be difficult to correct while continuing to support 'threadStatus'. -} +-- | Map a thread to an integer identifier which is unique within the +-- current process. +-- +-- @since 4.19.0.0 +fromThreadId :: ThreadId -> Word64 +fromThreadId tid = fromIntegral $ getThreadId (id2TSO tid) + -- | @since 4.2.0.0 instance Show ThreadId where showsPrec d t = showParen (d >= 11) $ showString "ThreadId " . - showsPrec d (getThreadId (id2TSO t)) + showsPrec d (fromThreadId t) showThreadId :: ThreadId -> String showThreadId = show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -279,7 +279,7 @@ class (RealFrac a, Floating a) => RealFloat a where -- -- This instance implements IEEE 754 standard with all its usual pitfalls -- about NaN, infinities and negative zero. --- Neither addition not multiplication are associative or distributive: +-- Neither addition nor multiplication are associative or distributive: -- -- >>> (0.1 + 0.1 :: Float) + 0.5 == 0.1 + (0.1 + 0.5) -- False @@ -533,7 +533,7 @@ instance Show Float where -- -- This instance implements IEEE 754 standard with all its usual pitfalls -- about NaN, infinities and negative zero. --- Neither addition not multiplication are associative or distributive: +-- Neither addition nor multiplication are associative or distributive: -- -- >>> (0.1 + 0.1) + 0.4 == 0.1 + (0.1 + 0.4) -- False ===================================== libraries/base/changelog.md ===================================== @@ -4,6 +4,7 @@ * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`. Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it. ([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/87) and [#114](https://github.com/haskell/core-libraries-committee/issues/114)) + * `GHC.Conc.Sync` now exports `fromThreadId :: ThreadId -> Word64`, which maps a thread to a per-process-unique identifier ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `Data.List.!?` ([CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110)) * `maximumBy`/`minimumBy` are now marked as `INLINE` improving performance for unpackable types significantly. ===================================== testsuite/tests/quantified-constraints/T23333.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE QuantifiedConstraints #-} +module T23333 where + +foo1 :: (forall y. Bool ~ y) => z -> Bool +foo1 x = not x + +foo2 :: (forall y. y ~ Bool) => z -> Bool +foo2 x = not x ===================================== testsuite/tests/quantified-constraints/all.T ===================================== @@ -41,4 +41,4 @@ test('T22216d', normal, compile, ['']) test('T22216e', normal, compile, ['']) test('T22223', normal, compile, ['']) test('T19690', normal, compile_fail, ['']) - +test('T23333', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T17284.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MonomorphismRestriction #-} +{-# LANGUAGE PartialTypeSignatures #-} + +module MonoPoly where + +f :: Num a => a -> _ +f x = x + y + +y = f 1 ===================================== testsuite/tests/typecheck/should_fail/T17284.stderr ===================================== @@ -0,0 +1,4 @@ + +T17284.hs:6:1: error: [GHC-16675] + Overloaded signature conflicts with monomorphism restriction + [partial signature] f :: Num a => a -> _ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -681,3 +681,4 @@ test('LazyFieldsDisabled', normal, compile_fail, ['']) test('TyfamsDisabled', normal, compile_fail, ['']) test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) test('CommonFieldTypeMismatch', normal, compile_fail, ['']) +test('T17284', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/875d394a498dbacc7a6527cbc4c5ebd612c1ab36...c2efebb73f835e2c6a93f1c7040c2540368bcf01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/875d394a498dbacc7a6527cbc4c5ebd612c1ab36...c2efebb73f835e2c6a93f1c7040c2540368bcf01 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 21:25:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 17:25:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/base-stability Message-ID: <645c0bd84754c_38ffda13f0a3a5821780f5@gitlab.mail> Ben Gamari pushed new branch wip/base-stability at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/base-stability You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 21:33:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 17:33:45 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 11 commits: compiler: Drop redundant import Message-ID: <645c0db9d41d2_38ffda13f4090d021830a1@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: 5b535f67 by Ben Gamari at 2023-05-10T17:33:23-04:00 compiler: Drop redundant import - - - - - 9ae254c1 by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Factor out errorBelch This was useful when debugging - - - - - 8cbb532c by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Clean up imports of GHC.ExecutionStack - - - - - 29217edd by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 818cc6c4 by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Move prettyCallStack to GHC.Stack - - - - - 50bd92dd by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Move PrimMVar to GHC.MVar - - - - - 6ed3218d by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Use displayException in top-level exception handler Happily this also allows us to eliminate a special case for Deadlock exceptions. - - - - - d5d6b74f by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Introduce exception context - - - - - c72a4217 by Ben Gamari at 2023-05-10T17:33:27-04:00 compiler: Default and warn ExceptionContext constraints - - - - - d8e6cc39 by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Introduce WhileHandling annotations - - - - - f73f3309 by Ben Gamari at 2023-05-10T17:33:27-04:00 base: Don't collect backtraces in onException - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/Exception.hs - + libraries/base/GHC/Exception/Backtrace.hs - + libraries/base/GHC/Exception/Backtrace.hs-boot - + libraries/base/GHC/Exception/Context.hs - + libraries/base/GHC/Exception/Context.hs-boot - libraries/base/GHC/Exception/Type.hs - libraries/base/GHC/ExecutionStack.hs - libraries/base/GHC/ExecutionStack/Internal.hsc - libraries/base/GHC/IO.hs - libraries/base/GHC/IO/Exception.hs - libraries/base/GHC/MVar.hs - libraries/base/GHC/Stack.hs - + libraries/base/GHC/Stack.hs-boot - libraries/base/GHC/Stack/CCS.hs-boot - libraries/base/GHC/Stack/CloneStack.hs - libraries/base/GHC/TopHandler.hs - libraries/base/base.cabal - libraries/base/changelog.md - libraries/base/tests/IO/T21336/T21336a.stderr - libraries/base/tests/IO/T21336/T21336b.stderr - testsuite/tests/ghci.debugger/scripts/T14690.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68027225a6a31e3dbaadee50139e15974c81ac7e...f73f33097195b87fd05ae95b829c639f953548af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68027225a6a31e3dbaadee50139e15974c81ac7e...f73f33097195b87fd05ae95b829c639f953548af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 21:40:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 17:40:44 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 4 commits: base: Introduce exception context Message-ID: <645c0f5c8135e_38ffda13fa280d821921df@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: 2264671d by Ben Gamari at 2023-05-10T17:40:25-04:00 base: Introduce exception context - - - - - df65ca1d by Ben Gamari at 2023-05-10T17:40:25-04:00 compiler: Default and warn ExceptionContext constraints - - - - - 3e92a6bb by Ben Gamari at 2023-05-10T17:40:25-04:00 base: Introduce WhileHandling annotations - - - - - 2d9ea503 by Ben Gamari at 2023-05-10T17:40:25-04:00 base: Don't collect backtraces in onException - - - - - 26 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/Exception.hs - + libraries/base/GHC/Exception/Backtrace.hs - + libraries/base/GHC/Exception/Backtrace.hs-boot - + libraries/base/GHC/Exception/Context.hs - + libraries/base/GHC/Exception/Context.hs-boot - libraries/base/GHC/Exception/Type.hs - libraries/base/GHC/IO.hs - libraries/base/GHC/IO/Exception.hs - libraries/base/GHC/Stack/CCS.hs-boot - libraries/base/GHC/Stack/CloneStack.hs - libraries/base/base.cabal - libraries/base/changelog.md - libraries/base/tests/IO/T21336/T21336a.stderr - libraries/base/tests/IO/T21336/T21336b.stderr - testsuite/tests/ghci.debugger/scripts/T14690.stdout - testsuite/tests/ghci.debugger/scripts/break024.stdout - testsuite/tests/typecheck/should_compile/holes.stderr - testsuite/tests/typecheck/should_compile/holes3.stderr Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -452,6 +452,10 @@ basicKnownKeyNames -- Overloaded record fields hasFieldClassName, + -- ExceptionContext + exceptionContextTyConName, + emptyExceptionContextName, + -- Call Stacks callStackTyConName, emptyCallStackName, pushCallStackName, @@ -557,7 +561,8 @@ gHC_PRIM, gHC_PRIM_PANIC, tYPEABLE, tYPEABLE_INTERNAL, gENERICS, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, mONAD_FAIL, aRROW, gHC_DESUGAR, rANDOM, gHC_EXTS, gHC_IS_LIST, - cONTROL_EXCEPTION_BASE, gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL, + cONTROL_EXCEPTION_BASE, gHC_EXCEPTION_CONTEXT, + gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL, gHC_TYPENATS, gHC_TYPENATS_INTERNAL, dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_CONSTPTR :: Module @@ -619,6 +624,7 @@ rANDOM = mkBaseModule (fsLit "System.Random") gHC_EXTS = mkBaseModule (fsLit "GHC.Exts") gHC_IS_LIST = mkBaseModule (fsLit "GHC.IsList") cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base") +gHC_EXCEPTION_CONTEXT = mkBaseModule (fsLit "GHC.Exception.Context") gHC_GENERICS = mkBaseModule (fsLit "GHC.Generics") gHC_TYPEERROR = mkBaseModule (fsLit "GHC.TypeError") gHC_TYPELITS = mkBaseModule (fsLit "GHC.TypeLits") @@ -1618,6 +1624,13 @@ hasFieldClassName :: Name hasFieldClassName = clsQual gHC_RECORDS (fsLit "HasField") hasFieldClassNameKey +-- ExceptionContext +exceptionContextTyConName, emptyExceptionContextName :: Name +exceptionContextTyConName = + tcQual gHC_EXCEPTION_CONTEXT (fsLit "ExceptionContext") exceptionContextTyConKey +emptyExceptionContextName + = varQual gHC_EXCEPTION_CONTEXT (fsLit "emptyExceptionContext") emptyExceptionContextKey + -- Source Locations callStackTyConName, emptyCallStackName, pushCallStackName, srcLocDataConName :: Name @@ -2085,6 +2098,9 @@ typeCharToNatTyFamNameKey = mkPreludeTyConUnique 415 typeNatToCharTyFamNameKey = mkPreludeTyConUnique 416 constPtrTyConKey = mkPreludeTyConUnique 417 +exceptionContextTyConKey :: Unique +exceptionContextTyConKey = mkPreludeTyConUnique 420 + {- ************************************************************************ * * @@ -2535,6 +2551,9 @@ fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560 makeStaticKey :: Unique makeStaticKey = mkPreludeMiscIdUnique 561 +emptyExceptionContextKey :: Unique +emptyExceptionContextKey = mkPreludeMiscIdUnique 562 + -- Unsafe coercion proofs unsafeEqualityProofIdKey, unsafeCoercePrimIdKey :: Unique unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570 ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -26,7 +26,8 @@ module GHC.Core.Predicate ( -- Implicit parameters isIPLikePred, hasIPSuperClasses, isIPTyCon, isIPClass, - isCallStackTy, isCallStackPred, isCallStackPredTy, + isCallStackPred, isCallStackPredTy, + isExceptionContextPred, isIPPred_maybe, -- Evidence variables @@ -292,6 +293,28 @@ has_ip_super_classes rec_clss cls tys initIPRecTc :: RecTcChecker initIPRecTc = setRecTcMaxBound 1 initRecTc +-- --------------------- ExceptionContext predicates -------------------------- + +-- | Is a 'PredType' an @ExceptionContext@ implicit parameter? +-- +-- If so, return the name of the parameter. +isExceptionContextPred :: Class -> [Type] -> Maybe FastString +isExceptionContextPred cls tys + | [ty1, ty2] <- tys + , isIPClass cls + , isExceptionContextTy ty2 + = isStrLitTy ty1 + | otherwise + = Nothing + +-- | Is a type a 'CallStack'? +isExceptionContextTy :: Type -> Bool +isExceptionContextTy ty + | Just tc <- tyConAppTyCon_maybe ty + = tc `hasKey` exceptionContextTyConKey + | otherwise + = False + -- --------------------- CallStack predicates --------------------------------- isCallStackPredTy :: Type -> Bool ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1406,6 +1406,17 @@ instance Diagnostic TcRnMessage where hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] + TcRnDefaultedExceptionContext ct_loc -> + mkSimpleDecorated $ vcat [ header, warning, proposal ] + where + header, warning, proposal :: SDoc + header + = vcat [ text "Solving for an implicit ExceptionContext constraint" + , nest 2 $ pprCtOrigin (ctLocOrigin ct_loc) <> text "." ] + warning + = vcat [ text "Future versions of GHC will turn this warning into an error." ] + proposal + = vcat [ text "See GHC Proposal #330." ] diagnosticReason = \case TcRnUnknownMessage m @@ -1870,6 +1881,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag + TcRnDefaultedExceptionContext{} + -> WarningWithoutFlag --WarningWithFlag TODO diagnosticHints = \case TcRnUnknownMessage m @@ -2352,6 +2365,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnknownTyVarsOnRhsOfInjCond{} -> noHints + TcRnDefaultedExceptionContext _ + -> noHints diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -3178,6 +3178,14 @@ data TcRnMessage where -} TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage + {-| TcRnDefaultedExceptionContext is a warning that is triggered when the + backward-compatibility logic solving for implicit ExceptionContext + constraints fires. + + Test cases: TODO + -} + TcRnDefaultedExceptionContext :: CtLoc -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -52,16 +52,19 @@ import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad as TcS import GHC.Tc.Types.Constraint import GHC.Tc.Instance.FunDeps +import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.Predicate import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType import GHC.Core.Type import GHC.Core.Ppr +import GHC.Core (Expr(Var)) import GHC.Core.TyCon ( TyConBinder, isTypeFamilyTyCon ) import GHC.Builtin.Types ( liftedRepTy, liftedDataConTy ) import GHC.Core.Unify ( tcMatchTyKi ) import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Types.TyThing ( MonadThings(lookupId) ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Basic ( IntWithInf, intGtLimit @@ -73,7 +76,8 @@ import Control.Monad import Data.Foldable ( toList ) import Data.List ( partition ) import Data.List.NonEmpty ( NonEmpty(..) ) -import GHC.Data.Maybe ( mapMaybe, isJust ) +import GHC.Data.Maybe ( mapMaybe, isJust, runMaybeT, MaybeT ) +import Control.Monad.Trans.Class (lift) {- ********************************************************************************* @@ -534,46 +538,66 @@ simplifyTopWanteds wanteds try_callstack_defaulting :: WantedConstraints -> TcS WantedConstraints try_callstack_defaulting wc - | isEmptyWC wc - = return wc - | otherwise - = defaultCallStacks wc + = defaultConstraints [defaultCallStack, defaultExceptionContext] wc + +defaultExceptionContext :: Ct -> MaybeT TcS () +defaultExceptionContext ct + = do { ClassPred cls tys <- pure $ classifyPredType (ctPred ct) + ; Just {} <- pure $ isExceptionContextPred cls tys + ; emptyEC <- Var <$> lift (lookupId emptyExceptionContextName) + ; let ev = ctEvidence ct + ; let ev_tm = mkEvCast emptyEC (wrapIP (ctEvPred ev)) + ; lift $ warnTcS $ TcRnDefaultedExceptionContext (ctLoc ct) + ; lift $ setEvBindIfWanted ev IsCoherent ev_tm + } -- | Default any remaining @CallStack@ constraints to empty @CallStack at s. -defaultCallStacks :: WantedConstraints -> TcS WantedConstraints -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -defaultCallStacks wanteds +defaultCallStack :: Ct -> MaybeT TcS () +defaultCallStack ct + = do { ClassPred cls tys <- pure $ classifyPredType (ctPred ct) + ; Just {} <- pure $ isCallStackPred cls tys + ; lift $ solveCallStack (ctEvidence ct) EvCsEmpty + } + +defaultConstraints :: [Ct -> MaybeT TcS ()] + -> WantedConstraints + -> TcS WantedConstraints +-- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence +defaultConstraints defaulting_strategies wanteds + | isEmptyWC wanteds = return wanteds + | otherwise = do simples <- handle_simples (wc_simple wanteds) mb_implics <- mapBagM handle_implic (wc_impl wanteds) return (wanteds { wc_simple = simples , wc_impl = catBagMaybes mb_implics }) - where - - handle_simples simples - = catBagMaybes <$> mapBagM defaultCallStack simples - - handle_implic :: Implication -> TcS (Maybe Implication) - -- The Maybe is because solving the CallStack constraint - -- may well allow us to discard the implication entirely - handle_implic implic - | isSolvedStatus (ic_status implic) - = return (Just implic) - | otherwise - = do { wanteds <- setEvBindsTcS (ic_binds implic) $ - -- defaultCallStack sets a binding, so - -- we must set the correct binding group - defaultCallStacks (ic_wanted implic) - ; setImplicationStatus (implic { ic_wanted = wanteds }) } - - defaultCallStack ct - | ClassPred cls tys <- classifyPredType (ctPred ct) - , Just {} <- isCallStackPred cls tys - = do { solveCallStack (ctEvidence ct) EvCsEmpty - ; return Nothing } - - defaultCallStack ct - = return (Just ct) + handle_simples :: Bag Ct -> TcS (Bag Ct) + handle_simples simples + = catBagMaybes <$> mapBagM handle_simple simples + where + handle_simple :: Ct -> TcS (Maybe Ct) + handle_simple ct = go defaulting_strategies + where + go [] = return (Just ct) + go (f:fs) = do + mb <- runMaybeT (f ct) + case mb of + Just () -> return Nothing + Nothing -> go fs + + handle_implic :: Implication -> TcS (Maybe Implication) + -- The Maybe is because solving the CallStack constraint + -- may well allow us to discard the implication entirely + handle_implic implic + | isSolvedStatus (ic_status implic) + = return (Just implic) + | otherwise + = do { wanteds <- setEvBindsTcS (ic_binds implic) $ + -- defaultCallStack sets a binding, so + -- we must set the correct binding group + defaultConstraints defaulting_strategies (ic_wanted implic) + ; setImplicationStatus (implic { ic_wanted = wanteds }) } {- Note [When to do type-class defaulting] ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -530,6 +530,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412 GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333 GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254 + GhcDiagnosticCode "TcRnDefaultedExceptionContext" = 46235 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -48,6 +48,17 @@ Runtime system - ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``. +- Exceptions can now carry arbitrary user-defined annotations via the new + :base-ref:`GHC.Exception.Type.ExceptionContext` implicit parameter of + ``SomeException``. These annotations are intended to be used to carry + context describing the provenance of an exception. + +- GHC now collects backtraces for synchronous exceptions. These are carried by + the exception via the ``ExceptionContext`` mechanism described above. + GHC supports several mechanisms by which backtraces can be collected which + can be individually enabled and disabled via + :base-ref:`GHC.Exception.Backtrace.setEnabledBacktraceMechanisms`. + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -106,7 +106,6 @@ module GHC.Conc.Sync import Foreign import Foreign.C -import Data.Typeable import Data.Maybe import GHC.Base @@ -944,7 +943,7 @@ uncaughtExceptionHandler :: IORef (SomeException -> IO ()) uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler) where defaultHandler :: SomeException -> IO () - defaultHandler se@(SomeException ex) = do + defaultHandler se = do (hFlush stdout) `catchAny` (\ _ -> return ()) let msg = displayException se withCString "%s" $ \cfmt -> ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -4,7 +4,10 @@ , MagicHash , PatternSynonyms #-} -{-# LANGUAGE DataKinds, PolyKinds #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- @@ -27,6 +30,7 @@ module GHC.Exception , ErrorCall(..,ErrorCall) , errorCallException , errorCallWithCallStackException + , toExceptionWithBacktrace -- * Re-exports from GHC.Types , CallStack, fromCallSiteList, getCallStack, prettyCallStack @@ -41,6 +45,8 @@ import GHC.OldList import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS import {-# SOURCE #-} GHC.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc) +import {-# SOURCE #-} GHC.Exception.Backtrace (collectBacktraces) +import GHC.Exception.Context import GHC.Exception.Type -- | Throw an exception. Exceptions may be thrown from purely @@ -49,8 +55,18 @@ import GHC.Exception.Type -- WARNING: You may want to use 'throwIO' instead so that your pure code -- stays exception-free. throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e. - Exception e => e -> a -throw e = raise# (toException e) + (?callStack :: CallStack, Exception e) => e -> a +throw e = + let !se = unsafePerformIO (toExceptionWithBacktrace e) + in raise# se + +toExceptionWithBacktrace :: (HasCallStack, Exception e) + => e -> IO SomeException +toExceptionWithBacktrace e + | backtraceDesired e = do + bt <- collectBacktraces + return (addExceptionContext bt (toException e)) + | otherwise = return (toException e) -- | This is thrown when the user calls 'error'. The first @String@ is the -- argument given to 'error', second @String@ is the location. @@ -84,7 +100,7 @@ errorCallWithCallStackException s stk = unsafeDupablePerformIO $ do implicitParamCallStack = prettyCallStackLines stk ccsCallStack = showCCSStack ccsStack stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack - return $ toException (ErrorCallWithLocation s stack) + toExceptionWithBacktrace (ErrorCallWithLocation s stack) showCCSStack :: [String] -> [String] showCCSStack [] = [] ===================================== libraries/base/GHC/Exception/Backtrace.hs ===================================== @@ -0,0 +1,129 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} + +module GHC.Exception.Backtrace + ( -- * Backtrace mechanisms + BacktraceMechanism(..) + , setEnabledBacktraceMechanisms + , getEnabledBacktraceMechanisms + -- * Collecting backtraces + , Backtraces + , getBacktrace + , collectBacktraces + , collectBacktrace + ) where + +import GHC.Base +import Data.OldList +import GHC.IORef +import GHC.IO.Unsafe (unsafePerformIO) +import GHC.Exception.Context +import GHC.Stack.Types (CallStack) +import qualified GHC.Stack as CallStack +import qualified GHC.ExecutionStack as ExecStack +import qualified GHC.Stack.CloneStack as CloneStack +import qualified GHC.Stack.CCS as CCS + +-- | How to collect a backtrace when an exception is thrown. +data BacktraceMechanism rep where + -- | collect cost-centre stack backtraces (only available when built with profiling) + CostCentreBacktrace :: BacktraceMechanism [String] -- TODO: Proper representation + -- | collect backtraces from native execution stack unwinding + ExecutionStackBacktrace :: BacktraceMechanism String -- TODO: proper representation + -- | collect backtraces from Info Table Provenance Entries + IPEBacktrace :: BacktraceMechanism [CloneStack.StackEntry] + -- | collect 'HasCallStack' backtraces + HasCallStackBacktrace :: BacktraceMechanism CallStack + +newtype EnabledBacktraceMechanisms = + EnabledBacktraceMechanisms { + backtraceMechanismEnabled :: forall a. BacktraceMechanism a -> Bool + } + +defaultEnabledBacktraceMechanisms :: EnabledBacktraceMechanisms +defaultEnabledBacktraceMechanisms = EnabledBacktraceMechanisms f + where + f HasCallStackBacktrace = True + f _ = False + +enabledBacktraceMechanisms :: IORef EnabledBacktraceMechanisms +enabledBacktraceMechanisms = + unsafePerformIO $ newIORef defaultEnabledBacktraceMechanisms +{-# NOINLINE enabledBacktraceMechanisms #-} + +-- | Set how 'Control.Exception.throwIO', et al. collect backtraces. +setEnabledBacktraceMechanisms :: EnabledBacktraceMechanisms -> IO () +setEnabledBacktraceMechanisms = writeIORef enabledBacktraceMechanisms + +-- | Returns the currently enabled 'BacktraceMechanism's. +getEnabledBacktraceMechanisms :: IO EnabledBacktraceMechanisms +getEnabledBacktraceMechanisms = readIORef enabledBacktraceMechanisms + +newtype Backtraces = Backtraces { getBacktrace :: forall a. BacktraceMechanism a -> Maybe a } + +displayBacktraces :: Backtraces -> String +displayBacktraces (Backtraces f) = concat + [ displayOne "Cost-centre stack backtrace" CostCentreBacktrace displayCc + , displayOne "Native stack backtrace" ExecutionStackBacktrace displayExec + , displayOne "IPE backtrace" IPEBacktrace displayIpe + , displayOne "HasCallStack backtrace" HasCallStackBacktrace CallStack.prettyCallStack + ] + where + indent :: Int -> String -> String + indent n s = replicate n ' ' ++ s + + displayCc = intercalate "\n" . map (indent 4) + displayExec = id + displayIpe = intercalate "\n" . map (indent 4 . CloneStack.prettyStackEntry) + + displayOne :: String -> BacktraceMechanism rep -> (rep -> String) -> String + displayOne label mech displ + | Just bt <- f mech = label ++ ":\n" ++ displ bt + | otherwise = "" + +instance ExceptionAnnotation Backtraces where + displayExceptionAnnotation = displayBacktraces + +collectBacktraces :: (?callStack :: CallStack) => IO Backtraces +collectBacktraces = CallStack.withFrozenCallStack $ do + EnabledBacktraceMechanisms enabled <- getEnabledBacktraceMechanisms + let collect :: BacktraceMechanism a -> IO (Maybe a) + collect mech + | enabled mech = collectBacktrace mech + | otherwise = return Nothing + + ccs <- collect CostCentreBacktrace + exec <- collect ExecutionStackBacktrace + ipe <- collect IPEBacktrace + hcs <- collect HasCallStackBacktrace + let f :: BacktraceMechanism rep -> Maybe rep + f CostCentreBacktrace = ccs + f ExecutionStackBacktrace = exec + f IPEBacktrace = ipe + f HasCallStackBacktrace = hcs + return (Backtraces f) + +collectBacktrace :: (?callStack :: CallStack) => BacktraceMechanism a -> IO (Maybe a) +collectBacktrace CostCentreBacktrace = do + strs <- CCS.currentCallStack + case strs of + [] -> return Nothing + _ -> pure (Just strs) + +collectBacktrace ExecutionStackBacktrace = do + mst <- ExecStack.showStackTrace + case mst of + Nothing -> return Nothing + Just st -> return (Just st) + +collectBacktrace IPEBacktrace = do + stack <- CloneStack.cloneMyStack + stackEntries <- CloneStack.decode stack + return (Just stackEntries) + +collectBacktrace HasCallStackBacktrace = + return (Just ?callStack) + ===================================== libraries/base/GHC/Exception/Backtrace.hs-boot ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RoleAnnotations #-} + +module GHC.Exception.Backtrace where + +import GHC.Base (IO) +import GHC.Stack.Types (HasCallStack) +import GHC.Exception.Context (ExceptionAnnotation) + +data Backtraces + +instance ExceptionAnnotation Backtraces + +-- For GHC.Exception +collectBacktraces :: HasCallStack => IO Backtraces ===================================== libraries/base/GHC/Exception/Context.hs ===================================== @@ -0,0 +1,89 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} +{-# OPTIONS_HADDOCK not-home #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Exception.Context +-- Copyright : (c) The University of Glasgow, 1998-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- Exception context type. +-- +----------------------------------------------------------------------------- + +module GHC.Exception.Context + ( -- * Exception context + ExceptionContext(..) + , emptyExceptionContext + , addExceptionAnnotation + , getExceptionAnnotations + , getAllExceptionAnnotations + , mergeExceptionContext + -- * Exception annotations + , SomeExceptionAnnotation(..) + , ExceptionAnnotation(..) + ) where + +import GHC.Base ((++), return, String, Maybe(..), Semigroup(..), Monoid(..)) +import GHC.Show (Show(..)) +import Data.Typeable.Internal (Typeable, typeRep, eqTypeRep) +import Data.Type.Equality ( (:~~:)(HRefl) ) + +-- | Exception context represents a list of 'ExceptionAnnotation's. These are +-- attached to 'SomeException's via 'Control.Exception.addExceptionContext' and +-- can be used to capture various ad-hoc metadata about the exception including +-- backtraces and application-specific context. +-- +-- 'ExceptionContext's can be merged via concatenation using the 'Semigroup' +-- instance or 'mergeExceptionContext'. +data ExceptionContext = ExceptionContext [SomeExceptionAnnotation] + +instance Semigroup ExceptionContext where + (<>) = mergeExceptionContext + +instance Monoid ExceptionContext where + mempty = emptyExceptionContext + +-- | An 'ExceptionContext' containing no annotations. +emptyExceptionContext :: ExceptionContext +emptyExceptionContext = ExceptionContext [] + +-- | Construct a singleton 'ExceptionContext' from an 'ExceptionAnnotation'. +addExceptionAnnotation :: ExceptionAnnotation a => a -> ExceptionContext -> ExceptionContext +addExceptionAnnotation x (ExceptionContext xs) = ExceptionContext (SomeExceptionAnnotation x : xs) + +getExceptionAnnotations :: forall a. ExceptionAnnotation a => ExceptionContext -> [a] +getExceptionAnnotations (ExceptionContext xs) = + [ x + | SomeExceptionAnnotation (x :: b) <- xs + , Just HRefl <- return (typeRep @a `eqTypeRep` typeRep @b) + ] + +getAllExceptionAnnotations :: ExceptionContext -> [SomeExceptionAnnotation] +getAllExceptionAnnotations (ExceptionContext xs) = xs + +-- | Merge two 'ExceptionContext's via concatenation +mergeExceptionContext :: ExceptionContext -> ExceptionContext -> ExceptionContext +mergeExceptionContext (ExceptionContext a) (ExceptionContext b) = ExceptionContext (a ++ b) + + +data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a + +-- | 'ExceptionAnnotation's are types which can decorate exceptions as +-- 'ExceptionContext'. +class (Typeable a) => ExceptionAnnotation a where + -- | Render the annotation for display to the user. + displayExceptionAnnotation :: a -> String + + default displayExceptionAnnotation :: Show a => a -> String + displayExceptionAnnotation = show + ===================================== libraries/base/GHC/Exception/Context.hs-boot ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.Exception.Context where + +data ExceptionContext + ===================================== libraries/base/GHC/Exception/Type.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK not-home #-} @@ -20,7 +22,20 @@ module GHC.Exception.Type ( Exception(..) -- Class - , SomeException(..), ArithException(..) + , SomeException(..) + , exceptionContext + , addExceptionContext + , mapExceptionContext + , NoBacktrace(..) + -- * Exception context + , ExceptionContext(..) + , emptyExceptionContext + , mergeExceptionContext + , ExceptionWithContext(..) + -- * 'WhileHandling' annotations + , WhileHandling(..) + -- * Arithmetic exceptions + , ArithException(..) , divZeroException, overflowException, ratioZeroDenomException , underflowException ) where @@ -30,13 +45,28 @@ import Data.Typeable (Typeable, cast) -- loop: Data.Typeable -> GHC.Err -> GHC.Exception import GHC.Base import GHC.Show +import GHC.Exception.Context {- | The @SomeException@ type is the root of the exception type hierarchy. When an exception of type @e@ is thrown, behind the scenes it is encapsulated in a @SomeException at . -} -data SomeException = forall e . Exception e => SomeException e +data SomeException = forall e. (Exception e, ?exceptionContext :: ExceptionContext) => SomeException e + +-- | View the 'ExceptionContext' of a 'SomeException'. +exceptionContext :: SomeException -> ExceptionContext +exceptionContext (SomeException _) = ?exceptionContext + +-- | Add more 'ExceptionContext' to a 'SomeException'. +addExceptionContext :: ExceptionAnnotation a => a -> SomeException -> SomeException +addExceptionContext ann = + mapExceptionContext (addExceptionAnnotation ann) + +mapExceptionContext :: (ExceptionContext -> ExceptionContext) -> SomeException -> SomeException +mapExceptionContext f se@(SomeException e) = + let ?exceptionContext = f (exceptionContext se) + in SomeException e -- | @since 3.0 instance Show SomeException where @@ -129,10 +159,12 @@ Caught MismatchedParentheses -} class (Typeable e, Show e) => Exception e where + -- | @toException@ should produce a 'SomeException' with no attached 'ExceptionContext'. toException :: e -> SomeException fromException :: SomeException -> Maybe e - toException = SomeException + toException e = SomeException e + where ?exceptionContext = emptyExceptionContext fromException (SomeException e) = cast e -- | Render this exception value in a human-friendly manner. @@ -143,14 +175,63 @@ class (Typeable e, Show e) => Exception e where displayException :: e -> String displayException = show + backtraceDesired :: e -> Bool + backtraceDesired _ = True + -- | @since 4.8.0.0 instance Exception Void -- | @since 3.0 instance Exception SomeException where - toException se = se + toException (SomeException e) = + let ?exceptionContext = emptyExceptionContext + in SomeException e fromException = Just - displayException (SomeException e) = displayException e + backtraceDesired (SomeException e) = backtraceDesired e + displayException (SomeException e) = + displayException e ++ "\n" ++ displayContext ?exceptionContext + +displayContext :: ExceptionContext -> String +displayContext (ExceptionContext anns0) = go anns0 + where + go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns + go [] = "\n" + +newtype NoBacktrace e = NoBacktrace e + deriving (Show) + +instance Exception e => Exception (NoBacktrace e) where + fromException = fmap NoBacktrace . fromException + toException (NoBacktrace e) = toException e + backtraceDesired _ = False + +-- | Wraps a particular exception exposing its 'ExceptionContext'. Intended to +-- be used when 'catch'ing exceptions in cases where access to the context is +-- desired. +data ExceptionWithContext a = ExceptionWithContext ExceptionContext a + +instance Show a => Show (ExceptionWithContext a) where + showsPrec _ (ExceptionWithContext _ e) = showString "ExceptionWithContext _ " . shows e + +instance Exception a => Exception (ExceptionWithContext a) where + toException (ExceptionWithContext ctxt e) = + SomeException e + where ?exceptionContext = ctxt + fromException se = do + e <- fromException se + return (ExceptionWithContext (exceptionContext se) e) + backtraceDesired (ExceptionWithContext _ e) = backtraceDesired e + displayException = displayException . toException + +-- | An 'ExceptionAnnotation' applied by 'catch' and similar operations +-- to exceptions thrown while handling another exception. +-- +-- @since 4.19.0.0 +newtype WhileHandling = WhileHandling SomeException + +instance ExceptionAnnotation WhileHandling where + displayExceptionAnnotation (WhileHandling e) = + "While handling: " ++ displayException e -- |Arithmetic exceptions. data ArithException ===================================== libraries/base/GHC/IO.hs ===================================== @@ -28,6 +28,7 @@ module GHC.IO ( unsafePerformIO, unsafeInterleaveIO, unsafeDupablePerformIO, unsafeDupableInterleaveIO, noDuplicate, + annotateIO, -- To and from ST stToIO, ioToST, unsafeIOToST, unsafeSTToIO, @@ -47,8 +48,10 @@ import GHC.ST import GHC.Exception import GHC.Show import GHC.IO.Unsafe +import GHC.Stack.Types ( HasCallStack ) import Unsafe.Coerce ( unsafeCoerce ) +import GHC.Exception.Context ( ExceptionAnnotation ) import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError ) -- --------------------------------------------------------------------------- @@ -158,6 +161,10 @@ catchException !io handler = catch io handler -- to catch exceptions of any type, see the section \"Catching all -- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so. -- +-- If the exception handler throws an exception during execution, the +-- thrown exception will be annotated with a 'WhileHandling' +-- 'ExceptionAnnotation'. +-- -- For catching exceptions in pure (non-'IO') expressions, see the -- function 'evaluate'. -- @@ -182,10 +189,29 @@ catch :: Exception e -> IO a -- See #exceptions_and_strictness#. catch (IO io) handler = IO $ catch# io handler' - where handler' e = case fromException e of - Just e' -> unIO (handler e') - Nothing -> raiseIO# e - + where + handler' e = + case fromException e of + Just e' -> unIO (withWhileHandling e (handler e')) + Nothing -> raiseIO# e + +-- | Catch an exception without adding a 'CausedBy' 'ExceptionContext' to any +-- exceptions thrown by the handler. See the documentation of 'catch' for a +-- detailed description of the semantics of this function. +-- +-- @since 4.19.0.0 +catchNoCause + :: Exception e + => IO a -- ^ The computation to run + -> (e -> IO a) -- ^ Handler to invoke if an exception is raised + -> IO a +-- See #exceptions_and_strictness#. +catchNoCause (IO io) handler = IO $ catch# io handler' + where + handler' e = + case fromException e of + Just e' -> unIO (handler e') + Nothing -> raiseIO# e -- | Catch any 'Exception' type in the 'IO' monad. -- @@ -194,7 +220,19 @@ catch (IO io) handler = IO $ catch# io handler' -- details. catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a catchAny !(IO io) handler = IO $ catch# io handler' - where handler' (SomeException e) = unIO (handler e) + where + handler' se@(SomeException e) = + unIO (withWhileHandling se (handler e)) + +withWhileHandling :: SomeException -> IO a -> IO a +withWhileHandling cause = annotateIO (WhileHandling cause) + +-- | Execute an 'IO' action, adding the given 'ExceptionContext' +-- to any thrown synchronous exceptions. +annotateIO :: forall e a. ExceptionAnnotation e => e -> IO a -> IO a +annotateIO ann (IO io) = IO (catch# io handler) + where + handler se = raiseIO# (addExceptionContext ann se) -- Using catchException here means that if `m` throws an -- 'IOError' /as an imprecise exception/, we will not catch @@ -235,8 +273,10 @@ mplusIO m n = m `catchException` \ (_ :: IOError) -> n -- for a more technical introduction to how GHC optimises around precise vs. -- imprecise exceptions. -- -throwIO :: Exception e => e -> IO a -throwIO e = IO (raiseIO# (toException e)) +throwIO :: (HasCallStack, Exception e) => e -> IO a +throwIO e = do + se <- toExceptionWithBacktrace e + IO (raiseIO# se) -- ----------------------------------------------------------------------------- -- Controlling asynchronous exception delivery @@ -310,8 +350,9 @@ getMaskingState = IO $ \s -> _ -> MaskedInterruptible #) onException :: IO a -> IO b -> IO a -onException io what = io `catchException` \e -> do _ <- what - throwIO (e :: SomeException) +onException io what = io `catchException` \e -> do + _ <- what + throwIO $ NoBacktrace (e :: SomeException) -- | Executes an IO computation with asynchronous -- exceptions /masked/. That is, any thread which attempts to raise ===================================== libraries/base/GHC/IO/Exception.hs ===================================== @@ -56,6 +56,7 @@ import GHC.Exception import GHC.IO.Handle.Types import GHC.OldList ( intercalate ) import {-# SOURCE #-} GHC.Stack.CCS +import GHC.Stack.Types (HasCallStack) import Foreign.C.Types import Data.Typeable ( cast ) @@ -184,18 +185,17 @@ instance Show SomeAsyncException where -- | @since 4.7.0.0 instance Exception SomeAsyncException --- |@since 4.7.0.0 +-- | @since 4.7.0.0 asyncExceptionToException :: Exception e => e -> SomeException asyncExceptionToException = toException . SomeAsyncException --- |@since 4.7.0.0 +-- | @since 4.7.0.0 asyncExceptionFromException :: Exception e => SomeException -> Maybe e asyncExceptionFromException x = do SomeAsyncException a <- fromException x cast a - --- |Asynchronous exceptions. +-- | Asynchronous exceptions. data AsyncException = StackOverflow -- ^The current thread\'s stack exceeded its limit. @@ -306,11 +306,11 @@ data ExitCode -- | @since 4.1.0.0 instance Exception ExitCode -ioException :: IOException -> IO a +ioException :: HasCallStack => IOException -> IO a ioException err = throwIO err -- | Raise an 'IOError' in the 'IO' monad. -ioError :: IOError -> IO a +ioError :: HasCallStack => IOError -> IO a ioError = ioException -- --------------------------------------------------------------------------- ===================================== libraries/base/GHC/Stack/CCS.hs-boot ===================================== @@ -14,3 +14,4 @@ module GHC.Stack.CCS where import GHC.Base currentCallStack :: IO [String] +renderStack :: [String] -> String ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -19,7 +19,8 @@ module GHC.Stack.CloneStack ( StackEntry(..), cloneMyStack, cloneThreadStack, - decode + decode, + prettyStackEntry ) where import GHC.MVar @@ -263,3 +264,7 @@ getDecodedStackArray (StackSnapshot s) = stackEntryAt :: Array# (Ptr InfoProvEnt) -> Int -> Ptr InfoProvEnt stackEntryAt stack (I# i) = case indexArray# stack i of (# se #) -> se + +prettyStackEntry :: StackEntry -> String +prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) = + " " ++ mod_nm ++ "." ++ fun_nm ++ " (" ++ loc ++ ")" ===================================== libraries/base/base.cabal ===================================== @@ -209,6 +209,8 @@ Library GHC.Err GHC.Event.TimeOut GHC.Exception + GHC.Exception.Backtrace + GHC.Exception.Context GHC.Exception.Type GHC.ExecutionStack GHC.ExecutionStack.Internal ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,7 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.19.0.0 *TBA* + * Add `Data.List.!?` ([CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110)) * `maximumBy`/`minimumBy` are now marked as `INLINE` improving performance for unpackable types significantly. @@ -12,6 +13,11 @@ * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) + * Exceptions now capture backtrace information via their `ExceptionContext`. GHC + supports several mechanisms by which backtraces can be collected which can be + individually enabled and disabled via + `GHC.Exception.Backtrace.setEnabledBacktraceMechanisms`. + * Exceptions can now be decorated with user-defined annotations via `ExceptionContext`. ## 4.18.0.0 *TBA* ===================================== libraries/base/tests/IO/T21336/T21336a.stderr ===================================== @@ -1 +1,14 @@ -Exception during weak pointer finalization (ignored): GHC.IO.FD.fdWrite: resource exhausted (No space left on device) +Exception during Weak# finalization (ignored): GHC.IO.FD.fdWrite: resource exhausted (No space left on device) +HasCallStack backtrace: +CallStack (from HasCallStack): + collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace + collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO + throwIO, called at libraries/base/GHC/IO/Exception.hs:315:19 in base:GHC.IO.Exception + ioException, called at libraries/base/GHC/IO/Exception.hs:319:20 in base:GHC.IO.Exception + ioError, called at libraries/base/Foreign/C/Error.hs:288:5 in base:Foreign.C.Error +HasCallStack backtrace: +CallStack (from HasCallStack): + collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace + collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO + throwIO, called at libraries/base/GHC/IO/Handle/Internals.hs:446:17 in base:GHC.IO.Handle.Internals + ===================================== libraries/base/tests/IO/T21336/T21336b.stderr ===================================== @@ -1 +1,9 @@ -Exception during weak pointer finalization (ignored): : hFlush: resource exhausted (No space left on device) +Exception during Weak# finalization (ignored): : hFlush: resource exhausted (No space left on device) +HasCallStack backtrace: +CallStack (from HasCallStack): + collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace + collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO + throwIO, called at libraries/base/GHC/IO/Exception.hs:315:19 in base:GHC.IO.Exception + ioException, called at libraries/base/GHC/IO/Exception.hs:319:20 in base:GHC.IO.Exception + ioError, called at libraries/base/GHC/IO/Handle/Internals.hs:181:13 in base:GHC.IO.Handle.Internals + ===================================== testsuite/tests/ghci.debugger/scripts/T14690.stdout ===================================== @@ -1,10 +1,12 @@ Stopped in , -_exception :: e = _ +_exception :: e = GHC.Exception.Type.SomeException + (GHC.Exception.ErrorCallWithLocation _ _) :steplocal is not possible. Cannot determine current top-level binding after a break on error / exception. Use :stepmodule. Stopped in , -_exception :: e = _ +_exception :: e = GHC.Exception.Type.SomeException + (GHC.Exception.ErrorCallWithLocation _ _) :steplocal is not possible. Cannot determine current top-level binding after a break on error / exception. Use :stepmodule. ===================================== testsuite/tests/ghci.debugger/scripts/break024.stdout ===================================== @@ -1,12 +1,14 @@ Left user error (error) Stopped in , -_exception :: e = _ +_exception :: e = SomeException + (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....) _exception = SomeException (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing) *** Exception: user error (error) Stopped in , -_exception :: e = _ +_exception :: e = SomeException + (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....) _exception = SomeException (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing) @@ -14,7 +16,8 @@ Stopped in , _exception :: e = SomeException (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....) Stopped in , -_exception :: e = _ +_exception :: e = SomeException + (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....) _exception = SomeException (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing) ===================================== testsuite/tests/typecheck/should_compile/holes.stderr ===================================== @@ -92,7 +92,9 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] asTypeOf :: forall a. a -> a -> a id :: forall a. a -> a until :: forall a. (a -> Bool) -> (a -> a) -> a -> a - ioError :: forall a. IOError -> IO a + ioError :: forall a. + GHC.Stack.Types.HasCallStack => + IOError -> IO a (!!) :: forall a. GHC.Stack.Types.HasCallStack => [a] -> Int -> a break :: forall a. (a -> Bool) -> [a] -> ([a], [a]) cycle :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a] ===================================== testsuite/tests/typecheck/should_compile/holes3.stderr ===================================== @@ -95,7 +95,9 @@ holes3.hs:11:15: error: [GHC-88464] asTypeOf :: forall a. a -> a -> a id :: forall a. a -> a until :: forall a. (a -> Bool) -> (a -> a) -> a -> a - ioError :: forall a. IOError -> IO a + ioError :: forall a. + GHC.Stack.Types.HasCallStack => + IOError -> IO a (!!) :: forall a. GHC.Stack.Types.HasCallStack => [a] -> Int -> a break :: forall a. (a -> Bool) -> [a] -> ([a], [a]) cycle :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f73f33097195b87fd05ae95b829c639f953548af...2d9ea503c8d71d14325ce4e0b590d8dc136f5b10 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f73f33097195b87fd05ae95b829c639f953548af...2d9ea503c8d71d14325ce4e0b590d8dc136f5b10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 22:22:50 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 10 May 2023 18:22:50 -0400 Subject: [Git][ghc/ghc][wip/T23070-unify] Use the eager unifier in the constraint solver Message-ID: <645c193aa7966_38ffda142b3084c22091e7@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-unify at Glasgow Haskell Compiler / GHC Commits: 5eff4c58 by Simon Peyton Jones at 2023-05-10T23:22:17+01:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 28 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5eff4c589bd0d4a3cff8810140c3399d9f6da4e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5eff4c589bd0d4a3cff8810140c3399d9f6da4e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 10 23:13:26 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 10 May 2023 19:13:26 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] More progress Message-ID: <645c2516238e2_38ffda145c4ad1022249b1@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: c81a1979 by Simon Peyton Jones at 2023-05-11T00:13:03+01:00 More progress - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Solver.hs - − compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - − compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c81a19793224270467c7e971365d63381fa63ebf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c81a19793224270467c7e971365d63381fa63ebf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 01:46:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 10 May 2023 21:46:46 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 8 commits: base: Introduce Data.Enum Message-ID: <645c4906d26c_38ffda1489b1114226239e@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 9bb86f04 by Ben Gamari at 2023-05-10T19:40:21-04:00 base: Introduce Data.Enum - - - - - 682aca44 by Ben Gamari at 2023-05-10T19:40:21-04:00 base: Add export list to GHC.Num.Integer - - - - - 6fa50500 by Ben Gamari at 2023-05-10T19:40:21-04:00 base: Add export list to GHC.Num - - - - - bfac7c16 by Ben Gamari at 2023-05-10T19:40:21-04:00 base: Add export list to GHC.Num.Natural - - - - - d0bbbc05 by Ben Gamari at 2023-05-10T19:40:21-04:00 base: Introduce Data.Show - - - - - 86237fa6 by Ben Gamari at 2023-05-10T21:01:04-04:00 base: Add export list to GHC.Float - - - - - efc8c431 by Ben Gamari at 2023-05-10T21:01:04-04:00 base: Add export list to GHC.Real - - - - - ee8acc6a by Ben Gamari at 2023-05-10T21:01:04-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 9 changed files: - + libraries/base/Data/Enum.hs - + libraries/base/Data/Show.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs Changes: ===================================== libraries/base/Data/Enum.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum ===================================== libraries/base/Data/Show.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Show +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Show' class. +-- +----------------------------------------------------------------------------- + +module Data.Show + ( Show(..) + -- * 'ShowS' + , ShowS + , shows + , showChar, showString, showMultiLineString + , showParen, showCommaSpace, showSpace + , showLitChar, showLitString + ) where + +import GHC.Show + ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,99 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int, int2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + , floorFloat + , ceilingFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Monomorphic equality operators + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , eqFloat, eqDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Num.hs ===================================== @@ -18,7 +18,9 @@ module GHC.Num - ( module GHC.Num + ( Num(..) + , subtract + , quotRemInteger , module GHC.Num.Integer , module GHC.Num.Natural -- reexported for backward compatibility ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,66 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + ) where #include "MachDeps.h" ===================================== libraries/base/base.cabal ===================================== @@ -127,6 +127,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 @@ -151,6 +152,7 @@ Library Data.Proxy Data.Ratio Data.Semigroup + Data.Show Data.STRef Data.STRef.Lazy Data.STRef.Strict ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -20,7 +20,131 @@ -- -- The 'Integer' type. -module GHC.Num.Integer where +module GHC.Num.Integer + ( Integer(..) + , integerCheck + , integerCheck# + + -- * Useful constants + , integerZero + , integerOne + + -- * Conversion with... + -- ** 'Int' + , integerFromInt# + , integerFromInt + , integerToInt# + , integerToInt + -- ** 'BigNat' + , integerFromBigNat# + , integerFromBigNatNeg# + , integerFromBigNatSign# + , integerToBigNatSign# + , integerToBigNatClamp# + -- ** 'Word' + , integerFromWord# + , integerFromWord + , integerFromWordNeg# + , integerFromWordSign# + , integerToWord# + , integerToWord + -- ** 'Natural' + , integerFromNatural + , integerToNaturalClamp + , integerToNatural + , integerToNaturalThrow + -- ** 'Int64'/'Word64' + , integerFromInt64# + , integerFromWord64# + , integerToInt64# + , integerToWord64# + -- ** Floating-point + , integerDecodeDouble# + , integerEncodeDouble# + , integerEncodeDouble + , integerEncodeFloat# + -- ** 'Addr#' + , integerToAddr# + , integerToAddr + , integerFromAddr# + , integerFromAddr + -- ** Limbs + , integerFromWordList + , integerToMutableByteArray# + , integerToMutableByteArray + , integerFromByteArray# + , integerFromByteArray + + -- * Predicates + , integerIsNegative# + , integerIsNegative + , integerIsZero + , integerIsOne + + -- * Comparison + , integerNe + , integerEq + , integerLe + , integerLt + , integerGt + , integerGe + , integerEq# + , integerNe# + , integerGt# + , integerLe# + , integerLt# + , integerGe# + , integerCompare + + -- * Arithmetic + , integerSub + , integerAdd + , integerMul + , integerNegate + , integerAbs + , integerSignum + , integerSignum# + , integerQuotRem# + , integerQuotRem + , integerQuot + , integerRem + , integerDivMod# + , integerDivMod + , integerDiv + , integerMod + , integerGcd + , integerLcm + , integerSqr + , integerLog2# + , integerLog2 + , integerLogBaseWord# + , integerLogBaseWord + , integerLogBase# + , integerLogBase + , integerIsPowerOf2# + , integerGcde# + , integerGcde + , integerRecipMod# + , integerPowMod# + + -- * Bit operations + , integerPopCount# + , integerBit# + , integerBit + , integerTestBit# + , integerTestBit + , integerShiftR# + , integerShiftR + , integerShiftL# + , integerShiftL + , integerOr + , integerXor + , integerAnd + , integerComplement + + -- * Miscellaneous + , integerSizeInBase# + ) where #include "MachDeps.h" #include "WordSize.h" ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -8,7 +8,109 @@ #include "MachDeps.h" #include "WordSize.h" -module GHC.Num.Natural where +module GHC.Num.Natural + ( Natural(..) + , naturalCheck# + , naturalCheck + + -- * Useful constants + , naturalZero + , naturalOne + + -- * Predicates + , naturalIsZero + , naturalIsOne + , naturalIsPowerOf2# + + -- * Conversion with... + -- ** 'BigNat' + , naturalFromBigNat# + , naturalToBigNat# + -- ** 'Word' + , naturalFromWord# + , naturalFromWord2# + , naturalFromWord + , naturalToWord# + , naturalToWord + , naturalToWordClamp# + , naturalToWordClamp + , naturalToWordMaybe# + -- ** Limbs + , naturalFromWordList + , naturalToMutableByteArray# + , naturalFromByteArray# + -- ** Floating point + , naturalEncodeDouble# + , naturalEncodeFloat# + -- ** 'Addr#' + , naturalToAddr# + , naturalToAddr + , naturalFromAddr# + , naturalFromAddr + + -- * Comparison + , naturalEq# + , naturalEq + , naturalNe# + , naturalNe + , naturalGe# + , naturalGe + , naturalLe# + , naturalLe + , naturalGt# + , naturalGt + , naturalLt# + , naturalLt + , naturalCompare + + -- * Bit operations + , naturalPopCount# + , naturalPopCount + , naturalShiftR# + , naturalShiftR + , naturalShiftL# + , naturalShiftL + , naturalAnd + , naturalAndNot + , naturalOr + , naturalXor + , naturalTestBit# + , naturalTestBit + , naturalBit# + , naturalBit + , naturalSetBit# + , naturalSetBit + , naturalClearBit# + , naturalClearBit + , naturalComplementBit# + , naturalComplementBit + + -- * Arithmetic + , naturalAdd + , naturalSub + , naturalSubThrow + , naturalSubUnsafe + , naturalMul + , naturalSqr + , naturalSignum + , naturalNegate + , naturalQuotRem# + , naturalQuotRem + , naturalQuot + , naturalRem + , naturalGcd + , naturalLcm + , naturalLog2# + , naturalLog2 + , naturalLogBaseWord# + , naturalLogBaseWord + , naturalLogBase# + , naturalLogBase + , naturalPowMod + + -- * Miscellaneous + , naturalSizeInBase# + ) where import GHC.Prim import GHC.Types View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4780d9128709b7556f5a4ec5e6fdeb5ab6ee46e...ee8acc6a23af4bd521636a715641a2da5b1f8eb0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4780d9128709b7556f5a4ec5e6fdeb5ab6ee46e...ee8acc6a23af4bd521636a715641a2da5b1f8eb0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 02:53:34 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 10 May 2023 22:53:34 -0400 Subject: [Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <645c58aebf191_38ffda14930ea54226777@gitlab.mail> Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC Commits: f3656646 by Josh Meredith at 2023-05-11T02:53:22+00:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 9 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,13 +6,15 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS , identsV , identsE -- * Saturation - , jsSaturate + , satJStat + , satJExpr -- * Generic traversal (via compos) , JMacro(..) , JMGadt(..) @@ -21,8 +23,6 @@ module GHC.JS.Transform , composOpM , composOpM_ , composOpFold - , satJExpr - , satJStat ) where @@ -33,11 +33,12 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) +import Data.List (sortBy) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique.Map +import GHC.Types.Unique.FM {-# INLINE identsS #-} @@ -205,69 +206,62 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) +satJStat :: Maybe FastString -> JStat -> Sat.JStat +satJStat str x = evalState (jsSaturateS x) (newIdentSupply str) + +satJExpr :: Maybe FastString -> JExpr -> Sat.JExpr +satJExpr str x = evalState (jsSaturateE x) (newIdentSupply str) + +jsSaturateS :: JStat -> State [Ident] Sat.JStat +jsSaturateS = \case + DeclStat i rhs -> Sat.DeclStat i <$> mapM jsSaturateE rhs + ReturnStat e -> Sat.ReturnStat <$> jsSaturateE e + IfStat c t e -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e + WhileStat is_do c e -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e + ForStat init p step body -> Sat.ForStat <$> jsSaturateS init <*> jsSaturateE p + <*> jsSaturateS step <*> jsSaturateS body + ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body + SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct + <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps + <*> jsSaturateS def + TryStat t i c f -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f + BlockStat bs -> fmap Sat.BlockStat $! mapM jsSaturateS bs + ApplStat rator rand -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand + UOpStat rator rand -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand + AssignStat lhs rhs -> Sat.AssignStat <$> jsSaturateE lhs <*> pure Sat.AssignOp <*> jsSaturateE rhs + LabelStat lbl stmt -> Sat.LabelStat lbl <$> jsSaturateS stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + FuncStat i args body -> Sat.FuncStat i args <$> jsSaturateS body + UnsatBlock us -> jsSaturateS =<< runIdentSupply us + +jsSaturateE :: JExpr -> State [Ident] Sat.JExpr +jsSaturateE = \case + ValExpr v -> Sat.ValExpr <$> jsSaturateV v + SelExpr obj i -> Sat.SelExpr <$> jsSaturateE obj <*> pure i + IdxExpr o i -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i + InfixExpr op l r -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r + UOpExpr op r -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r + IfExpr c t e -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e + ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands + UnsatExpr us -> jsSaturateE =<< runIdentSupply us + +jsSaturateV :: JVal -> State [Ident] Sat.JVal +jsSaturateV = \case + JVar i -> return $ Sat.JVar i + JList xs -> Sat.JList <$> mapM jsSaturateE xs + JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) + JInt i -> return $ Sat.JInt i + JStr s -> return $ Sat.JStr s + JRegEx f -> return $ Sat.JRegEx f + JHash m -> Sat.JHash <$> mapUniqMapM satHash m where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v - - --------------------------------------------------------------------------------- --- Translation --- --------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForStat init p step body) = Sat.ForStat - (witness init) (satJExpr p) - (witness step) (witness body) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) Sat.AssignOp (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness (FuncStat i args body) = Sat.FuncStat i args (witness body) - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - - -satJExpr :: JExpr -> Sat.JExpr -satJExpr = go - where - go (ValExpr v) = Sat.ValExpr (satJVal v) - go (SelExpr obj i) = Sat.SelExpr (satJExpr obj) i - go (IdxExpr o i) = Sat.IdxExpr (satJExpr o) (satJExpr i) - go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r) - go (UOpExpr op r) = Sat.UOpExpr (satJUOp op) (satJExpr r) - go (IfExpr c t e) = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e) - go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands) - go UnsatExpr{} = error "satJExpr: discovered an Unsat...impossibly" + satHash (i, x) = (i,) . (i,) <$> jsSaturateE x + compareHash (i,_) (j,_) = lexicalCompareFS i j + -- By lexically sorting the elements, the non-determinism introduced by nonDetEltsUFM is avoided + mapUniqMapM f (UniqMap m) = UniqMap . listToUFM <$> (mapM f . sortBy compareHash $ nonDetEltsUFM m) + JFunc args body -> Sat.JFunc args <$> jsSaturateS body + UnsatVal us -> jsSaturateV =<< runIdentSupply us satJOp :: JOp -> Sat.Op satJOp = go @@ -313,15 +307,3 @@ satJUOp = go go PreDecOp = Sat.PreDecOp go PostDecOp = Sat.PostDecOp -satJVal :: JVal -> Sat.JVal -satJVal = go - where - go (JVar i) = Sat.JVar i - go (JList xs) = Sat.JList (satJExpr <$> xs) - go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) - go (JInt i) = Sat.JInt i - go (JStr f) = Sat.JStr f - go (JRegEx f) = Sat.JRegEx f - go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) - go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,10 +134,9 @@ genUnits m ss spt_entries foreign_stubs = do glbl <- State.gets gsGlobal staticInit <- initStaticPtrs spt_entries - let stat = ( jsOptimize - . satJStat - . jsSaturate (Just $ modulePrefix m 1) - $ mconcat (reverse glbl) <> staticInit) + let stat = ( jsOptimize . + satJStat (Just $ modulePrefix m 1) + $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] let oi = ObjUnit { oiSymbols = syms @@ -210,8 +209,7 @@ genUnits m ss spt_entries foreign_stubs = do si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 let stat = jsOptimize - . satJStat - $ jsSaturate (Just $ modulePrefix m n) body + $ satJStat (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -249,8 +247,7 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = jsOptimize - . satJStat - . jsSaturate (Just $ modulePrefix m n) + . satJStat (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps let oi = ObjUnit @@ -339,7 +336,7 @@ genToplevelRhs i rhs = case rhs of eid@(TxtI eidt) <- identForEntryId i (TxtI idt) <- identForId i body <- genBody (initExprCtx i) R2 args body typ - global_occs <- globalOccs (jsSaturate (Just "ghcjs_tmp_sat_") body) + global_occs <- globalOccs (satJStat (Just "ghcjs_tmp_sat_") body) let lidents = map global_ident global_occs let lids = map global_id global_occs let lidents' = map identFS lidents ===================================== compiler/GHC/StgToJS/CoreUtils.hs ===================================== @@ -253,7 +253,7 @@ assocPrimReps (r:rs) vs = case (primRepSize r,vs) of (NoSlot, xs) -> (r,[]) : assocPrimReps rs xs (OneSlot, x:xs) -> (r,[x]) : assocPrimReps rs xs (TwoSlots, x:y:xs) -> (r,[x,y]) : assocPrimReps rs xs - err -> pprPanic "assocPrimReps" (ppr $ fmap (map satJExpr) $ err) + err -> pprPanic "assocPrimReps" (ppr $ map (satJExpr Nothing) <$> err) -- | Associate the given values to the Id's PrimReps, taking into account the -- number of slots per PrimRep ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -60,8 +60,8 @@ genCon ctx con args | xs <- concatMap typex_expr (ctxTarget ctx) = pprPanic "genCon: unhandled DataCon" (ppr (con - , fmap satJExpr args - , fmap satJExpr xs + , satJExpr Nothing <$> args + , satJExpr Nothing <$> xs )) -- | Allocate a data constructor. Allocate in this context means bind the data @@ -90,7 +90,7 @@ allocUnboxedCon con = \case | isBoolDataCon con && dataConTag con == 2 -> true_ [x] | isUnboxableCon con -> x - xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, fmap satJExpr xs)) + xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, satJExpr Nothing <$> xs)) -- | Allocate an entry function. See 'GHC.StgToJS.hs' for the object layout. allocDynamicE :: Bool -- ^ csInlineAlloc from StgToJSConfig ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -899,7 +899,7 @@ caseCond = \case DataAlt da -> return $ Just (toJExpr $ dataConTag da) LitAlt l -> genLit l >>= \case [e] -> pure (Just e) - es -> pprPanic "caseCond: expected single-variable literal" (ppr $ fmap satJExpr es) + es -> pprPanic "caseCond: expected single-variable literal" (ppr $ satJExpr Nothing <$> es) -- fixme use single tmp var for all branches -- | Load parameters from constructor ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,8 +177,8 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a -saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) +saturateFFI :: Int -> JStat -> Sat.JStat +saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack => ExprCtx ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -333,7 +333,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -31,6 +31,7 @@ import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform import GHC.JS.Optimizer +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,8 +299,8 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat -rtsDecls = jsSaturate (Just "h$RTSD") $ +rtsDecls :: Sat.JStat +rtsDecls = satJStat (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -314,15 +315,15 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . jsOptimize . satJStat . rts +rtsText = show . pretty . jsOptimize . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . jsOptimize . satJStat $ rtsDecls +rtsDeclsText = show . pretty . jsOptimize $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat -rts = jsSaturate (Just "h$RTS") . rts' +rts :: StgToJSConfig -> Sat.JStat +rts = satJStat (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f36566468f0653c5e53844140f30bfccf3c17555 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f36566468f0653c5e53844140f30bfccf3c17555 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 06:14:18 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 11 May 2023 02:14:18 -0400 Subject: [Git][ghc/ghc][wip/t22884] 3 commits: Allow API users to wrap error messages created during 'load' Message-ID: <645c87ba1297c_38ffda14f460ff02284290@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: fa26afc0 by Matthew Pickering at 2023-05-11T07:14:07+01:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - d68100b8 by Matthew Pickering at 2023-05-11T07:14:07+01:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 8d3c21ae by Matthew Pickering at 2023-05-11T07:14:07+01:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 30 changed files: - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Tc/Errors/Ppr.hs - docs/users_guide/9.8.1-notes.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - + testsuite/tests/package/T22884.hs - + testsuite/tests/package/T22884.stderr - + testsuite/tests/package/T22884_interactive.script - + testsuite/tests/package/T22884_interactive.stderr - testsuite/tests/package/T4806.stderr - + testsuite/tests/package/T4806_interactive.script - + testsuite/tests/package/T4806_interactive.stderr - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/all.T - testsuite/tests/package/package01e.stderr - testsuite/tests/package/package06e.stderr - testsuite/tests/package/package07e.stderr - testsuite/tests/package/package08e.stderr - testsuite/tests/perf/compiler/parsing001.stderr - testsuite/tests/plugins/T11244.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3635f32fe170a3b4a85d10ba56d576f9bea16df0...8d3c21ae621af3ac7bfbf79fc25d0044e8c8d6b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3635f32fe170a3b4a85d10ba56d576f9bea16df0...8d3c21ae621af3ac7bfbf79fc25d0044e8c8d6b5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 07:24:23 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 11 May 2023 03:24:23 -0400 Subject: [Git][ghc/ghc][wip/T23070-unify] Use the eager unifier in the constraint solver Message-ID: <645c982725100_38ffda15398b7c4229852e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-unify at Glasgow Haskell Compiler / GHC Commits: cc5d53c5 by Simon Peyton Jones at 2023-05-11T08:26:10+01:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 28 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc5d53c57530b7b3f0c79103fdea34545ea1d7fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc5d53c57530b7b3f0c79103fdea34545ea1d7fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:10:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 04:10:35 -0400 Subject: [Git][ghc/ghc][master] base: Export GHC.Conc.Sync.fromThreadId Message-ID: <645ca2fb55c26_38ffda1550cf8e02309078@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 2 changed files: - libraries/base/GHC/Conc/Sync.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Conc.Sync ( -- * Threads ThreadId(..) + , fromThreadId , showThreadId , myThreadId , killThread @@ -148,11 +149,18 @@ garbage collected until you drop the 'ThreadId'. This misfeature would be difficult to correct while continuing to support 'threadStatus'. -} +-- | Map a thread to an integer identifier which is unique within the +-- current process. +-- +-- @since 4.19.0.0 +fromThreadId :: ThreadId -> Word64 +fromThreadId tid = fromIntegral $ getThreadId (id2TSO tid) + -- | @since 4.2.0.0 instance Show ThreadId where showsPrec d t = showParen (d >= 11) $ showString "ThreadId " . - showsPrec d (getThreadId (id2TSO t)) + showsPrec d (fromThreadId t) showThreadId :: ThreadId -> String showThreadId = show ===================================== libraries/base/changelog.md ===================================== @@ -4,6 +4,7 @@ * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`. Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it. ([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/87) and [#114](https://github.com/haskell/core-libraries-committee/issues/114)) + * `GHC.Conc.Sync` now exports `fromThreadId :: ThreadId -> Word64`, which maps a thread to a per-process-unique identifier ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `Data.List.!?` ([CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110)) * `maximumBy`/`minimumBy` are now marked as `INLINE` improving performance for unpackable types significantly. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a5139522394b901276ffa71283f01420e270746 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a5139522394b901276ffa71283f01420e270746 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:11:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 04:11:17 -0400 Subject: [Git][ghc/ghc][master] Build vanilla alpine bindists Message-ID: <645ca325bbfe3_38ffda1552baa88231417@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 3 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -424,7 +424,7 @@ distroVariables Alpine = mconcat -- T10458, ghcilink002: due to #17869 -- linker_unload_native: due to musl not supporting any means of probing dynlib dependencies -- (see Note [Object unloading]). - , "BROKEN_TESTS" =: "encoding004 T10458 ghcilink002 linker_unload_native" + , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native" ] distroVariables Centos7 = mconcat [ "HADRIAN_ARGS" =: "--docs=no-sphinx" @@ -903,8 +903,11 @@ job_groups = , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) - , standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static) - , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + -- Fully static build, in theory usable on any linux distribution. + , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) + -- Dynamically linked build, suitable for building your own static executables on alpine + , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) + , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") ) @@ -919,6 +922,10 @@ job_groups = ] where + + -- ghcilink002 broken due to #17869 + fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 ") + hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url") tsan_jobs = ===================================== .gitlab/jobs.yaml ===================================== @@ -597,7 +597,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -606,6 +606,68 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-alpine3_12-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "8 weeks", + "paths": [ + "ghc-x86_64-linux-alpine3_12-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--docs=no-sphinx", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -659,7 +721,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -2472,7 +2534,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2535,7 +2597,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2545,6 +2607,69 @@ "XZ_OPT": "-9" } }, + "release-x86_64-linux-alpine3_12-release+no_split_sections": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-alpine3_12-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BUILD_FLAVOUR": "release+no_split_sections", + "CONFIGURE_ARGS": "--disable-ld-override ", + "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", + "IGNORE_PERF_FAILURES": "all", + "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", + "XZ_OPT": "-9" + } + }, "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3581,7 +3706,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -30,6 +30,7 @@ def job_triple(job_name): 'release-x86_64-linux-deb9-release': 'x86_64-deb9-linux', 'release-x86_64-linux-centos7-release': 'x86_64-centos7-linux', 'release-x86_64-linux-alpine3_12-release+fully_static': 'x86_64-alpine3_12-linux-static', + 'release-x86_64-linux-alpine3_12-release': 'x86_64-alpine3_12-linux', 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29be39ba3f187279b19cf451f2d8f58822edab4f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29be39ba3f187279b19cf451f2d8f58822edab4f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:11:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 04:11:49 -0400 Subject: [Git][ghc/ghc][master] Look both ways when looking for quantified equalities Message-ID: <645ca345e287b_38ffda15492d04c23180dd@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - 6 changed files: - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - + testsuite/tests/quantified-constraints/T23333.hs - testsuite/tests/quantified-constraints/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -67,7 +67,7 @@ doTopReactDict inerts work_item@(CDictCan { cc_ev = ev, cc_class = cls OneInst { cir_what = what } -> do { insertSafeOverlapFailureTcS what work_item ; addSolvedDict what ev cls xis - ; chooseInstance work_item lkup_res } + ; chooseInstance ev lkup_res } _ -> -- NoInstance or NotSure -- We didn't solve it; so try functional dependencies with -- the instance environment @@ -100,28 +100,24 @@ tryLastResortProhibitedSuperclass inerts tryLastResortProhibitedSuperclass _ work_item = continueWith work_item -chooseInstance :: Ct -> ClsInstResult -> TcS (StopOrContinue Ct) +chooseInstance :: CtEvidence -> ClsInstResult -> TcS (StopOrContinue Ct) chooseInstance work_item (OneInst { cir_new_theta = theta , cir_what = what , cir_mk_ev = mk_ev , cir_coherence = coherence }) - = do { traceTcS "doTopReact/found instance for" $ ppr ev + = do { traceTcS "doTopReact/found instance for" $ ppr work_item ; deeper_loc <- checkInstanceOK loc what pred ; checkReductionDepth deeper_loc pred - ; evb <- getTcEvBindsVar - ; if isCoEvBindsVar evb - then continueWith work_item - -- See Note [Instances in no-evidence implications] - else - do { evc_vars <- mapM (newWanted deeper_loc (ctRewriters work_item)) theta - ; setEvBindIfWanted ev coherence (mk_ev (map getEvExpr evc_vars)) - ; emitWorkNC (freshGoals evc_vars) - ; stopWith ev "Dict/Top (solved wanted)" }} + ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar) + (ppr work_item) + ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta + ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars)) + ; emitWorkNC (freshGoals evc_vars) + ; stopWith work_item "Dict/Top (solved wanted)" } where - ev = ctEvidence work_item - pred = ctEvPred ev - loc = ctEvLoc ev + pred = ctEvPred work_item + loc = ctEvLoc work_item chooseInstance work_item lookup_res = pprPanic "chooseInstance" (ppr work_item $$ ppr lookup_res) @@ -147,27 +143,6 @@ checkInstanceOK loc what pred | otherwise = loc -{- Note [Instances in no-evidence implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In #15290 we had - [G] forall p q. Coercible p q => Coercible (m p) (m q)) - [W] forall a. m (Int, IntStateT m a) - ~R# - m (Int, StateT Int m a) - -The Given is an ordinary quantified constraint; the Wanted is an implication -equality that arises from - [W] (forall a. t1) ~R# (forall a. t2) - -But because the (t1 ~R# t2) is solved "inside a type" (under that forall a) -we can't generate any term evidence. So we can't actually use that -lovely quantified constraint. Alas! - -This test arranges to ignore the instance-based solution under these -(rare) circumstances. It's sad, but I really don't see what else we can do. --} - - matchClassInst :: DynFlags -> InertSet -> Class -> [Type] -> CtLoc -> TcS ClsInstResult ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -2647,23 +2647,45 @@ finishEqCt work_item@(EqCt { eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel }) final_qci_check :: Ct -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct) -- The "final QCI check" checks to see if we have -- [W] t1 ~# t2 --- and a Given quantified contraint like (forall a b. blah => a :~: b) +-- and a Given quantified contraint like (forall a b. blah => a ~ b) -- Why? See Note [Looking up primitive equalities in quantified constraints] final_qci_check work_ct eq_rel lhs rhs - | isWanted ev - , Just (cls, tys) <- boxEqPred eq_rel lhs rhs - = do { res <- matchLocalInst (mkClassPred cls tys) loc - ; case res of - OneInst { cir_mk_ev = mk_ev } - -> chooseInstance work_ct - (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) - _ -> continueWith work_ct } - - | otherwise - = continueWith work_ct + = do { ev_binds_var <- getTcEvBindsVar + ; ics <- getInertCans + ; if isWanted ev -- Never look up Givens in quantified constraints + && not (null (inert_insts ics)) -- Shortcut common case + && not (isCoEvBindsVar ev_binds_var) -- See Note [Instances in no-evidence implications] + then try_for_qci + else continueWith work_ct } where ev = ctEvidence work_ct loc = ctEvLoc ev + role = eqRelRole eq_rel + + try_for_qci -- First try looking for (lhs ~ rhs) + | Just (cls, tys) <- boxEqPred eq_rel lhs rhs + = do { res <- matchLocalInst (mkClassPred cls tys) loc + ; traceTcS "final_qci_check:1" (ppr (mkClassPred cls tys)) + ; case res of + OneInst { cir_mk_ev = mk_ev } + -> chooseInstance ev (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) + _ -> try_swapping } + | otherwise + = continueWith work_ct + + try_swapping -- Now try looking for (rhs ~ lhs) (see #23333) + | Just (cls, tys) <- boxEqPred eq_rel rhs lhs + = do { res <- matchLocalInst (mkClassPred cls tys) loc + ; traceTcS "final_qci_check:2" (ppr (mkClassPred cls tys)) + ; case res of + OneInst { cir_mk_ev = mk_ev } + -> do { ev' <- rewriteEqEvidence emptyRewriterSet ev IsSwapped + (mkReflRedn role rhs) (mkReflRedn role lhs) + ; chooseInstance ev' (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) } + _ -> do { traceTcS "final_qci_check:3" (ppr work_ct) + ; continueWith work_ct }} + | otherwise + = continueWith work_ct mk_eq_ev cls tys mk_ev evs | sc_id : rest <- classSCSelIds cls -- Just one superclass for this @@ -2672,6 +2694,27 @@ final_qci_check work_ct eq_rel lhs rhs ev -> pprPanic "mk_eq_ev" (ppr ev) | otherwise = pprPanic "finishEqCt" (ppr work_ct) +{- Note [Instances in no-evidence implications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #15290 we had + [G] forall p q. Coercible p q => Coercible (m p) (m q)) -- Quantified + [W] forall a. m (Int, IntStateT m a) + ~R# + m (Int, StateT Int m a) + +The Given is an ordinary quantified constraint; the Wanted is an implication +equality that arises from + [W] (forall a. t1) ~R# (forall a. t2) + +But because the (t1 ~R# t2) is solved "inside a type" (under that forall a) +we can't generate any term evidence. So we can't actually use that +lovely quantified constraint. Alas! + +This test arranges to ignore the instance-based solution under these +(rare) circumstances. It's sad, but I really don't see what else we can do. +-} + + {- ********************************************************************** * * ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -1303,7 +1303,7 @@ doTopReactOther work_item | otherwise = do { res <- matchLocalInst pred loc ; case res of - OneInst {} -> chooseInstance work_item res + OneInst {} -> chooseInstance ev res _ -> continueWith work_item } where ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1713,8 +1713,8 @@ just a coercion? i.e. evTermCoercion_maybe returns Nothing. Consider [G] forall a. blah => a ~ T [W] S ~# T -Then doTopReactEqPred carefully looks up the (boxed) constraint (S ~ -T) in the quantified constraints, and wraps the (boxed) evidence it +Then doTopReactEqPred carefully looks up the (boxed) constraint (S ~ T) +in the quantified constraints, and wraps the (boxed) evidence it gets back in an eq_sel to extract the unboxed (S ~# T). We can't put that term into a coercion, so we add a value binding h = eq_sel (...) ===================================== testsuite/tests/quantified-constraints/T23333.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE QuantifiedConstraints #-} +module T23333 where + +foo1 :: (forall y. Bool ~ y) => z -> Bool +foo1 x = not x + +foo2 :: (forall y. y ~ Bool) => z -> Bool +foo2 x = not x ===================================== testsuite/tests/quantified-constraints/all.T ===================================== @@ -41,4 +41,4 @@ test('T22216d', normal, compile, ['']) test('T22216e', normal, compile, ['']) test('T22223', normal, compile, ['']) test('T19690', normal, compile_fail, ['']) - +test('T23333', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40c7daed0c971e58e86a8189f82f72e9213af8b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40c7daed0c971e58e86a8189f82f72e9213af8b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:12:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 04:12:29 -0400 Subject: [Git][ghc/ghc][master] Move "target has RTS linker" out of settings Message-ID: <645ca36d9c450_38ffda155c56a4c232301c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4830,8 +4830,9 @@ compilerInfo dflags ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), - ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)), - ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)), + ("Have native code generator", showBool $ platformNcgSupported platform), + ("target has RTS linker", showBool $ platformHasRTSLinker platform), + ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ ("Support dynamic-too", showBool $ not isWindows), -- Whether or not we support the @-j@ flag with @--make at . ===================================== compiler/GHC/Platform.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Platform , platformInIntRange , platformInWordRange , platformCConvNeedsExtension + , platformHasRTSLinker , PlatformMisc(..) , SseVersion (..) , BmiVersion (..) @@ -271,6 +272,23 @@ platformCConvNeedsExtension platform = case platformArch platform of | OSDarwin <- platformOS platform -> True _ -> False +-- | Does this platform have an RTS linker? +platformHasRTSLinker :: Platform -> Bool +-- Note that we've inlined this logic in hadrian's +-- Settings.Builders.RunTest.inTreeCompilerArgs. +-- If you change this, be sure to change it too +platformHasRTSLinker p = case archOS_arch (platformArchOS p) of + ArchPPC -> False -- powerpc + ArchPPC_64 ELF_V1 -> False -- powerpc64 + ArchPPC_64 ELF_V2 -> False -- powerpc64le + ArchS390X -> False + ArchRISCV64 -> False + ArchLoongArch64 -> False + ArchJavaScript -> False + ArchWasm32 -> False + _ -> True + + -------------------------------------------------- -- Instruction sets ===================================== configure.ac ===================================== @@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) -dnl ** Does target have runtime linker support? -dnl -------------------------------------------------------------- -case "$target" in - powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) - TargetHasRTSLinker=NO - ;; - *) - TargetHasRTSLinker=YES - ;; -esac -AC_SUBST(TargetHasRTSLinker) - # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT ===================================== distrib/configure.ac.in ===================================== @@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@ bootstrap_llvm_target=@LlvmTarget@ -TargetHasRTSLinker=@TargetHasRTSLinker@ -AC_SUBST(TargetHasRTSLinker) - TargetHasLibm=@TargetHasLibm@ AC_SUBST(TargetHasLibm) ===================================== hadrian/bindist/Makefile ===================================== @@ -116,7 +116,6 @@ lib/settings : config.mk @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@ @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@ TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ -TargetHasRTSLinker = @TargetHasRTSLinker@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@ target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ target-has-ident-directive = @TargetHasIdentDirective@ target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ -target-has-rts-linker = @TargetHasRTSLinker@ target-has-libm = @TargetHasLibm@ target-arm-version = @ARM_ISA@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -79,7 +79,6 @@ data Setting = BuildArch | TargetOsHaskell | TargetArmVersion | TargetWordSize - | TargetHasRtsLinker | BourneShell -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). @@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of TargetArchHaskell -> "target-arch-haskell" TargetOsHaskell -> "target-os-haskell" TargetWordSize -> "target-word-size" - TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" bootIsStage0 :: Stage -> Stage ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -448,7 +448,6 @@ generateSettings = do , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") - , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker") , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -134,7 +134,10 @@ inTreeCompilerArgs stg = do libdir <- System.FilePath.normalise . (top -/-) <$> stageLibPath stg - rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker + -- For this information, we need to query ghc --info, however, that would + -- require building ghc, which we don't want to do here. Therefore, the + -- logic from `platformHasRTSLinker` is duplicated here. + let rtsLinker = not $ arch `elem` ["powerpc", "powerpc64", "powerpc64le", "s390x", "riscv64", "loongarch64", "javascript", "wasm32"] return TestCompilerArgs{..} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c17bb82f1cc66cb819acbfc7727a6b366097a323 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c17bb82f1cc66cb819acbfc7727a6b366097a323 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:13:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 04:13:27 -0400 Subject: [Git][ghc/ghc][master] Add a test for #17284 Message-ID: <645ca3a73446b_38ffda155c9da64232634a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 4 changed files: - compiler/GHC/Tc/Types.hs - + testsuite/tests/typecheck/should_fail/T17284.hs - + testsuite/tests/typecheck/should_fail/T17284.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -1592,7 +1592,7 @@ instance Outputable TcIdSigInfo where ppr (CompleteSig { sig_bndr = bndr }) = ppr bndr <+> dcolon <+> ppr (idType bndr) ppr (PartialSig { psig_name = name, psig_hs_ty = hs_ty }) - = text "psig" <+> ppr name <+> dcolon <+> ppr hs_ty + = text "[partial signature]" <+> ppr name <+> dcolon <+> ppr hs_ty instance Outputable TcIdSigInst where ppr (TISI { sig_inst_sig = sig, sig_inst_skols = skols ===================================== testsuite/tests/typecheck/should_fail/T17284.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MonomorphismRestriction #-} +{-# LANGUAGE PartialTypeSignatures #-} + +module MonoPoly where + +f :: Num a => a -> _ +f x = x + y + +y = f 1 ===================================== testsuite/tests/typecheck/should_fail/T17284.stderr ===================================== @@ -0,0 +1,4 @@ + +T17284.hs:6:1: error: [GHC-16675] + Overloaded signature conflicts with monomorphism restriction + [partial signature] f :: Num a => a -> _ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -681,3 +681,4 @@ test('LazyFieldsDisabled', normal, compile_fail, ['']) test('TyfamsDisabled', normal, compile_fail, ['']) test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) test('CommonFieldTypeMismatch', normal, compile_fail, ['']) +test('T17284', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd0b056ea56643bcca1a23b78f72576f9459ce1b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd0b056ea56643bcca1a23b78f72576f9459ce1b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:13:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 04:13:52 -0400 Subject: [Git][ghc/ghc][master] Document unlawfulness of instance Num Fixed Message-ID: <645ca3c0528a5_38ffda155c9da64233214@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 2 changed files: - libraries/base/Data/Fixed.hs - libraries/base/GHC/Float.hs Changes: ===================================== libraries/base/Data/Fixed.hs ===================================== @@ -163,6 +163,13 @@ instance Enum (Fixed a) where enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c) -- | @since 2.01 +-- +-- Multiplication is not associative or distributive: +-- +-- >>> (0.2 * 0.6 :: Deci) * 0.9 == 0.2 * (0.6 * 0.9) +-- False +-- >>> (0.1 + 0.1 :: Deci) * 0.5 == 0.1 * 0.5 + 0.1 * 0.5 +-- False instance (HasResolution a) => Num (Fixed a) where (MkFixed a) + (MkFixed b) = MkFixed (a + b) (MkFixed a) - (MkFixed b) = MkFixed (a - b) ===================================== libraries/base/GHC/Float.hs ===================================== @@ -279,7 +279,7 @@ class (RealFrac a, Floating a) => RealFloat a where -- -- This instance implements IEEE 754 standard with all its usual pitfalls -- about NaN, infinities and negative zero. --- Neither addition not multiplication are associative or distributive: +-- Neither addition nor multiplication are associative or distributive: -- -- >>> (0.1 + 0.1 :: Float) + 0.5 == 0.1 + (0.1 + 0.5) -- False @@ -533,7 +533,7 @@ instance Show Float where -- -- This instance implements IEEE 754 standard with all its usual pitfalls -- about NaN, infinities and negative zero. --- Neither addition not multiplication are associative or distributive: +-- Neither addition nor multiplication are associative or distributive: -- -- >>> (0.1 + 0.1) + 0.4 == 0.1 + (0.1 + 0.4) -- False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/630b1fea1e41a1e00860a30742b6ab8ade8a0de0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/630b1fea1e41a1e00860a30742b6ab8ade8a0de0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:16:09 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 11 May 2023 04:16:09 -0400 Subject: [Git][ghc/ghc][wip/t22884] error messages: Don't display ghci specific hints for missing packages Message-ID: <645ca449379d9_38ffda1558267b023323ea@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: a92a710f by Matthew Pickering at 2023-05-11T09:15:57+01:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 26 changed files: - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Ppr.hs - ghc/GHCi/UI/Exception.hs - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - + testsuite/tests/package/T22884.hs - + testsuite/tests/package/T22884.stderr - + testsuite/tests/package/T22884_interactive.script - + testsuite/tests/package/T22884_interactive.stderr - testsuite/tests/package/T4806.stderr - + testsuite/tests/package/T4806_interactive.script - + testsuite/tests/package/T4806_interactive.stderr - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/all.T - testsuite/tests/package/package01e.stderr - testsuite/tests/package/package06e.stderr - testsuite/tests/package/package07e.stderr - testsuite/tests/package/package08e.stderr - testsuite/tests/perf/compiler/parsing001.stderr - testsuite/tests/plugins/T11244.stderr - testsuite/tests/plugins/plugins03.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr - testsuite/tests/typecheck/should_fail/tcfail082.stderr Changes: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -19,6 +19,11 @@ module GHC.Iface.Errors.Ppr , missingInterfaceErrorReason , missingInterfaceErrorDiagnostic , readInterfaceErrorDiagnostic + + , lookingForHerald + , cantFindErrorX + , mayShowLocations + , pkgHiddenHint ) where @@ -129,34 +134,34 @@ cantFindError :: IfaceMessageOpts -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindError opts = cantFindErrorX (pkg_hidden_hint (ifaceBuildingCabalPackage opts)) (mayShowLocations (ifaceShowTriedFiles opts)) - where - pkg_hidden_hint using_cabal (Just pkg) - | using_cabal == YesBuildingCabalPackage - = text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - -- MP: This is ghci specific, remove - | otherwise - = text "You can run" <+> - quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> - text "to expose it." $$ - text "(Note: this unloads all the modules in the current scope.)" - pkg_hidden_hint _ Nothing = empty - -mayShowLocations :: Bool -> [FilePath] -> SDoc -mayShowLocations verbose files +cantFindError opts = + cantFindErrorX + (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts)) + (mayShowLocations "-v" (ifaceShowTriedFiles opts)) + + +pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage + -> UnitInfo -> SDoc +pkgHiddenHint _hint YesBuildingCabalPackage pkg + = text "Perhaps you need to add" <+> + quotes (ppr (unitPackageName pkg)) <+> + text "to the build-depends in your .cabal file." +pkgHiddenHint hint _not_cabal pkg + = hint pkg + +mayShowLocations :: String -> Bool -> [FilePath] -> SDoc +mayShowLocations option verbose files | null files = empty | not verbose = - text "Use -v (or `:set -v` in ghci) " <> + text "Use" <+> text option <+> text "to see a list of the files searched for." | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) -- | General version of cantFindError which has some holes which allow GHC/GHCi to display slightly different -- error messages. -cantFindErrorX :: (Maybe UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstalled mod_name cfir) = +cantFindErrorX :: (UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc +cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInstalled mod_name cfir) = let ambig = isAmbiguousInstalledReason cfir find_or_load = isLoadOrFindReason cfir ppr_what = prettyCantFindWhat find_or_load mod_or_interface ambig @@ -184,11 +189,11 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal text "There are files missing in the " <> quotes (ppr pkg) <+> text "package," $$ text "try running 'ghc-pkg check'." $$ - mayShowLocations files + may_show_locations files MissingPackageWayFiles build pkg files -> text "Perhaps you haven't installed the " <> text build <+> text "libraries for package " <> quotes (ppr pkg) <> char '?' $$ - mayShowLocations files + may_show_locations files ModuleSuggestion ms fps -> let pp_suggestions :: [ModuleSuggestion] -> SDoc @@ -230,7 +235,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> ppr (mkUnit pkg)) | otherwise = empty - in pp_suggestions ms $$ mayShowLocations fps + in pp_suggestions ms $$ may_show_locations fps NotAModule -> text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> vcat (map text fps) MultiplePackages mods @@ -248,7 +253,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal vcat (map pkg_hidden pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ vcat (map unusable unusables) $$ - mayShowLocations files + may_show_locations files where pprMod (m, o) = text "it is bound as" <+> ppr m <+> text "by" <+> pprOrigin m o @@ -268,7 +273,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> quotes (ppr uid) --FIXME: we don't really want to show the unit id here we should -- show the source package id or installed package id if it's ambiguous - <> dot $$ pkg_hidden_hint uif + <> dot $$ maybe empty pkg_hidden_hint uif mod_hidden pkg = @@ -285,21 +290,21 @@ interfaceErrorDiagnostic opts = \ case Can'tFindNameInInterface name relevant_tyThings -> missingDeclInInterface name relevant_tyThings Can'tFindInterface err looking_for -> - case looking_for of - LookingForName {} -> - missingInterfaceErrorDiagnostic opts err - LookingForModule {} -> - missingInterfaceErrorDiagnostic opts err - LookingForHiBoot mod -> - hang (text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon) - 2 (missingInterfaceErrorDiagnostic opts err) - LookingForSig sig -> - hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) - 2 (missingInterfaceErrorDiagnostic opts err) + hangNotEmpty (lookingForHerald looking_for) 2 (missingInterfaceErrorDiagnostic opts err) CircularImport mod -> text "Circular imports: module" <+> quotes (ppr mod) <+> text "depends on itself" +lookingForHerald :: InterfaceLookingFor -> SDoc +lookingForHerald looking_for = + case looking_for of + LookingForName {} -> empty + LookingForModule {} -> empty + LookingForHiBoot mod -> + text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon + LookingForSig sig -> + text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon + readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc readInterfaceErrorDiagnostic = \ case ExceptionOccurred fp ex -> ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,6 +21,10 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) , pprTyThingUsedWrong + + -- | Useful when overriding message printing. + , messageWithInfoDiagnosticMessage + , messageWithHsDocContext ) where @@ -126,12 +130,8 @@ instance Diagnostic TcRnMessage where (tcOptsShowContext opts) (diagnosticMessage opts msg) TcRnWithHsDocContext ctxt msg - -> if tcOptsShowContext opts - then main_msg `unionDecoratedSDoc` ctxt_msg - else main_msg - where - main_msg = diagnosticMessage opts msg - ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + -> messageWithHsDocContext opts ctxt (diagnosticMessage opts msg) + TcRnSolverReport msg _ _ -> mkSimpleDecorated $ pprSolverReportWithCtxt msg TcRnRedundantConstraints redundants (info, show_info) @@ -3259,6 +3259,14 @@ messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important = in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc` mkDecorated err_info' +messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc +messageWithHsDocContext opts ctxt main_msg = do + if tcOptsShowContext opts + then main_msg `unionDecoratedSDoc` ctxt_msg + else main_msg + where + ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc dodgy_msg kind tc ie = vcat [ text "The" <+> kind <+> text "item" <+> quotes (ppr ie) <+> text "suggests that" ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -4,14 +4,28 @@ module GHCi.UI.Exception(printGhciException, GHCiMessage(..)) where import GHC.Prelude -import GHC.Utils.Logger -import Control.Monad.IO.Class -import GHC.Driver.Session -import GHC.Types.SourceError -import GHC.Driver.Errors.Types -import GHC.Types.Error + import GHC.Driver.Config.Diagnostic import GHC.Driver.Errors +import GHC.Driver.Errors.Types +import GHC.Driver.Session + +import GHC.Iface.Errors.Ppr +import GHC.Iface.Errors.Types + +import GHC.Tc.Errors.Ppr +import GHC.Tc.Errors.Types + +import GHC.Types.Error +import GHC.Types.SourceError + +import GHC.Unit.State + +import GHC.Utils.Logger +import GHC.Utils.Outputable + +import Control.Monad.IO.Class + -- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting -- for some error messages. @@ -24,15 +38,67 @@ printGhciException err = do liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err)) -newtype GHCiMessage = GHCiMessage { getGhciMessage :: GhcMessage } +newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage } instance Diagnostic GHCiMessage where type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage - diagnosticMessage opts (GHCiMessage msg) = diagnosticMessage opts msg + diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg diagnosticReason (GHCiMessage msg) = diagnosticReason msg diagnosticHints (GHCiMessage msg) = diagnosticHints msg diagnosticCode (GHCiMessage msg) = diagnosticCode msg + +-- Modifications to error messages which we want to display in GHCi +ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc +ghciDiagnosticMessage ghc_opts msg = + case msg of + GhcTcRnMessage tc_msg -> tcRnMessage (tcMessageOpts ghc_opts) tc_msg + GhcDriverMessage (DriverInterfaceError err) -> + case ghciInterfaceError err of + Just sdoc -> mkSimpleDecorated sdoc + Nothing -> diagnosticMessage ghc_opts msg + GhcDriverMessage {} -> diagnosticMessage ghc_opts msg + GhcPsMessage {} -> diagnosticMessage ghc_opts msg + GhcDsMessage {} -> diagnosticMessage ghc_opts msg + GhcUnknownMessage {} -> diagnosticMessage ghc_opts msg + where + tcRnMessage tc_opts tc_msg = + case tc_msg of + TcRnInterfaceError err -> + case ghciInterfaceError err of + Just sdoc -> mkSimpleDecorated sdoc + Nothing -> diagnosticMessage ghc_opts msg + TcRnMessageWithInfo unit_state msg_with_info -> + case msg_with_info of + TcRnMessageDetailed err_info wrapped_msg + -> messageWithInfoDiagnosticMessage unit_state err_info + (tcOptsShowContext tc_opts) + (tcRnMessage tc_opts wrapped_msg) + TcRnWithHsDocContext ctxt wrapped_msg -> + messageWithHsDocContext tc_opts ctxt (tcRnMessage tc_opts wrapped_msg) + _ -> diagnosticMessage ghc_opts msg + + opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts) + + ghciInterfaceError (Can'tFindInterface err looking_for) = + hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err + ghciInterfaceError _ = Nothing + + ghciMissingInterfaceErrorDiagnostic reason = + case reason of + CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi) + _ -> Nothing + where + + may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts) + + pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts) + where + hidden_msg pkg = + text "You can run" <+> + quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> + text "to expose it." $$ + text "(Note: this unloads all the modules in the current scope.)" ===================================== testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr ===================================== @@ -2,4 +2,4 @@ module-visibility-import/MV.hs:5:1: error: [GHC-87110] Could not load module ‘MV2’. it is a hidden module in the package ‘mv’ - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.stderr ===================================== @@ -18,7 +18,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z A.hs:3:1: error: [GHC-87110] Could not find module ‘B’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. == Dep_DM_AB == Dep_Error_DM_AB @@ -27,7 +27,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z A.hs:3:1: error: [GHC-87110] Could not find module ‘B’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. == Dep_MD_AB == Dep_Error_MD_AB ===================================== testsuite/tests/ghc-e/should_run/T2636.stderr ===================================== @@ -1,4 +1,4 @@ T2636.hs:1:1: error: [GHC-87110] Could not find module ‘MissingModule’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/module/mod1.stderr ===================================== @@ -1,4 +1,4 @@ mod1.hs:3:1: error: [GHC-87110] Could not find module ‘N’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/module/mod2.stderr ===================================== @@ -1,4 +1,4 @@ mod2.hs:3:1: error: [GHC-87110] Could not find module ‘N’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T22884.hs ===================================== @@ -0,0 +1,3 @@ +module T22884 where + +import Data.Text ===================================== testsuite/tests/package/T22884.stderr ===================================== @@ -0,0 +1,5 @@ + +T22884.hs:3:1: error: [GHC-87110] + Could not load module ‘Data.Text’. + It is a member of the hidden package ‘text-2.0.2’. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T22884_interactive.script ===================================== @@ -0,0 +1,3 @@ +:set -hide-all-packages + +import Data.Text ===================================== testsuite/tests/package/T22884_interactive.stderr ===================================== @@ -0,0 +1,6 @@ + +: error: [GHC-87110] + Could not load module ‘Data.Text’. + It is a member of the hidden package ‘text-2.0.2’. + You can run ‘:set -package text’ to expose it. + (Note: this unloads all the modules in the current scope.) ===================================== testsuite/tests/package/T4806.stderr ===================================== @@ -3,4 +3,4 @@ T4806.hs:1:1: error: [GHC-87110] Could not load module ‘Data.Map’. It is a member of the package ‘containers-0.6.7’ which is ignored due to an -ignore-package flag - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T4806_interactive.script ===================================== @@ -0,0 +1,3 @@ +:set -ignore-package containers + +:l T4806.hs ===================================== testsuite/tests/package/T4806_interactive.stderr ===================================== @@ -0,0 +1,6 @@ + +T4806.hs:1:1: error: [GHC-87110] + Could not load module ‘Data.Map’. + It is a member of the package ‘containers-0.6.7’ + which is ignored due to an -ignore-package flag + Use :set -v to see a list of the files searched for. ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -4,4 +4,4 @@ T4806a.hs:1:1: error: [GHC-87110] It is a member of the package ‘containers-0.6.7’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: deepseq-1.4.8.1 template-haskell-2.20.0.0 - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/all.T ===================================== @@ -20,3 +20,6 @@ test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers']) test('T4806a', normalise_version('deepseq', 'containers', 'template-haskell'), compile_fail, ['-ignore-package deepseq']) +test('T22884', normalise_version('text'), compile_fail, ['-hide-package text']) +test('T22884_interactive', normalise_version('text'), ghci_script, ['T22884_interactive.script']) +test('T4806_interactive', [extra_files(['T4806.hs']), normalise_version('containers')], ghci_script, ['T4806_interactive.script']) ===================================== testsuite/tests/package/package01e.stderr ===================================== @@ -2,13 +2,9 @@ package01e.hs:2:1: error: [GHC-87110] Could not load module ‘Data.Map’. It is a member of the hidden package ‘containers-0.6.7’. - You can run ‘:set -package containers’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package01e.hs:3:1: error: [GHC-87110] Could not load module ‘Data.IntMap’. It is a member of the hidden package ‘containers-0.6.7’. - You can run ‘:set -package containers’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package06e.stderr ===================================== @@ -2,13 +2,9 @@ package06e.hs:2:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package06e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package07e.stderr ===================================== @@ -5,25 +5,19 @@ package07e.hs:2:1: error: [GHC-61948] GHC.Hs.Type (needs flag -package-id ghc-9.7) GHC.Tc.Types (needs flag -package-id ghc-9.7) GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:4:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Utils’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:5:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package08e.stderr ===================================== @@ -5,25 +5,19 @@ package08e.hs:2:1: error: [GHC-61948] GHC.Hs.Type (needs flag -package-id ghc-9.7) GHC.Tc.Types (needs flag -package-id ghc-9.7) GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:4:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Utils’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:5:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/perf/compiler/parsing001.stderr ===================================== @@ -1,4 +1,4 @@ parsing001.hs:3:1: error: [GHC-87110] Could not find module ‘Wibble’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/plugins/T11244.stderr ===================================== @@ -1,5 +1,3 @@ : Could not load module ‘RuleDefiningPlugin’. It is a member of the hidden package ‘rule-defining-plugin-0.1’. -You can run ‘:set -package rule-defining-plugin’ to expose it. -(Note: this unloads all the modules in the current scope.) -Use -v (or `:set -v` in ghci) to see a list of the files searched for. +Use -v to see a list of the files searched for. ===================================== testsuite/tests/plugins/plugins03.stderr ===================================== @@ -1,2 +1,2 @@ : Could not find module ‘Simple.NonExistentPlugin’. -Use -v (or `:set -v` in ghci) to see a list of the files searched for. +Use -v to see a list of the files searched for. ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr ===================================== @@ -4,4 +4,4 @@ SafeLang07.hs:2:14: warning: SafeLang07.hs:15:1: error: [GHC-87110] Could not find module ‘SafeLang07_A’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/typecheck/should_fail/tcfail082.stderr ===================================== @@ -1,12 +1,12 @@ tcfail082.hs:2:1: error: [GHC-87110] Could not find module ‘Data82’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. tcfail082.hs:3:1: error: [GHC-87110] Could not find module ‘Inst82_1’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. tcfail082.hs:4:1: error: [GHC-87110] Could not find module ‘Inst82_2’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a92a710f67869f51790e750974c4896e1a009900 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a92a710f67869f51790e750974c4896e1a009900 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:26:00 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 11 May 2023 04:26:00 -0400 Subject: [Git][ghc/ghc][wip/compact-sourcetext] 4 commits: Use compact representation for SourceText Message-ID: <645ca698c658f_38ffda15670e1b023408cb@gitlab.mail> Zubin pushed to branch wip/compact-sourcetext at Glasgow Haskell Compiler / GHC Commits: 8a1d15ef by Zubin Duggal at 2023-05-11T13:55:22+05:30 Use compact representation for SourceText - - - - - 1401a0a8 by Zubin Duggal at 2023-05-11T13:55:23+05:30 Use compact representation for SourceNotes - - - - - 75e1e7d7 by Zubin Duggal at 2023-05-11T13:55:23+05:30 Use compact representation for UsageFile (#22744) - - - - - c4e26c80 by Zubin Duggal at 2023-05-11T13:55:23+05:30 testsuite: add test for T22744 - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/IPE.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Types/Tickish.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48435306f9d518deb11c3641369017df547debb4...c4e26c8014d983576310f91ac67b588692d65a4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48435306f9d518deb11c3641369017df547debb4...c4e26c8014d983576310f91ac67b588692d65a4a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:27:47 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 11 May 2023 04:27:47 -0400 Subject: [Git][ghc/ghc][wip/T23070-unify] 7 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <645ca7032ac9e_38ffda1565588202343728@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-unify at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 80d404f6 by Simon Peyton Jones at 2023-05-11T09:21:36+01:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 28 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Platform.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc5d53c57530b7b3f0c79103fdea34545ea1d7fc...80d404f69a9753b28dab79e3897ce5fc5dbd2862 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc5d53c57530b7b3f0c79103fdea34545ea1d7fc...80d404f69a9753b28dab79e3897ce5fc5dbd2862 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 08:45:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 04:45:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <645cab1660c36_38ffda15756310c23477f8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 5d35b32d by sheaf at 2023-05-11T04:45:00-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - fd35cd9a by Krzysztof Gogolewski at 2023-05-11T04:45:00-04:00 Add a test for #21278 - - - - - eab4bb1b by Matthew Pickering at 2023-05-11T04:45:01-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 447f2e1c by Cheng Shao at 2023-05-11T04:45:03-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Platform.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/SysTools/Cpp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2efebb73f835e2c6a93f1c7040c2540368bcf01...447f2e1c9ce714da9a48e075c29f80a4aaddc09f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2efebb73f835e2c6a93f1c7040c2540368bcf01...447f2e1c9ce714da9a48e075c29f80a4aaddc09f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 12:06:57 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Thu, 11 May 2023 08:06:57 -0400 Subject: [Git][ghc/ghc][wip/T23083] 3 commits: Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) Message-ID: <645cda614db20_38ffda15a3de7fc24284f2@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 73b6075e by Sebastian Graf at 2023-05-05T09:46:01+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - 1de52aee by Sebastian Graf at 2023-05-11T13:59:56+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - be2753a2 by Sebastian Graf at 2023-05-11T13:59:56+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Utils/Trace.hs - docs/users_guide/using-optimisation.rst - libraries/base/Unsafe/Coerce.hs - libraries/ghc-bignum/ghc-bignum.cabal - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - + testsuite/tests/simplCore/should_compile/T23083.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9ebee2ce4c512730ca4782393936afb6d2e52fd...be2753a2d1b7e8f26a760c2f5204f453a47d2f33 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9ebee2ce4c512730ca4782393936afb6d2e52fd...be2753a2d1b7e8f26a760c2f5204f453a47d2f33 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 12:26:38 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 11 May 2023 08:26:38 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 64 commits: JS: Fix h$base_access implementation (issue 22576) Message-ID: <645cdefe4180e_38ffda15a5dd36424471ee@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 1d3399e7 by Andrei Borzenkov at 2023-05-11T16:25:23+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Match/Literal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efb8ddf7177102885d14e03c799bd5fa5c69b7a5...1d3399e732162c89031e67bcddba087709abaeba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efb8ddf7177102885d14e03c799bd5fa5c69b7a5...1d3399e732162c89031e67bcddba087709abaeba You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 12:26:43 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 08:26:43 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 3 commits: base: Add export list to GHC.Float Message-ID: <645cdf03e08f8_38ffda159f598582447340@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: b166d4ec by Ben Gamari at 2023-05-11T08:26:37-04:00 base: Add export list to GHC.Float - - - - - 6f78aba0 by Ben Gamari at 2023-05-11T08:26:37-04:00 base: Add export list to GHC.Real - - - - - dfb874b7 by Ben Gamari at 2023-05-11T08:26:37-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 3 changed files: - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Real.hs Changes: ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,102 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int + , int2Float + , word2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + , floorFloat + , ceilingFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , word2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Monomorphic equality operators + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , eqFloat, eqDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,66 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + ) where #include "MachDeps.h" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee8acc6a23af4bd521636a715641a2da5b1f8eb0...dfb874b71fb9a32bc093c551df6eb45017c37a3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee8acc6a23af4bd521636a715641a2da5b1f8eb0...dfb874b71fb9a32bc093c551df6eb45017c37a3a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 12:29:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 08:29:03 -0400 Subject: [Git][ghc/ghc][wip/T23210] Update StgToByteCode.hs Message-ID: <645cdf8fc6bfb_38ffda15a33274024477a3@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: f947a665 by Ben Gamari at 2023-05-11T12:29:01+00:00 Update StgToByteCode.hs - - - - - 1 changed file: - compiler/GHC/StgToByteCode.hs Changes: ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1,4 +1,3 @@ - {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} @@ -1827,7 +1826,7 @@ pushAtom d p (StgVarArg var) Just con | isNullaryRepDataCon con -> do return (unitOL (PACK con 0), szb) - Nothing + _ -- see Note [Generating code for top-level string literal bindings] | isUnliftedType (idType var) -> do massert (idType var `eqType` addrPrimTy) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f947a665f0523a8195515a1a1ee47f34a61efd84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f947a665f0523a8195515a1a1ee47f34a61efd84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 12:34:20 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 11 May 2023 08:34:20 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23362 Message-ID: <645ce0cca6b98_38ffda158ef0c502451341@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23362 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23362 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 12:34:42 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 11 May 2023 08:34:42 -0400 Subject: [Git][ghc/ghc][wip/T23362] Fix coercion optimisation for SelCo (#23362) Message-ID: <645ce0e2a7d9a_38ffda15a4fb2d42451585@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23362 at Glasgow Haskell Compiler / GHC Commits: 64c12e10 by Krzysztof Gogolewski at 2023-05-11T14:34:26+02:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 3 changed files: - compiler/GHC/Core/Coercion.hs - + testsuite/tests/simplCore/should_compile/T23362.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1355,7 +1355,7 @@ mkProofIrrelCo r kco g1 g2 = mkUnivCo (ProofIrrelProv kco) r -- | Converts a coercion to be nominal, if possible. -- See Note [Role twiddling functions] setNominalRole_maybe :: Role -- of input coercion - -> Coercion -> Maybe Coercion + -> Coercion -> Maybe CoercionN setNominalRole_maybe r co | r == Nominal = Just co | otherwise = setNominalRole_maybe_helper co @@ -1380,10 +1380,19 @@ setNominalRole_maybe r co = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2 setNominalRole_maybe_helper (ForAllCo tv kind_co co) = ForAllCo tv kind_co <$> setNominalRole_maybe_helper co - setNominalRole_maybe_helper (SelCo n co) + setNominalRole_maybe_helper (SelCo (SelTyCon n _r) co) -- NB, this case recurses via setNominalRole_maybe, not -- setNominalRole_maybe_helper! - = SelCo n <$> setNominalRole_maybe (coercionRole co) co + -- Remember to update the role in SelTyCon to nominal; + -- not doing this caused #23362. + -- See the typing rule in Note [SelCo] in GHC.Core.TyCo.Rep. + = SelCo (SelTyCon n Nominal) <$> setNominalRole_maybe (coercionRole co) co + setNominalRole_maybe_helper (SelCo (SelFun fs) co) + -- NB, this case recurses via setNominalRole_maybe, not + -- setNominalRole_maybe_helper! + = SelCo (SelFun fs) <$> setNominalRole_maybe (coercionRole co) co + setNominalRole_maybe_helper (SelCo SelForAll co) + = pprPanic "setNominalRole_maybe: the coercion should already be nominal" (ppr co) setNominalRole_maybe_helper (InstCo co arg) = InstCo <$> setNominalRole_maybe_helper co <*> pure arg setNominalRole_maybe_helper (UnivCo prov _ co1 co2) ===================================== testsuite/tests/simplCore/should_compile/T23362.hs ===================================== @@ -0,0 +1,21 @@ +module T23362 where + +import Unsafe.Coerce +import Data.Kind + +type Phantom :: Type -> Type +data Phantom a = MkPhantom + +newtype Id a = MkId a +newtype First a = MkFirst (Id a) +data Second a = MkSecond (First a) +data Third a = MkThird !(Second a) + +a :: Second (Phantom Int) +a = MkSecond (MkFirst (MkId MkPhantom)) + +uc :: Second (Phantom Int) -> Second (Phantom Bool) +uc = unsafeCoerce + +b :: Third (Phantom Bool) +b = MkThird (uc a) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23362', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64c12e10917adaf851eef0ec98ff9ee18e7052ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64c12e10917adaf851eef0ec98ff9ee18e7052ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 12:39:29 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 11 May 2023 08:39:29 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] 2 commits: ROMES: WIP improvements Message-ID: <645ce20183748_38ffda15a5dd24c24565ab@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: ad9e3570 by Rodrigo Mesquita at 2023-05-10T01:03:15+01:00 ROMES: WIP improvements In particular, we note that in dsUnliftedBind we pass to matchEquations variables which were let bound, which get further down the line used in matchOneConLike (and in bindNonRec too) as case-pattern bound variables! In this situation, where we use originally let-bound variables as case bound variables, we must ensure the case bound variables are set to be `LambdaBound` with the correct multiplicity (which should be some mix of scaling with the constructor annotated multiplicities) TODO: The multiplicity corresponding to the constructor multiplicity scaled by ... This broke through one more wall in the compilation of stage1 caused by incorrect provenences (well, really, by variables being moved around binding types while the provenence isn't updated) - - - - - 9e29c164 by Rodrigo Mesquita at 2023-05-11T13:39:00+01:00 Document 'selectMatchVars' - - - - - 19 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Match.hs-boot - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GADTs, StandaloneDeriving #-} -- | GHC.Core holds all the main data types for use by for the Glasgow Haskell Compiler midsection module GHC.Core ( @@ -270,9 +271,12 @@ type Arg b = Expr b -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint -data Alt b - = Alt AltCon [b] (Expr b) - deriving (Data) +-- data Alt b +-- = Alt AltCon [b] (Expr b) +-- deriving (Data) +data Alt b where + Alt :: HasCallStack => AltCon -> [b] -> (Expr b) -> Alt b +deriving instance Data b => Data (Alt b) -- | A case alternative constructor (i.e. pattern match) @@ -2204,7 +2208,7 @@ data AnnExpr' bndr annot | AnnCoercion Coercion -- | A clone of the 'Alt' type but allowing annotation at every tree node -data AnnAlt bndr annot = AnnAlt AltCon [bndr] (AnnExpr bndr annot) +data AnnAlt bndr annot = HasCallStack => AnnAlt AltCon [bndr] (AnnExpr bndr annot) -- | A clone of the 'Bind' type but allowing annotation at every tree node data AnnBind bndr annot ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1693,7 +1693,7 @@ lintIdBndr top_lvl bind_site id thing_inside -- Check that the binding site matches the binding provenance of the id -- (we do this regardless of -dlinear-core-lint as it should always be true?) ; checkL (matchesBindingSite (idBinding id) bind_site) - (text "Core Id binding doesn't match binding site" <+> ppr (idBinding id) <+> ppr bind_site) + (text "Core Id binding doesn't match binding site" <+> ppr (idBinding id) <+> text (show bind_site)) -- Check that if the binder is nested, it is not marked as exported ; checkL (not (isExportedId id) || is_top_lvl) ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -1,5 +1,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# LANGUAGE GADTs #-} + -- | Handy functions for creating much Core syntax module GHC.Core.Make ( -- * Constructing normal syntax @@ -732,7 +734,7 @@ mkSmallTupleCase vars body scrut_var scrut data FloatBind = FloatLet CoreBind - | FloatCase CoreExpr Id AltCon [Var] + | HasCallStack => FloatCase CoreExpr Id AltCon [Var] -- case e of y { C ys -> ... } -- See Note [Floating single-alternative cases] in GHC.Core.Opt.SetLevels @@ -741,7 +743,7 @@ instance Outputable FloatBind where ppr (FloatCase e b c bs) = hang (text "CASE" <+> ppr e <+> text "of" <+> ppr b) 2 (ppr c <+> ppr bs) -wrapFloat :: FloatBind -> CoreExpr -> CoreExpr +wrapFloat :: HasCallStack => FloatBind -> CoreExpr -> CoreExpr wrapFloat (FloatLet defns) body = Let defns body wrapFloat (FloatCase e b con bs) body = mkSingleAltCase e b con bs body ===================================== compiler/GHC/Core/Opt/FloatIn.hs ===================================== @@ -41,11 +41,10 @@ import GHC.Utils.Outputable import Data.List ( mapAccumL ) -{- +{- | Top-level interface function, @floatInwards at . Note that we do not actually float any bindings downwards from the top-level. -} - floatInwards :: Platform -> CoreProgram -> CoreProgram floatInwards platform binds = map (fi_top_bind platform) binds where @@ -144,7 +143,7 @@ instance Outputable FloatInBind where ppr (FB bvs fvs _) = text "FB" <> braces (sep [ text "bndrs =" <+> ppr bvs , text "fvs =" <+> ppr fvs ]) -fiExpr :: Platform +fiExpr :: HasCallStack => Platform -> RevFloatInBinds -- Binds we're trying to drop -- as far "inwards" as possible -> CoreExprWithFVs -- Input expr @@ -806,7 +805,7 @@ floatedBindsFVs binds = mapUnionDVarSet fbFVs binds fbFVs :: FloatInBind -> DVarSet fbFVs (FB _ fvs _) = fvs -wrapFloats :: RevFloatInBinds -> CoreExpr -> CoreExpr +wrapFloats :: HasCallStack => RevFloatInBinds -> CoreExpr -> CoreExpr -- Remember RevFloatInBinds is in *reverse* dependency order wrapFloats [] e = e wrapFloats (FB _ _ fl : bs) e = wrapFloats bs (wrapFloat fl e) ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -229,8 +229,9 @@ tidyExpr env (Lam b e) ------------ Case alternatives -------------- tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt -tidyAlt env (Alt con vs rhs) - = tidyBndrs env vs =: \ (env', vs) -> +tidyAlt env a@(Alt con vs rhs) + = pprTrace "tidyAlt" (ppr a $$ ppr (map (\x -> (idBinding x, x)) vs) $$ callStackDoc) $ + tidyBndrs env vs =: \ (env', vs) -> (Alt con vs (tidyExpr env' rhs)) ------------ Tickish -------------- @@ -277,16 +278,16 @@ tidyVarOcc :: TidyEnv -> Var -> Var tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v -- tidyBndr is used for lambda and case binders -tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var) +tidyBndr :: HasCallStack => TidyEnv -> Var -> (TidyEnv, Var) tidyBndr env var | isTyCoVar var = tidyVarBndr env var | otherwise = tidyIdBndr env var -tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var]) +tidyBndrs :: HasCallStack => TidyEnv -> [Var] -> (TidyEnv, [Var]) tidyBndrs env vars = mapAccumL tidyBndr env vars -- Non-top-level variables, not covars -tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id) +tidyIdBndr :: HasCallStack => TidyEnv -> Id -> (TidyEnv, Id) tidyIdBndr env@(tidy_env, var_env) id = -- Do this pattern match strictly, otherwise we end up holding on to -- stuff in the OccName. ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -507,6 +507,10 @@ bindNonRec :: HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr -- that give Core Lint a heart attack, although actually -- the simplifier deals with them perfectly well. See -- also 'GHC.Core.Make.mkCoreLet' +-- +-- We must be careful about the idBinding of the binder. If we make the let +-- binder into a case binder, we must update the idBinding to reflect that, +-- since it must change from LetBound to CaseBound bindNonRec bndr rhs body | isTyVar bndr = let_bind | isCoVar bndr = if isCoArg rhs then let_bind @@ -515,7 +519,7 @@ bindNonRec bndr rhs body | needsCaseBinding (idType bndr) rhs = pprTrace "bindNonRec:needsCaseBinding:" (ppr bndr <+> ppr (idBinding bndr)) case_bind | otherwise = let_bind where - case_bind = mkDefaultCase rhs (setIdBinding bndr (LambdaBound ManyTy)) body + case_bind = mkDefaultCase rhs (setIdBinding bndr (maybe (LambdaBound ManyTy) LambdaBound (varMultMaybe bndr))) body -- ROMES:TODO: Explain let_bind = Let (NonRec bndr rhs) body -- | Tests whether we have to use a @case@ rather than @let@ binding for this @@ -543,11 +547,10 @@ mkAltExpr DEFAULT _ _ = panic "mkAltExpr DEFAULT" mkDefaultCase :: CoreExpr -> Id -> CoreExpr -> CoreExpr -- Make (case x of y { DEFAULT -> e } mkDefaultCase scrut case_bndr body - = pprTrace "mkDefaultCase bndr is LambdaBound?" (ppr $ isJust (varMultMaybe case_bndr)) $ - assertPpr (isJust (varMultMaybe case_bndr)) (text "mkDefaultCase:Case binder is marked LetBound!") $ + = assertPpr (isJust (varMultMaybe case_bndr)) (text "mkDefaultCase:Case binder is marked LetBound!") $ Case scrut case_bndr (exprType body) [Alt DEFAULT [] body] -mkSingleAltCase :: CoreExpr -> Id -> AltCon -> [Var] -> CoreExpr -> CoreExpr +mkSingleAltCase :: HasCallStack => CoreExpr -> Id -> AltCon -> [Var] -> CoreExpr -> CoreExpr -- Use this function if possible, when building a case, -- because it ensures that the type on the Case itself -- doesn't mention variables bound by the case ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -197,19 +197,26 @@ dsUnliftedBind (FunBind { fun_id = L l fun { let rhs' = core_wrap (mkOptTickBox tick rhs) ; return (bindNonRec fun rhs' body) } } -dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss +dsUnliftedBind p@(PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = (ty, _) }) body = -- let C x# y# = rhs in body -- ==> case rhs of C x# y# -> body do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], + eqn = pprTrace "dsUnliftedBind" (ppr p $$ ppr upat) $ EqnInfo { eqn_pats = [upat], eqn_orig = FromSource, eqn_rhs = cantFailMatchResult body } ; var <- selectMatchVar ManyTy upat -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. + -- + -- romes: Why in a let binder? Sometimes it will end up in a + -- case binder (see bindNonRec and matchOneConLike). + + -- ROMES:TODO: I will need to make this correct here... this transformation seems suspicious + -- Matching will turn a group of equations and matching ids into a group of case expressions? + -- It seems really weird for the eqn to have let bound variables, if they're patterns...? ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ; return (bindNonRec var rhs result) } ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -85,7 +85,7 @@ import qualified Data.Map as Map ************************************************************************ The function @match@ is basically the same as in the Wadler chapter -from "The Implementation of Functional Programming Languages", +from "The Implementation of Functional Programming Languages" (Chapter 5), except it is monadised, to carry around the name supply, info about annotations, etc. @@ -180,7 +180,8 @@ See also Note [Localise pattern binders] in GHC.HsToCore.Utils type MatchId = Id -- See Note [Match Ids] -match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with +-- | Described by the comment block above +match :: HasCallStack => [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with -- ^ See Note [Match Ids] -- -- ^ Note that the Match Ids carry not only a name, but @@ -824,7 +825,22 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches $ replicate (length (grhssGRHSs m)) initNablas -matchEquations :: HsMatchContext GhcRn +-- | Matching will turn a group of pattern-matching equations and MatchId's +-- into a group of case expressions +-- +-- For example: +-- +-- mappairs f [] ys = [] +-- mappairs f (x:xs) [] = [] +-- mappairs f (x:xs) (y:ys) = f x y : mappairs f xs ys +-- ==> +-- mappairs = \f -> \xs' -> \ys' -> +-- case xs' of +-- [] -> [] +-- (x:xs) -> case ys' of +-- [] -> [] +-- (y:ys) -> f x y : mappairs f xs ys +matchEquations :: HasCallStack => HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr matchEquations ctxt vars eqns_info rhs_ty ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -8,7 +8,9 @@ import GHC.Core ( CoreExpr ) import GHC.Hs ( LPat, HsMatchContext, MatchGroup, LHsExpr ) import GHC.Hs.Extension ( GhcTc, GhcRn ) -match :: [Id] +import GHC.Stack (HasCallStack) + +match :: HasCallStack => [Id] -> Type -> [EquationInfo] -> DsM (MatchResult CoreExpr) ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -29,6 +29,7 @@ import GHC.Core ( CoreExpr ) import GHC.Core.Make ( mkCoreLets ) import GHC.Utils.Misc import GHC.Types.Id +import GHC.Types.Var (pprIdWithBinding) import GHC.Types.Name.Env import GHC.Types.FieldLabel ( flSelector ) import GHC.Types.SrcLoc @@ -92,7 +93,7 @@ have-we-used-all-the-constructors? question; the local function @match_cons_used@ does all the real work. -} -matchConFamily :: NonEmpty Id +matchConFamily :: HasCallStack => NonEmpty Id -> Type -> NonEmpty (NonEmpty EquationInfo) -> DsM (MatchResult CoreExpr) @@ -126,7 +127,7 @@ matchPatSyn (var :| vars) ty eqns type ConArgPats = HsConPatDetails GhcTc -matchOneConLike :: [Id] +matchOneConLike :: HasCallStack => [Id] -> Type -> Mult -> NonEmpty EquationInfo @@ -190,8 +191,16 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; match_results <- mapM (match_group arg_vars) groups + ; pprTraceM "matchOneConLike" (text "Dicts:" <+> ppr (map pprIdWithBinding dicts1) $$ text "Args:" <+> ppr (map pprIdWithBinding arg_vars)) + -- ROMES:TODO: Understand better if we could determine this elsewhere, but: + -- + -- The provenence of the variables put in the alt_bndrs is not + -- necessarily correct, as it may come from a variable which was + -- originally let bound and will now be lambda bound. + -- See comments in dsUnliftedBind too. + ; let arg_vars' = map (`setIdBinding` (LambdaBound ManyTy)) arg_vars -- ROMES:TODO: Not ManyTy!! It depends on the constructor! ; return $ MkCaseAlt{ alt_pat = con1, - alt_bndrs = tvs1 ++ dicts1 ++ arg_vars, + alt_bndrs = tvs1 ++ dicts1 ++ arg_vars', -- these arg_vars contain variables that were originally let bound alt_wrapper = wrapper1, alt_result = foldr1 combineMatchResults match_results } } where @@ -243,12 +252,12 @@ same_fields flds1 flds2 ----------------- -selectConMatchVars :: [Scaled Type] -> ConArgPats -> DsM [Id] +selectConMatchVars :: HasCallStack => [Scaled Type] -> ConArgPats -> DsM [Id] selectConMatchVars arg_tys con = case con of RecCon {} -> newSysLocalsDs arg_tys - PrefixCon _ ps -> selectMatchVars (zipMults arg_tys ps) - InfixCon p1 p2 -> selectMatchVars (zipMults arg_tys [p1, p2]) + PrefixCon _ ps -> pprTrace "selectConMatchVars:InfixCon" (ppr ps) $ selectMatchVars (zipMults arg_tys ps) + InfixCon p1 p2 -> pprTrace "selectConMatchVars:InfixCon" (ppr p1 <+> ppr p2) $ selectMatchVars (zipMults arg_tys [p1, p2]) where zipMults = zipWithEqual "selectConMatchVar" (\a b -> (scaledMult a, unLoc b)) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} {- (c) The University of Glasgow 2006 @@ -60,6 +61,7 @@ import GHC.Core.Utils import GHC.Core.Make import GHC.Types.Id.Make import GHC.Types.Id +import GHC.Types.Var (pprIdWithBinding) import GHC.Types.Literal import GHC.Core.TyCon import GHC.Core.DataCon @@ -108,7 +110,7 @@ selectSimpleMatchVarL :: Mult -> LPat GhcTc -> DsM Id -- Postcondition: the returned Id has an Internal Name selectSimpleMatchVarL w pat = selectMatchVar w (unLoc pat) --- (selectMatchVars ps tys) chooses variables of type tys +-- | (selectMatchVars ps tys) chooses variables of type tys -- to use for matching ps against. If the pattern is a variable, -- we try to use that, to save inventing lots of fresh variables. -- @@ -123,17 +125,25 @@ selectSimpleMatchVarL w pat = selectMatchVar w (unLoc pat) -- f (T2 i) (y::a) = 0 -- Then we must not choose (x::Int) as the matching variable! -- And nowadays we won't, because the (x::Int) will be wrapped in a CoPat - -selectMatchVars :: [(Mult, Pat GhcTc)] -> DsM [Id] +selectMatchVars :: HasCallStack => [(Mult, Pat GhcTc)] -> DsM [Id] -- Postcondition: the returned Ids have Internal Names selectMatchVars ps = mapM (uncurry selectMatchVar) ps -selectMatchVar :: Mult -> Pat GhcTc -> DsM Id +-- | 'selectMatchVar' chooses a variable to use for matching against the pattern. +-- +-- In particular, for as-patterns and variable patterns we can re-use the +-- existing variable, while for other patterns we must invent a fresh variable. +-- +-- For the following example patterns, +-- (1) let !(x@(C a b)) = ... -- `x` is chosen +-- (2) let ~y = ... -- `y` is chosen +-- (3) let (a,b) = ... -- fresh `z` is chosen +selectMatchVar :: HasCallStack => Mult -> Pat GhcTc -> DsM Id -- Postcondition: the returned Id has an Internal Name selectMatchVar w (BangPat _ pat) = selectMatchVar w (unLoc pat) selectMatchVar w (LazyPat _ pat) = selectMatchVar w (unLoc pat) selectMatchVar w (ParPat _ _ pat _) = selectMatchVar w (unLoc pat) -selectMatchVar _w (VarPat _ var) = return (localiseId (unLoc var)) +selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWithBinding (unLoc var)) $ return (localiseId (unLoc var)) -- Note [Localise pattern binders] -- -- Remark: when the pattern is a variable (or @@ -284,7 +294,7 @@ mkCoPrimCaseMatchResult var ty match_alts do body <- runMatchResult fail mr return (Alt (LitAlt lit) [] body) -data CaseAlt a = MkCaseAlt{ alt_pat :: a, +data CaseAlt a = HasCallStack => MkCaseAlt{ alt_pat :: a, alt_bndrs :: [Var], alt_wrapper :: HsWrapper, alt_result :: MatchResult CoreExpr } @@ -367,7 +377,7 @@ mkDataConCase var ty alts@(alt1 :| _) , alt_result = match_result } = flip adjustMatchResultDs match_result $ \body -> do case dataConBoxer con of - Nothing -> return (Alt (DataAlt con) args body) + Nothing -> pprTrace "mk_alt" (ppr (map (\x -> (idBinding x, x)) args)) $ return (Alt (DataAlt con) args body) Just (DCB boxer) -> do us <- newUniqueSupply let (rep_ids, binds) = initUs_ us (boxer ty_args args) ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -253,8 +253,9 @@ tcLocalBinds (EmptyLocalBinds x) thing_inside = do { thing <- thing_inside ; return (EmptyLocalBinds x, thing) } -tcLocalBinds (HsValBinds x (XValBindsLR (NValBinds binds sigs))) thing_inside - = do { (binds', thing) <- tcValBinds NotTopLevel binds sigs thing_inside +tcLocalBinds h@(HsValBinds x (XValBindsLR (NValBinds binds sigs))) thing_inside + = pprTrace "tcLocalBinds:HsValBinds" (ppr h) $ + do { (binds', thing) <- tcValBinds NotTopLevel binds sigs thing_inside ; return (HsValBinds x (XValBindsLR (NValBinds binds' sigs)), thing) } tcLocalBinds (HsValBinds _ (ValBinds {})) _ = panic "tcLocalBinds" @@ -434,6 +435,7 @@ recursivePatSynErr recursivePatSynErr loc binds = failAt loc $ TcRnRecursivePatternSynonym binds +-- | ROMES:TODO: Document tc_single :: forall thing. HasCallStack => TopLevelFlag -> TcSigFun -> TcPragEnv -> LHsBind GhcRn -> IsGroupClosed -> TcM thing @@ -704,6 +706,7 @@ it's all cool; each signature has distinct type variables from the renamer.) * * ********************************************************************* -} +-- | ROMES:TODO: Document... tcPolyInfer :: HasCallStack => RecFlag -- Whether it's recursive after breaking -- dependencies based on type signatures @@ -711,7 +714,8 @@ tcPolyInfer -> [LHsBind GhcRn] -> TcM (LHsBinds GhcTc, [TcId]) tcPolyInfer rec_tc prag_fn tc_sig_fn bind_list - = do { (tclvl, wanted, (binds', mono_infos)) + = pprTrace "tcPolyInfer" (ppr bind_list) $ + do { (tclvl, wanted, (binds', mono_infos)) <- pushLevelAndCaptureConstraints $ tcMonoBinds rec_tc tc_sig_fn LetLclBndr bind_list @@ -1695,6 +1699,7 @@ We typecheck pattern bindings as follows. First tcLhs does this: Result: the type of the binder is always at pc_lvl. This is crucial. + ROMES:TODO: Update note, they're not all let bound, for our definition of let bound 4. Throughout, when we are making up an Id for the pattern-bound variables (newLetBndr), we have two cases: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -94,7 +94,7 @@ is used in error messages. It checks that all the equations have the same number of arguments before using @tcMatches@ to do the work. -} -tcMatchesFun :: LocatedN Name -- MatchContext Id +tcMatchesFun :: HasCallStack => LocatedN Name -- MatchContext Id -> MatchGroup GhcRn (LHsExpr GhcRn) -> ExpRhoType -- Expected type of function -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc)) @@ -209,7 +209,7 @@ type AnnoBody body ) -- | Type-check a MatchGroup. -tcMatches :: (AnnoBody body ) => TcMatchCtxt body +tcMatches :: HasCallStack => (AnnoBody body ) => TcMatchCtxt body -> [Scaled ExpSigmaTypeFRR] -- ^ Expected pattern types. -> ExpRhoType -- ^ Expected result-type of the Match. -> MatchGroup GhcRn (LocatedA (body GhcRn)) @@ -239,7 +239,7 @@ tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches }) } ------------- -tcMatch :: (AnnoBody body) => TcMatchCtxt body +tcMatch :: HasCallStack => (AnnoBody body) => TcMatchCtxt body -> [Scaled ExpSigmaType] -- Expected pattern types -> ExpRhoType -- Expected result-type of the Match. -> LMatch GhcRn (LocatedA (body GhcRn)) @@ -265,7 +265,7 @@ tcMatch ctxt pat_tys rhs_ty match _ -> addErrCtxt (pprMatchInCtxt match) thing_inside ------------- -tcGRHSs :: AnnoBody body +tcGRHSs :: HasCallStack => AnnoBody body => TcMatchCtxt body -> GRHSs GhcRn (LocatedA (body GhcRn)) -> ExpRhoType -> TcM (GRHSs GhcTc (LocatedA (body GhcTc))) ===================================== compiler/GHC/Tc/Gen/Match.hs-boot ===================================== @@ -7,11 +7,13 @@ import GHC.Hs.Extension ( GhcRn, GhcTc ) import GHC.Parser.Annotation ( LocatedN ) import GHC.Types.Name (Name) +import GHC.Stack + tcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn) -> ExpRhoType -> TcM (GRHSs GhcTc (LHsExpr GhcTc)) -tcMatchesFun :: LocatedN Name +tcMatchesFun :: HasCallStack => LocatedN Name -> MatchGroup GhcRn (LHsExpr GhcRn) -> ExpSigmaType -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc)) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -87,7 +87,11 @@ import Data.List( partition ) ************************************************************************ -} -tcLetPat :: (Name -> Maybe TcId) +-- The issue being we're incorrectly calling tcLetPat for case bound variables... +-- ROMES:TODO:! Document that we don't consider case binder variables to be Let +-- bound, we consider them lambda bound, or Case bound. (this is also in the +-- definition of PatCtxt) +tcLetPat :: HasCallStack => (Name -> Maybe TcId) -> LetBndrSpec -> LPat GhcRn -> Scaled ExpSigmaTypeFRR -> TcM a @@ -104,7 +108,7 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside ; tc_lpat pat_ty penv pat thing_inside } ----------------- -tcPats :: HsMatchContext GhcTc +tcPats :: HasCallStack => HsMatchContext GhcTc -> [LPat GhcRn] -- ^ atterns -> [Scaled ExpSigmaTypeFRR] -- ^ types of the patterns -> TcM a -- ^ checker for the body @@ -212,7 +216,7 @@ inPatBind (PE { pe_ctxt = LamPat {} }) = False * * ********************************************************************* -} -tcPatBndr :: PatEnv -> Name -> Scaled ExpSigmaTypeFRR -> TcM (HsWrapper, TcId) +tcPatBndr :: HasCallStack => PatEnv -> Name -> Scaled ExpSigmaTypeFRR -> TcM (HsWrapper, TcId) -- (coi, xp) = tcPatBndr penv x pat_ty -- Then coi : pat_ty ~ typeof(xp) -- @@ -239,7 +243,8 @@ tcPatBndr penv@(PE { pe_ctxt = LetPat { pc_lvl = bind_lvl do { bndr_ty <- inferResultToType infer_res ; return (mkNomReflCo bndr_ty, bndr_ty) } ; let bndr_mult = scaledMult exp_pat_ty - ; bndr_id <- newLetBndr no_gen bndr_name (unitUE bndr_name bndr_mult) bndr_ty -- ROMES:TODO: Likely incorrect + -- ; massert (isOneTy bndr_mult) -- ROMES:It's not necessary, it's just that we won't add it to the usage environment in case it is ManyTy. Do this in a helper UsageEnv "builder" + ; bndr_id <- newLetBndr no_gen bndr_name zeroUE bndr_ty -- ROMES:TODO: UE is incorrect here, we were previously doing unitUE bndr_name bndr_mult. What now? -- Keep zeroUE until it compiles ; traceTc "tcPatBndr(nosig)" (vcat [ ppr bind_lvl , ppr exp_pat_ty, ppr bndr_ty, ppr co , ppr bndr_id ]) @@ -249,7 +254,7 @@ tcPatBndr _ bndr_name pat_ty = do { let pat_mult = scaledMult pat_ty ; pat_ty <- expTypeToType (scaledThing pat_ty) ; traceTc "tcPatBndr(not let)" (ppr bndr_name $$ ppr pat_ty) - ; return (idHsWrapper, mkLocalIdOrCoVar bndr_name (LambdaBound pat_mult) pat_ty) } -- ROMES:TODO: Pat Mult Lambda bound? + ; return (idHsWrapper, mkLocalIdOrCoVar bndr_name (LambdaBound pat_mult) pat_ty) } -- ROMES:TODO: Pat Mult Lambda bound, rather should really be binder of binding Pattern? PatCtxt agrees this is LambdaBound -- We should not have "OrCoVar" here, this is a bug (#17545) -- Whether or not there is a sig is irrelevant, -- as this is local @@ -344,7 +349,7 @@ tcMultiple tc_pat penv args thing_inside ; loop penv args } -------------------- -tc_lpat :: Scaled ExpSigmaTypeFRR +tc_lpat :: HasCallStack => Scaled ExpSigmaTypeFRR -> Checker (LPat GhcRn) (LPat GhcTc) tc_lpat pat_ty penv (L span pat) thing_inside = setSrcSpanA span $ @@ -352,7 +357,7 @@ tc_lpat pat_ty penv (L span pat) thing_inside thing_inside ; return (L span pat', res) } -tc_lpats :: [Scaled ExpSigmaTypeFRR] +tc_lpats :: HasCallStack => [Scaled ExpSigmaTypeFRR] -> Checker [LPat GhcRn] [LPat GhcTc] tc_lpats tys penv pats = assertPpr (equalLength pats tys) (ppr pats $$ ppr tys) $ @@ -365,7 +370,7 @@ tc_lpats tys penv pats checkManyPattern :: Scaled a -> TcM HsWrapper checkManyPattern pat_ty = tcSubMult NonLinearPatternOrigin ManyTy (scaledMult pat_ty) -tc_pat :: Scaled ExpSigmaTypeFRR +tc_pat :: HasCallStack => Scaled ExpSigmaTypeFRR -- ^ Fully refined result type -> Checker (Pat GhcRn) (Pat GhcTc) -- ^ Translated pattern ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -637,7 +637,7 @@ unsatisfiableEvExpr (unsat_ev, given_msg) wtd_ty BI_Box { bi_data_con = mkDictBox } -> mkDictBox _ -> pprPanic "unsatisfiableEvExpr: no DictBox!" (ppr wtd_ty) dictBox = dataConTyCon mkDictBox - ; ev_bndr <- mkSysLocalM (fsLit "ct") ManyTy fun_ty + ; ev_bndr <- mkSysLocalM (fsLit "ct") (LambdaBound ManyTy) fun_ty -- Dict ((##) -=> wtd_ty) ; let scrut_ty = mkTyConApp dictBox [fun_ty] -- unsatisfiable @{LiftedRep} @given_msg @(Dict ((##) -=> wtd_ty)) unsat_ev ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -143,7 +143,7 @@ import GHC.Types.Var( Id, CoVar, JoinId, OutId, OutVar, idInfo, idDetails, setIdDetails, globaliseId, isId, isLocalId, isGlobalId, isExportedId, - setIdBinding, -- used to be setIdMult + setIdBinding, updateIdTypeAndMults, updateIdTypeButNotMults, updateIdTypeAndMultsM, IdBinding(..) ) ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -59,7 +59,7 @@ module GHC.Types.Var ( setIdExported, setIdNotExported, setIdBinding, updateIdTypeButNotMults, updateIdTypeAndMults, updateIdTypeAndMultsM, - IdBinding(..), idBinding, + IdBinding(..), idBinding, pprIdWithBinding, -- ** Predicates isId, isTyVar, isTcTyVar, @@ -283,6 +283,9 @@ data IdBinding where -- Removed globalbinding in exchange for LetBound with zero Ue (closed top-level let bound) -- Might no longer make sense to merge with IdScope at all +pprIdWithBinding :: Id -> SDoc +pprIdWithBinding x = ppr x <> text "[" <> ppr (idBinding x) <> text "]" + {- Note the binding sites considered in Core (see lintCoreExpr, lintIdBinder) data BindingSite ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -1208,7 +1208,7 @@ data BindingSite | CaseBind -- ^ The x in case scrut of x { (y,z) -> ... } | CasePatBind -- ^ The y,z in case scrut of x { (y,z) -> ... } | LetBind -- ^ The x in (let x = rhs in e) - deriving Eq + deriving (Eq, Show) -- | When we print a binder, we often want to print its type too. -- The @OutputableBndr@ class encapsulates this idea. class Outputable a => OutputableBndr a where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/070f7fc12fa78440bd9828633f09d234add52c7b...9e29c1644350f13a1804a53cc57269064ffe5c56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/070f7fc12fa78440bd9828633f09d234add52c7b...9e29c1644350f13a1804a53cc57269064ffe5c56 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 13:00:33 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 11 May 2023 09:00:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/restore-lint Message-ID: <645ce6f133fcb_38ffda15a3de7fc24616a8@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/restore-lint at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/restore-lint You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 13:03:10 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 11 May 2023 09:03:10 -0400 Subject: [Git][ghc/ghc][wip/T23362] Fix coercion optimisation for SelCo (#23362) Message-ID: <645ce78ef2954_38ffda15a5dd36424618ca@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23362 at Glasgow Haskell Compiler / GHC Commits: 50e82f6f by Krzysztof Gogolewski at 2023-05-11T15:03:04+02:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 3 changed files: - compiler/GHC/Core/Coercion.hs - + testsuite/tests/simplCore/should_compile/T23362.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1355,7 +1355,7 @@ mkProofIrrelCo r kco g1 g2 = mkUnivCo (ProofIrrelProv kco) r -- | Converts a coercion to be nominal, if possible. -- See Note [Role twiddling functions] setNominalRole_maybe :: Role -- of input coercion - -> Coercion -> Maybe Coercion + -> Coercion -> Maybe CoercionN setNominalRole_maybe r co | r == Nominal = Just co | otherwise = setNominalRole_maybe_helper co @@ -1380,10 +1380,19 @@ setNominalRole_maybe r co = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2 setNominalRole_maybe_helper (ForAllCo tv kind_co co) = ForAllCo tv kind_co <$> setNominalRole_maybe_helper co - setNominalRole_maybe_helper (SelCo n co) + setNominalRole_maybe_helper (SelCo cs co) = -- NB, this case recurses via setNominalRole_maybe, not -- setNominalRole_maybe_helper! - = SelCo n <$> setNominalRole_maybe (coercionRole co) co + case cs of + SelTyCon n _r -> + -- Remember to update the role in SelTyCon to nominal; + -- not doing this caused #23362. + -- See the typing rule in Note [SelCo] in GHC.Core.TyCo.Rep. + SelCo (SelTyCon n Nominal) <$> setNominalRole_maybe (coercionRole co) co + SelFun fs -> + SelCo (SelFun fs) <$> setNominalRole_maybe (coercionRole co) co + SelForAll -> + pprPanic "setNominalRole_maybe: the coercion should already be nominal" (ppr co) setNominalRole_maybe_helper (InstCo co arg) = InstCo <$> setNominalRole_maybe_helper co <*> pure arg setNominalRole_maybe_helper (UnivCo prov _ co1 co2) ===================================== testsuite/tests/simplCore/should_compile/T23362.hs ===================================== @@ -0,0 +1,21 @@ +module T23362 where + +import Unsafe.Coerce +import Data.Kind + +type Phantom :: Type -> Type +data Phantom a = MkPhantom + +newtype Id a = MkId a +newtype First a = MkFirst (Id a) +data Second a = MkSecond (First a) +data Third a = MkThird !(Second a) + +a :: Second (Phantom Int) +a = MkSecond (MkFirst (MkId MkPhantom)) + +uc :: Second (Phantom Int) -> Second (Phantom Bool) +uc = unsafeCoerce + +b :: Third (Phantom Bool) +b = MkThird (uc a) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23362', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50e82f6fe83f2eca5e095b78393c7e50a11bdbf5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50e82f6fe83f2eca5e095b78393c7e50a11bdbf5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 13:31:03 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 11 May 2023 09:31:03 -0400 Subject: [Git][ghc/ghc][wip/T23070-unify] Use the eager unifier in the constraint solver Message-ID: <645cee17368f9_38ffda15e32071c247365f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-unify at Glasgow Haskell Compiler / GHC Commits: 1553a77a by Simon Peyton Jones at 2023-05-11T14:32:36+01:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 28 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1553a77aeec7c666797cb9659255016de38b26a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1553a77aeec7c666797cb9659255016de38b26a6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 13:55:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 11 May 2023 09:55:30 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] Make match variables always lambda bound Message-ID: <645cf3d2b0995_38ffda15ec2f6b424793ce@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: d97c081f by Rodrigo Mesquita at 2023-05-11T14:53:59+01:00 Make match variables always lambda bound The burning question being: Will variables selected for match (`selectMatchVar`) always be bound in case patterns? - - - - - 9 changed files: - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -182,7 +182,7 @@ mkCoreAppTyped d (fun, fun_ty) arg -- -- See Note [WildCard binders] in "GHC.Core.Opt.Simplify.Env" mkWildValBinder :: Mult -> Type -> Id -mkWildValBinder w ty = mkLocalIdOrCoVar wildCardName (LambdaBound w) ty -- ROMES: for now we consider wildcards to be lambdabound +mkWildValBinder w ty = mkLocalIdOrCoVar wildCardName (LambdaBound w) ty -- ROMES: just tepmorarily now we consider wildcards to be lambdabound -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors -- (e.g. see test T15695). Ticket #17291 covers fixing this problem. ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -809,14 +809,14 @@ prepareRhs env top_lvl occ rhs0 anfise other = return (emptyLetFloats, other) -makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) +makeTrivialArg :: HasCallStack => HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) = do { (floats, e') <- makeTrivial env NotTopLevel dmd (fsLit "arg") e ; return (floats, arg { as_arg = e' }) } makeTrivialArg _ arg = return (emptyLetFloats, arg) -- CastBy, TyArg -makeTrivial :: HasDebugCallStack +makeTrivial :: HasCallStack => HasDebugCallStack => SimplEnv -> TopLevelFlag -> Demand -> FastString -- ^ A "friendly name" to build the new binder from -> OutExpr @@ -3676,7 +3676,12 @@ mkDupableContWithDmds env _ ; let join_body = wrapFloats floats1 join_inner res_ty = contResultType cont - ; mkDupableStrictBind env bndr' join_body res_ty } + -- romes: The `x` becomes an arg of the join point, so it should move + -- from let bound to lambda bound (with which multiplicity? ROMES:TODO). + -- (Note [Duplicating StrictBind] explains the transformation) + bndr'' = bndr' `setIdBinding` LambdaBound ManyTy + + ; mkDupableStrictBind env bndr'' join_body res_ty } mkDupableContWithDmds env _ (StrictArg { sc_fun = fun, sc_cont = cont @@ -3792,7 +3797,9 @@ mkDupableContWithDmds env _ -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_cont = mkBoringStop (contResultType cont) } ) } -mkDupableStrictBind :: SimplEnv -> OutId -> OutExpr -> OutType +-- ROMES:TODO: What does this function do? +-- Refer to Note [Dupable StrictBind]? StrictBind con? +mkDupableStrictBind :: HasCallStack => SimplEnv -> OutId -> OutExpr -> OutType -> SimplM (SimplFloats, SimplCont) mkDupableStrictBind env arg_bndr join_rhs res_ty | exprIsTrivial join_rhs -- See point (2) of Note [Duplicating join points] ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -217,6 +217,12 @@ dsUnliftedBind p@(PatBind { pat_lhs = pat, pat_rhs = grhss -- ROMES:TODO: I will need to make this correct here... this transformation seems suspicious -- Matching will turn a group of equations and matching ids into a group of case expressions? -- It seems really weird for the eqn to have let bound variables, if they're patterns...? + -- + -- Should match equations ever move a let bound var into a case bound position? + -- If not, then it is never its responsibility to update the IdBindings + -- + -- It seems in matchConFamily is where we treat C x# y# = ... ==> case rhs of C x# y# -> ..? + ; pprTraceM "dsUnliftedBind:eqn" (ppr var <+> ppr eqn) ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ; return (bindNonRec var rhs result) } ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -371,6 +371,7 @@ Among other things in the resulting Pattern: The bindings created by the above patterns are put into the returned wrapper instead. +-- ROMES:TODO: Do something about this, lambda bound can become let bound for irrefutable patterns This means a definition of the form: f x = rhs when called with v get's desugared to the equivalent of: @@ -825,8 +826,9 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches $ replicate (length (grhssGRHSs m)) initNablas +-- No wait, doesn't seem quite right? -- | Matching will turn a group of pattern-matching equations and MatchId's --- into a group of case expressions +-- into a case expression -- -- For example: -- @@ -840,6 +842,8 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- (x:xs) -> case ys' of -- [] -> [] -- (y:ys) -> f x y : mappairs f xs ys +-- +-- See also 'match' matchEquations :: HasCallStack => HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr @@ -970,7 +974,7 @@ groupEquations :: Platform -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInf -- (b) none of the gi are empty -- The ordering of equations is unchanged groupEquations platform eqns - = NEL.groupBy same_gp $ [(patGroup platform (firstPat eqn), eqn) | eqn <- eqns] + = NEL.groupBy same_gp $ [pprTrace "groupEquations" (ppr (firstPat eqn)) $! (patGroup platform (firstPat eqn), eqn) | eqn <- eqns] -- comprehension on NonEmpty where same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -93,17 +93,36 @@ have-we-used-all-the-constructors? question; the local function @match_cons_used@ does all the real work. -} +-- | Turn group of equations for a single constructor into a case expression? +-- +-- Example: +-- +-- data T = C Int Int | D Bool +-- +-- ROMES: Doesn't seem quite right, perhaps each group can only have 1 expr it's deconstructing? +-- let C a b = +-- D c = -- not sure about this second one, I think it's wrong here, just adding it bc I'm unsure. +-- in ... +-- +-- ==> +-- +-- case of +-- C a b -> ... +-- D c -> ... -- not sure about this second constructor being correct +-- +-- Relevant notes seem to be [Match Ids] and [Localise pattern binders] matchConFamily :: HasCallStack => NonEmpty Id -> Type -> NonEmpty (NonEmpty EquationInfo) -> DsM (MatchResult CoreExpr) -- Each group of eqns is for a single constructor matchConFamily (var :| vars) ty groups - = do let mult = idMult var + = pprTrace "matchConFamily" (ppr var <+> hsep (map ppr vars) $$ ppr (map idBinding (var:vars)) $$ ppr groups) $ + do let !mult = idMult var -- Each variable in the argument list correspond to one column in the -- pattern matching equations. Its multiplicity is the context -- multiplicity of the pattern. We extract that multiplicity, so that - -- 'matchOneconLike' knows the context multiplicity, in case it needs + -- 'matchOneConLike' knows the context multiplicity, in case it needs -- to come up with new variables. alts <- mapM (fmap toRealAlt . matchOneConLike vars ty mult) groups return (mkCoAlgCaseMatchResult var ty alts) @@ -198,9 +217,16 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct -- necessarily correct, as it may come from a variable which was -- originally let bound and will now be lambda bound. -- See comments in dsUnliftedBind too. - ; let arg_vars' = map (`setIdBinding` (LambdaBound ManyTy)) arg_vars -- ROMES:TODO: Not ManyTy!! It depends on the constructor! + -- + -- ROMES:TODO:No,! We should only set LambdaBound x if we have a + -- LetBound var, otherwise it already has a multiplicity? Or should we + -- simply recompute it completely here? + -- + -- What if the only case putting us here really is dsUnliftedBind? Try to make the change there. + -- ; let arg_vars' = map (`setIdBinding` (LambdaBound ManyTy)) arg_vars -- ROMES:TODO: Not ManyTy!! It depends on the constructor! Don't always overwrite? + -- ...these arg_vars sometimes contain variables that were originally let bound, when do we make the change passing let bound variables to matchEquations? Should we always discern it here? ; return $ MkCaseAlt{ alt_pat = con1, - alt_bndrs = tvs1 ++ dicts1 ++ arg_vars', -- these arg_vars contain variables that were originally let bound + alt_bndrs = tvs1 ++ dicts1 ++ arg_vars, alt_wrapper = wrapper1, alt_result = foldr1 combineMatchResults match_results } } where ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -395,7 +395,7 @@ newSysLocalDs = mkSysLocalM (fsLit "ds") newFailLocalDs = mkSysLocalM (fsLit "fail") newSysLocalsDs :: [Scaled Type] -> DsM [Id] -newSysLocalsDs = mapM (\(Scaled w t) -> newSysLocalDs (LambdaBound w) t) -- Scaled -> LambdaBound +newSysLocalsDs = mapM (\(Scaled w t) -> newSysLocalDs (LambdaBound w) t) -- Scaled -> LambdaBound? {- We can also reach out and either set/grab location information from ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -143,7 +143,7 @@ selectMatchVar :: HasCallStack => Mult -> Pat GhcTc -> DsM Id selectMatchVar w (BangPat _ pat) = selectMatchVar w (unLoc pat) selectMatchVar w (LazyPat _ pat) = selectMatchVar w (unLoc pat) selectMatchVar w (ParPat _ _ pat _) = selectMatchVar w (unLoc pat) -selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWithBinding (unLoc var)) $ return (localiseId (unLoc var)) +selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWithBinding (unLoc var)) $ return (localiseId ((unLoc var) `setIdBinding` (LambdaBound ManyTy))) -- ROMES:TODO: see comment below about match variables being put in cases -- Note [Localise pattern binders] -- -- Remark: when the pattern is a variable (or @@ -151,8 +151,9 @@ selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWit -- multiplicity stored within the variable -- itself. It's easier to pull it from the -- variable, so we ignore the multiplicity. -selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return (unLoc var)) -selectMatchVar w other_pat = newSysLocalDs (LambdaBound w) (hsPatType other_pat) -- ROMES:TODO: provenance isn't so trivial in match var? +selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return ((unLoc var) `setIdBinding` (LambdaBound ManyTy))) -- ROMES:TODO: Are match variables always put in cases? If yes, then this could be a way to guarantee match variables are lambda bound/case bound +-- selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return (unLoc var)) +selectMatchVar w other_pat = newSysLocalDs (LambdaBound w) (hsPatType other_pat) -- ROMES:TODO: Can match variables end up in lets and cases?, I think yes. {- Note [Localise pattern binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -300,7 +301,7 @@ data CaseAlt a = HasCallStack => MkCaseAlt{ alt_pat :: a, alt_result :: MatchResult CoreExpr } mkCoAlgCaseMatchResult - :: Id -- ^ Scrutinee + :: HasCallStack => Id -- ^ Scrutinee -> Type -- ^ Type of exp -> NonEmpty (CaseAlt DataCon) -- ^ Alternatives (bndrs *include* tyvars, dicts) -> MatchResult CoreExpr @@ -310,7 +311,7 @@ mkCoAlgCaseMatchResult var ty match_alts mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1 | otherwise - = mkDataConCase var ty match_alts + = pprTrace "mkCoAlgCaseMatchResult" (pprIdWithBinding var) $ mkDataConCase var ty match_alts where isNewtype = isNewTyCon (dataConTyCon (alt_pat alt1)) @@ -348,9 +349,9 @@ mkPatSynCase var ty alt fail = do ensure_unstrict cont | needs_void_lam = Lam voidArgId cont | otherwise = cont -mkDataConCase :: Id -> Type -> NonEmpty (CaseAlt DataCon) -> MatchResult CoreExpr +mkDataConCase :: HasCallStack => Id -> Type -> NonEmpty (CaseAlt DataCon) -> MatchResult CoreExpr mkDataConCase var ty alts@(alt1 :| _) - = liftA2 mk_case mk_default mk_alts + = pprTrace "mkDataConCase" (ppr var <+> ppr (idBinding var)) $ liftA2 mk_case mk_default mk_alts -- The liftA2 combines the failability of all the alternatives and the default where con1 = alt_pat alt1 @@ -365,7 +366,7 @@ mkDataConCase var ty alts@(alt1 :| _) -- (not that splitTyConApp does, these days) mk_case :: Maybe CoreAlt -> [CoreAlt] -> CoreExpr - mk_case def alts = mkWildCase (Var var) (idScaledType var) ty $ + mk_case def alts = mkWildCase (Var var) (pprTrace "mk_case:var" (pprIdWithBinding var) $ idScaledType var) ty $ maybeToList def ++ alts mk_alts :: MatchResult [CoreAlt] ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -223,6 +223,7 @@ idUsageEnv x = case Var.idBinding x of -- ROMES: Scaled Types seem to be used mainly in data cons; I think Scaled -- things remain as they are, bc they seem to only occur in places where the Id is definitely a lambda bound (or datacon, which would be the same) variable +-- Truly horrendous that this might fail like this, not how we'll leave it... at least return an optional value idScaledType :: HasCallStack => Id -> Scaled Type idScaledType id = Scaled (idMult id) (idType id) ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -280,6 +280,7 @@ data Var data IdBinding where LambdaBound :: !Mult -> IdBinding -- ^ includes lambda-bound and constructor fields---pattern bound LetBound :: HasCallStack => UsageEnv -> IdBinding -- ^ a local let binding has a usage env bc it might have free linear variables in its body + -- ROMES:TODO: What about type variables? LambdaBound too? Do type variables have a multiplicity? -- Removed globalbinding in exchange for LetBound with zero Ue (closed top-level let bound) -- Might no longer make sense to merge with IdScope at all View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d97c081f88fc793e336e76ac59c5c5c57e557612 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d97c081f88fc793e336e76ac59c5c5c57e557612 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 15:25:28 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 11 May 2023 11:25:28 -0400 Subject: [Git][ghc/ghc][wip/t22884] error messages: Don't display ghci specific hints for missing packages Message-ID: <645d08e85ab84_352ebabd84457545@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: 04197c6b by Matthew Pickering at 2023-05-11T16:25:18+01:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 26 changed files: - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Ppr.hs - ghc/GHCi/UI/Exception.hs - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - + testsuite/tests/package/T22884.hs - + testsuite/tests/package/T22884.stderr - + testsuite/tests/package/T22884_interactive.script - + testsuite/tests/package/T22884_interactive.stderr - testsuite/tests/package/T4806.stderr - + testsuite/tests/package/T4806_interactive.script - + testsuite/tests/package/T4806_interactive.stderr - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/all.T - testsuite/tests/package/package01e.stderr - testsuite/tests/package/package06e.stderr - testsuite/tests/package/package07e.stderr - testsuite/tests/package/package08e.stderr - testsuite/tests/perf/compiler/parsing001.stderr - testsuite/tests/plugins/T11244.stderr - testsuite/tests/plugins/plugins03.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr - testsuite/tests/typecheck/should_fail/tcfail082.stderr Changes: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -19,6 +19,11 @@ module GHC.Iface.Errors.Ppr , missingInterfaceErrorReason , missingInterfaceErrorDiagnostic , readInterfaceErrorDiagnostic + + , lookingForHerald + , cantFindErrorX + , mayShowLocations + , pkgHiddenHint ) where @@ -129,34 +134,34 @@ cantFindError :: IfaceMessageOpts -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindError opts = cantFindErrorX (pkg_hidden_hint (ifaceBuildingCabalPackage opts)) (mayShowLocations (ifaceShowTriedFiles opts)) - where - pkg_hidden_hint using_cabal (Just pkg) - | using_cabal == YesBuildingCabalPackage - = text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - -- MP: This is ghci specific, remove - | otherwise - = text "You can run" <+> - quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> - text "to expose it." $$ - text "(Note: this unloads all the modules in the current scope.)" - pkg_hidden_hint _ Nothing = empty - -mayShowLocations :: Bool -> [FilePath] -> SDoc -mayShowLocations verbose files +cantFindError opts = + cantFindErrorX + (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts)) + (mayShowLocations "-v" (ifaceShowTriedFiles opts)) + + +pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage + -> UnitInfo -> SDoc +pkgHiddenHint _hint YesBuildingCabalPackage pkg + = text "Perhaps you need to add" <+> + quotes (ppr (unitPackageName pkg)) <+> + text "to the build-depends in your .cabal file." +pkgHiddenHint hint _not_cabal pkg + = hint pkg + +mayShowLocations :: String -> Bool -> [FilePath] -> SDoc +mayShowLocations option verbose files | null files = empty | not verbose = - text "Use -v (or `:set -v` in ghci) " <> + text "Use" <+> text option <+> text "to see a list of the files searched for." | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) -- | General version of cantFindError which has some holes which allow GHC/GHCi to display slightly different -- error messages. -cantFindErrorX :: (Maybe UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstalled mod_name cfir) = +cantFindErrorX :: (UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc +cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInstalled mod_name cfir) = let ambig = isAmbiguousInstalledReason cfir find_or_load = isLoadOrFindReason cfir ppr_what = prettyCantFindWhat find_or_load mod_or_interface ambig @@ -184,11 +189,11 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal text "There are files missing in the " <> quotes (ppr pkg) <+> text "package," $$ text "try running 'ghc-pkg check'." $$ - mayShowLocations files + may_show_locations files MissingPackageWayFiles build pkg files -> text "Perhaps you haven't installed the " <> text build <+> text "libraries for package " <> quotes (ppr pkg) <> char '?' $$ - mayShowLocations files + may_show_locations files ModuleSuggestion ms fps -> let pp_suggestions :: [ModuleSuggestion] -> SDoc @@ -230,7 +235,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> ppr (mkUnit pkg)) | otherwise = empty - in pp_suggestions ms $$ mayShowLocations fps + in pp_suggestions ms $$ may_show_locations fps NotAModule -> text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> vcat (map text fps) MultiplePackages mods @@ -248,7 +253,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal vcat (map pkg_hidden pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ vcat (map unusable unusables) $$ - mayShowLocations files + may_show_locations files where pprMod (m, o) = text "it is bound as" <+> ppr m <+> text "by" <+> pprOrigin m o @@ -268,7 +273,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> quotes (ppr uid) --FIXME: we don't really want to show the unit id here we should -- show the source package id or installed package id if it's ambiguous - <> dot $$ pkg_hidden_hint uif + <> dot $$ maybe empty pkg_hidden_hint uif mod_hidden pkg = @@ -285,21 +290,21 @@ interfaceErrorDiagnostic opts = \ case Can'tFindNameInInterface name relevant_tyThings -> missingDeclInInterface name relevant_tyThings Can'tFindInterface err looking_for -> - case looking_for of - LookingForName {} -> - missingInterfaceErrorDiagnostic opts err - LookingForModule {} -> - missingInterfaceErrorDiagnostic opts err - LookingForHiBoot mod -> - hang (text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon) - 2 (missingInterfaceErrorDiagnostic opts err) - LookingForSig sig -> - hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) - 2 (missingInterfaceErrorDiagnostic opts err) + hangNotEmpty (lookingForHerald looking_for) 2 (missingInterfaceErrorDiagnostic opts err) CircularImport mod -> text "Circular imports: module" <+> quotes (ppr mod) <+> text "depends on itself" +lookingForHerald :: InterfaceLookingFor -> SDoc +lookingForHerald looking_for = + case looking_for of + LookingForName {} -> empty + LookingForModule {} -> empty + LookingForHiBoot mod -> + text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon + LookingForSig sig -> + text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon + readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc readInterfaceErrorDiagnostic = \ case ExceptionOccurred fp ex -> ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,6 +21,10 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) , pprTyThingUsedWrong + + -- | Useful when overriding message printing. + , messageWithInfoDiagnosticMessage + , messageWithHsDocContext ) where @@ -126,12 +130,8 @@ instance Diagnostic TcRnMessage where (tcOptsShowContext opts) (diagnosticMessage opts msg) TcRnWithHsDocContext ctxt msg - -> if tcOptsShowContext opts - then main_msg `unionDecoratedSDoc` ctxt_msg - else main_msg - where - main_msg = diagnosticMessage opts msg - ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + -> messageWithHsDocContext opts ctxt (diagnosticMessage opts msg) + TcRnSolverReport msg _ _ -> mkSimpleDecorated $ pprSolverReportWithCtxt msg TcRnRedundantConstraints redundants (info, show_info) @@ -3259,6 +3259,14 @@ messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important = in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc` mkDecorated err_info' +messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc +messageWithHsDocContext opts ctxt main_msg = do + if tcOptsShowContext opts + then main_msg `unionDecoratedSDoc` ctxt_msg + else main_msg + where + ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc dodgy_msg kind tc ie = vcat [ text "The" <+> kind <+> text "item" <+> quotes (ppr ie) <+> text "suggests that" ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -4,14 +4,28 @@ module GHCi.UI.Exception(printGhciException, GHCiMessage(..)) where import GHC.Prelude -import GHC.Utils.Logger -import Control.Monad.IO.Class -import GHC.Driver.Session -import GHC.Types.SourceError -import GHC.Driver.Errors.Types -import GHC.Types.Error + import GHC.Driver.Config.Diagnostic import GHC.Driver.Errors +import GHC.Driver.Errors.Types +import GHC.Driver.Session + +import GHC.Iface.Errors.Ppr +import GHC.Iface.Errors.Types + +import GHC.Tc.Errors.Ppr +import GHC.Tc.Errors.Types + +import GHC.Types.Error +import GHC.Types.SourceError + +import GHC.Unit.State + +import GHC.Utils.Logger +import GHC.Utils.Outputable + +import Control.Monad.IO.Class + -- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting -- for some error messages. @@ -24,15 +38,67 @@ printGhciException err = do liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err)) -newtype GHCiMessage = GHCiMessage { getGhciMessage :: GhcMessage } +newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage } instance Diagnostic GHCiMessage where type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage - diagnosticMessage opts (GHCiMessage msg) = diagnosticMessage opts msg + diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg diagnosticReason (GHCiMessage msg) = diagnosticReason msg diagnosticHints (GHCiMessage msg) = diagnosticHints msg diagnosticCode (GHCiMessage msg) = diagnosticCode msg + +-- Modifications to error messages which we want to display in GHCi +ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc +ghciDiagnosticMessage ghc_opts msg = + case msg of + GhcTcRnMessage tc_msg -> + case tcRnMessage (tcMessageOpts ghc_opts) tc_msg of + Nothing -> diagnosticMessage ghc_opts msg + Just sdoc -> sdoc + GhcDriverMessage (DriverInterfaceError err) -> + case ghciInterfaceError err of + Just sdoc -> mkSimpleDecorated sdoc + Nothing -> diagnosticMessage ghc_opts msg + GhcDriverMessage {} -> diagnosticMessage ghc_opts msg + GhcPsMessage {} -> diagnosticMessage ghc_opts msg + GhcDsMessage {} -> diagnosticMessage ghc_opts msg + GhcUnknownMessage {} -> diagnosticMessage ghc_opts msg + where + tcRnMessage tc_opts tc_msg = + case tc_msg of + TcRnInterfaceError err -> mkSimpleDecorated <$> (ghciInterfaceError err) + TcRnMessageWithInfo unit_state msg_with_info -> + case msg_with_info of + TcRnMessageDetailed err_info wrapped_msg + -> messageWithInfoDiagnosticMessage unit_state err_info + (tcOptsShowContext tc_opts) + <$> tcRnMessage tc_opts wrapped_msg + TcRnWithHsDocContext ctxt wrapped_msg -> + messageWithHsDocContext tc_opts ctxt <$> tcRnMessage tc_opts wrapped_msg + _ -> Nothing + + opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts) + + ghciInterfaceError (Can'tFindInterface err looking_for) = + hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err + ghciInterfaceError _ = Nothing + + ghciMissingInterfaceErrorDiagnostic reason = + case reason of + CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi) + _ -> Nothing + where + + may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts) + + pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts) + where + hidden_msg pkg = + text "You can run" <+> + quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> + text "to expose it." $$ + text "(Note: this unloads all the modules in the current scope.)" ===================================== testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr ===================================== @@ -2,4 +2,4 @@ module-visibility-import/MV.hs:5:1: error: [GHC-87110] Could not load module ‘MV2’. it is a hidden module in the package ‘mv’ - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.stderr ===================================== @@ -18,7 +18,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z A.hs:3:1: error: [GHC-87110] Could not find module ‘B’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. == Dep_DM_AB == Dep_Error_DM_AB @@ -27,7 +27,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z A.hs:3:1: error: [GHC-87110] Could not find module ‘B’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. == Dep_MD_AB == Dep_Error_MD_AB ===================================== testsuite/tests/ghc-e/should_run/T2636.stderr ===================================== @@ -1,4 +1,4 @@ T2636.hs:1:1: error: [GHC-87110] Could not find module ‘MissingModule’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/module/mod1.stderr ===================================== @@ -1,4 +1,4 @@ mod1.hs:3:1: error: [GHC-87110] Could not find module ‘N’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/module/mod2.stderr ===================================== @@ -1,4 +1,4 @@ mod2.hs:3:1: error: [GHC-87110] Could not find module ‘N’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T22884.hs ===================================== @@ -0,0 +1,3 @@ +module T22884 where + +import Data.Text ===================================== testsuite/tests/package/T22884.stderr ===================================== @@ -0,0 +1,5 @@ + +T22884.hs:3:1: error: [GHC-87110] + Could not load module ‘Data.Text’. + It is a member of the hidden package ‘text-2.0.2’. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T22884_interactive.script ===================================== @@ -0,0 +1,3 @@ +:set -hide-all-packages + +import Data.Text ===================================== testsuite/tests/package/T22884_interactive.stderr ===================================== @@ -0,0 +1,6 @@ + +: error: [GHC-87110] + Could not load module ‘Data.Text’. + It is a member of the hidden package ‘text-2.0.2’. + You can run ‘:set -package text’ to expose it. + (Note: this unloads all the modules in the current scope.) ===================================== testsuite/tests/package/T4806.stderr ===================================== @@ -3,4 +3,4 @@ T4806.hs:1:1: error: [GHC-87110] Could not load module ‘Data.Map’. It is a member of the package ‘containers-0.6.7’ which is ignored due to an -ignore-package flag - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T4806_interactive.script ===================================== @@ -0,0 +1,3 @@ +:set -ignore-package containers + +:l T4806.hs ===================================== testsuite/tests/package/T4806_interactive.stderr ===================================== @@ -0,0 +1,6 @@ + +T4806.hs:1:1: error: [GHC-87110] + Could not load module ‘Data.Map’. + It is a member of the package ‘containers-0.6.7’ + which is ignored due to an -ignore-package flag + Use :set -v to see a list of the files searched for. ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -4,4 +4,4 @@ T4806a.hs:1:1: error: [GHC-87110] It is a member of the package ‘containers-0.6.7’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: deepseq-1.4.8.1 template-haskell-2.20.0.0 - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/all.T ===================================== @@ -20,3 +20,6 @@ test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers']) test('T4806a', normalise_version('deepseq', 'containers', 'template-haskell'), compile_fail, ['-ignore-package deepseq']) +test('T22884', normalise_version('text'), compile_fail, ['-hide-package text']) +test('T22884_interactive', normalise_version('text'), ghci_script, ['T22884_interactive.script']) +test('T4806_interactive', [extra_files(['T4806.hs']), normalise_version('containers')], ghci_script, ['T4806_interactive.script']) ===================================== testsuite/tests/package/package01e.stderr ===================================== @@ -2,13 +2,9 @@ package01e.hs:2:1: error: [GHC-87110] Could not load module ‘Data.Map’. It is a member of the hidden package ‘containers-0.6.7’. - You can run ‘:set -package containers’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package01e.hs:3:1: error: [GHC-87110] Could not load module ‘Data.IntMap’. It is a member of the hidden package ‘containers-0.6.7’. - You can run ‘:set -package containers’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package06e.stderr ===================================== @@ -2,13 +2,9 @@ package06e.hs:2:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package06e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package07e.stderr ===================================== @@ -5,25 +5,19 @@ package07e.hs:2:1: error: [GHC-61948] GHC.Hs.Type (needs flag -package-id ghc-9.7) GHC.Tc.Types (needs flag -package-id ghc-9.7) GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:4:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Utils’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:5:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package08e.stderr ===================================== @@ -5,25 +5,19 @@ package08e.hs:2:1: error: [GHC-61948] GHC.Hs.Type (needs flag -package-id ghc-9.7) GHC.Tc.Types (needs flag -package-id ghc-9.7) GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:4:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Utils’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:5:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/perf/compiler/parsing001.stderr ===================================== @@ -1,4 +1,4 @@ parsing001.hs:3:1: error: [GHC-87110] Could not find module ‘Wibble’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/plugins/T11244.stderr ===================================== @@ -1,5 +1,3 @@ : Could not load module ‘RuleDefiningPlugin’. It is a member of the hidden package ‘rule-defining-plugin-0.1’. -You can run ‘:set -package rule-defining-plugin’ to expose it. -(Note: this unloads all the modules in the current scope.) -Use -v (or `:set -v` in ghci) to see a list of the files searched for. +Use -v to see a list of the files searched for. ===================================== testsuite/tests/plugins/plugins03.stderr ===================================== @@ -1,2 +1,2 @@ : Could not find module ‘Simple.NonExistentPlugin’. -Use -v (or `:set -v` in ghci) to see a list of the files searched for. +Use -v to see a list of the files searched for. ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr ===================================== @@ -4,4 +4,4 @@ SafeLang07.hs:2:14: warning: SafeLang07.hs:15:1: error: [GHC-87110] Could not find module ‘SafeLang07_A’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/typecheck/should_fail/tcfail082.stderr ===================================== @@ -1,12 +1,12 @@ tcfail082.hs:2:1: error: [GHC-87110] Could not find module ‘Data82’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. tcfail082.hs:3:1: error: [GHC-87110] Could not find module ‘Inst82_1’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. tcfail082.hs:4:1: error: [GHC-87110] Could not find module ‘Inst82_2’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04197c6b669a6bc3ba834d4dfecfaa8ab74a8982 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04197c6b669a6bc3ba834d4dfecfaa8ab74a8982 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 15:55:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 11:55:38 -0400 Subject: [Git][ghc/ghc][master] Add fused multiply-add instructions Message-ID: <645d0ffaf022e_352ebac69e4689c2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/SysTools/Cpp.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using.rst - libraries/ghc-prim/changelog.md - rts/RtsSymbols.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87eebf98cb485f7c9175330051736e147ade9848 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87eebf98cb485f7c9175330051736e147ade9848 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 15:56:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 11:56:19 -0400 Subject: [Git][ghc/ghc][master] Add a test for #21278 Message-ID: <645d1023bac4_352ebac69e4724f1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 3 changed files: - + testsuite/tests/linear/should_fail/T21278.hs - + testsuite/tests/linear/should_fail/T21278.stderr - testsuite/tests/linear/should_fail/all.T Changes: ===================================== testsuite/tests/linear/should_fail/T21278.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE LinearTypes #-} +module T21278 where + +data C a = forall p. C (a %p -> a) + +f :: C a -> C a +f b = C (\x -> case b of C g -> g x) ===================================== testsuite/tests/linear/should_fail/T21278.stderr ===================================== @@ -0,0 +1,13 @@ + +T21278.hs:7:11: error: [GHC-25897] + • Couldn't match type ‘p’ with ‘Many’ + arising from multiplicity of ‘x’ + ‘p’ is a rigid type variable bound by + a pattern with constructor: + C :: forall a (p :: GHC.Types.Multiplicity). (a %p -> a) %1 -> C a, + in a case alternative + at T21278.hs:7:26-28 + • In the first argument of ‘C’, namely + ‘(\ x -> case b of C g -> g x)’ + In the expression: C (\ x -> case b of C g -> g x) + In an equation for ‘f’: f b = C (\ x -> case b of C g -> g x) ===================================== testsuite/tests/linear/should_fail/all.T ===================================== @@ -40,3 +40,4 @@ test('T18888_datakinds', normal, compile_fail, ['']) test('T19120', normal, compile_fail, ['']) test('T20083', normal, compile_fail, ['-XLinearTypes']) test('T19361', normal, compile_fail, ['']) +test('T21278', normal, compile_fail, ['-XLinearTypes']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad16a0666340723b656879f4c0bb94653363608b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad16a0666340723b656879f4c0bb94653363608b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 15:56:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 11:56:59 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 15 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <645d104b2c881_352ebabcca077930@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 3017aef1 by Ben Gamari at 2023-05-11T08:32:12-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 59725a87 by Ben Gamari at 2023-05-11T09:16:53-04:00 base: Introduce Data.Enum - - - - - 00d2831f by Ben Gamari at 2023-05-11T09:17:07-04:00 base: Add export list to GHC.Num.Integer - - - - - 00efb5c5 by Ben Gamari at 2023-05-11T09:19:15-04:00 base: Add export list to GHC.Num - - - - - 0f9b6bb0 by Ben Gamari at 2023-05-11T09:19:42-04:00 base: Add export list to GHC.Num.Natural - - - - - 59a78d1b by Ben Gamari at 2023-05-11T11:04:12-04:00 base: Introduce Data.Show - - - - - 58960e89 by Ben Gamari at 2023-05-11T11:39:21-04:00 base: Add export list to GHC.Float - - - - - 34c18c23 by Ben Gamari at 2023-05-11T11:55:26-04:00 base: Add export list to GHC.Real - - - - - 91cb668c by Ben Gamari at 2023-05-11T11:55:33-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Driver/Session.hs - compiler/GHC/Platform.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - + libraries/base/Data/Enum.hs - libraries/base/Data/Fixed.hs - + libraries/base/Data/Show.hs - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dfb874b71fb9a32bc093c551df6eb45017c37a3a...91cb668cc440b13a685c893bbe70a2d094fe1442 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dfb874b71fb9a32bc093c551df6eb45017c37a3a...91cb668cc440b13a685c893bbe70a2d094fe1442 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 15:57:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 11:57:07 -0400 Subject: [Git][ghc/ghc][master] rts: Refine memory retention behaviour to account for pinned/compacted objects Message-ID: <645d105364f1_352ebac69f878392@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 5 changed files: - rts/sm/GC.c - rts/sm/Storage.c - rts/sm/Storage.h - + testsuite/tests/rts/T23221.hs - testsuite/tests/rts/all.T Changes: ===================================== rts/sm/GC.c ===================================== @@ -994,14 +994,40 @@ GarbageCollect (struct GcConfig config, commitMBlockFreeing(); if (major_gc) { - W_ need_prealloc, need_live, need, got; + W_ need_prealloc, need_copied_live, need_uncopied_live, need, got, extra_needed; uint32_t i; - need_live = 0; + need_copied_live = 0; + need_uncopied_live = 0; for (i = 0; i < RtsFlags.GcFlags.generations; i++) { - need_live += genLiveBlocks(&generations[i]); + need_copied_live += genLiveCopiedBlocks(&generations[i]); + need_uncopied_live += genLiveUncopiedBlocks(&generations[i]); } - need_live = stg_max(RtsFlags.GcFlags.minOldGenSize, need_live); + + debugTrace(DEBUG_gc, "(before) copied_live: %d; uncopied_live: %d", need_copied_live, need_uncopied_live ); + + + // minOldGenSize states that the size of the oldest generation must be at least + // as big as a certain value, so make sure to save enough memory for that. + extra_needed = 0; + if (RtsFlags.GcFlags.minOldGenSize >= need_copied_live + need_uncopied_live){ + extra_needed = RtsFlags.GcFlags.minOldGenSize - (need_copied_live + need_uncopied_live); + } + debugTrace(DEBUG_gc, "(minOldGen: %d; extra_needed: %d", RtsFlags.GcFlags.minOldGenSize, extra_needed); + + // If oldest gen is uncopying in some manner (compact or non-moving) then + // add the extra requested by minOldGenSize to uncopying portion of memory. + // Otherwise, the last generation is copying so add it to copying portion. + if (oldest_gen -> compact || RtsFlags.GcFlags.useNonmoving) { + need_uncopied_live += extra_needed; + } + else { + need_copied_live += extra_needed; + } + + ASSERT(need_uncopied_live + need_copied_live >= RtsFlags.GcFlags.minOldGenSize ); + + debugTrace(DEBUG_gc, "(after) copyied_live: %d; uncopied_live: %d", need_copied_live, need_uncopied_live ); need_prealloc = 0; for (i = 0; i < n_nurseries; i++) { @@ -1027,14 +1053,19 @@ GarbageCollect (struct GcConfig config, debugTrace(DEBUG_gc, "factors: %f %d %f", RtsFlags.GcFlags.oldGenFactor, consec_idle_gcs, scaled_factor ); - // Unavoidable need depends on GC strategy + // Unavoidable need for copying memory depends on GC strategy // * Copying need 2 * live // * Compacting need 1.x * live (we choose 1.2) - // * Nonmoving needs ~ 1.x * live - double unavoidable_need_factor = (oldest_gen->compact || RtsFlags.GcFlags.useNonmoving) - ? 1.2 : 2; - W_ scaled_needed = (scaled_factor + unavoidable_need_factor) * need_live; - debugTrace(DEBUG_gc, "factors_2: %f %d", unavoidable_need_factor, scaled_needed); + double unavoidable_copied_need_factor = (oldest_gen->compact) + ? 1.2 : 2; + + // Unmoving blocks (compacted, pinned, nonmoving GC blocks) are not going + // to be copied so don't need to save 2* the memory for them. + double unavoidable_uncopied_need_factor = 1.2; + + W_ scaled_needed = ((scaled_factor + unavoidable_copied_need_factor) * need_copied_live) + + ((scaled_factor + unavoidable_uncopied_need_factor) * need_uncopied_live); + debugTrace(DEBUG_gc, "factors_2: %f %d", ((scaled_factor + unavoidable_copied_need_factor) * need_copied_live), ((scaled_factor + unavoidable_uncopied_need_factor) * need_uncopied_live)); need = need_prealloc + scaled_needed; /* Also, if user set heap size, do not drop below it. ===================================== rts/sm/Storage.c ===================================== @@ -1608,20 +1608,34 @@ W_ countOccupied (bdescr *bd) return words; } +// Returns the total number of live blocks W_ genLiveWords (generation *gen) { return (gen->live_estimate ? gen->live_estimate : gen->n_words) + gen->n_large_words + gen->n_compact_blocks * BLOCK_SIZE_W; } -W_ genLiveBlocks (generation *gen) +// The number of live blocks which will be copied by the copying collector. +W_ genLiveCopiedBlocks (generation *gen) +{ + return gen->n_blocks; +} + +// The number of live blocks which will not be copied by the copying collector +// This includes non-moving collector segments, compact blocks and large/pinned blocks. +W_ genLiveUncopiedBlocks (generation *gen) { W_ nonmoving_blocks = 0; // The nonmoving heap contains some blocks that live outside the regular generation structure. if (gen == oldest_gen && RtsFlags.GcFlags.useNonmoving){ nonmoving_blocks = n_nonmoving_large_blocks + n_nonmoving_marked_large_blocks + n_nonmoving_compact_blocks + n_nonmoving_marked_compact_blocks; } - return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks; + return gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks; +} + +W_ genLiveBlocks (generation *gen) +{ + return genLiveCopiedBlocks(gen) + genLiveUncopiedBlocks(gen); } W_ gcThreadLiveWords (uint32_t i, uint32_t g) ===================================== rts/sm/Storage.h ===================================== @@ -121,6 +121,8 @@ StgWord gcThreadLiveBlocks (uint32_t i, uint32_t g); StgWord genLiveWords (generation *gen); StgWord genLiveBlocks (generation *gen); +StgWord genLiveCopiedBlocks (generation *gen); +StgWord genLiveUncopiedBlocks (generation *gen); StgWord calcTotalLargeObjectsW (void); StgWord calcTotalCompactW (void); ===================================== testsuite/tests/rts/T23221.hs ===================================== @@ -0,0 +1,70 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, NumericUnderscores #-} + +module Main where + +import GHC.Exts +import GHC.IO +import System.Mem +import System.Environment +import Debug.Trace +import Control.Monad +import GHC.Stats +import Data.Word + +-- This test is for checking the memory return behaviour of blocks which will be +-- copied and blocks which are not copied (#23221) +main :: IO () +main = do + [sn] <- getArgs + let n = read sn + -- By checking that lower bound of unpinned is the upper bound of pinned then we + -- check that unpinned has lower memory baseline than pinned. + loop newByteArray 2 3 n + loop newPinnedByteArray 1 2 n + + +-- The upper_bound is the upper bound on how much total memory should be live at the end +-- of the test as a factor of the expected live bytes. +loop f lower_bound upper_bound n = do + ba <- mapM (\_ -> f 128) [0..n] + traceMarkerIO "Allocated_all" + performGC + let !ba' = take (n `div` 4) ba + evaluate (length ba') + traceMarkerIO "GC_4" + performGC + evaluate (length (reverse ba')) + replicateM_ 20 performGC + total_mem <- checkStats lower_bound upper_bound (n `div` 4) + evaluate (length (reverse ba')) + return total_mem + +checkStats :: Double -> Double -> Int -> IO () +checkStats lower_bound upper_bound n = do + stats <- getRTSStats + let expected_live_memory = fromIntegral n -- How many objects + * (3 -- One list cons + + 2 -- One BA constructor + + 18) -- ByteArray# object (size 16 + 2 overhead) + -- size of each object + * 8 -- word size + let bytes_used = gcdetails_mem_in_use_bytes (gc stats) + mblocks = bytes_used `div` (2 ^ 20) + when (truncate (expected_live_memory * upper_bound) < bytes_used) $ + error ("Upper Memory bound failed: " ++ show (truncate expected_live_memory, upper_bound, bytes_used)) + when (truncate (expected_live_memory * lower_bound) >= bytes_used) $ + error ("Lower Memory bound failed: " ++ show (truncate expected_live_memory, lower_bound, bytes_used)) + +data BA = BA ByteArray# + +newByteArray :: Int -> IO BA +newByteArray (I# sz#) = IO $ \s -> case newByteArray# sz# s of + (# s', k #) -> case unsafeFreezeByteArray# k s' of + (# s'', ba# #) -> (# s'', BA ba# #) + +newPinnedByteArray :: Int -> IO BA +newPinnedByteArray (I# sz#) = IO $ \s -> case newPinnedByteArray# sz# s of + (# s', k #) -> case unsafeFreezeByteArray# k s' of + (# s'', ba# #) -> (# s'', BA ba# #) + + ===================================== testsuite/tests/rts/all.T ===================================== @@ -590,4 +590,6 @@ test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded - test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T']) +test('T23221', [js_skip, high_memory_usage, extra_run_opts('1500000'), unless(wordsize(64), skip)], compile_and_run, ['-O -with-rtsopts -T']) + test('T23142', [unless(debug_rts(), skip), req_interp], makefile_test, ['T23142']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05cea68c0f883999e8fc69edd305906041f44829 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05cea68c0f883999e8fc69edd305906041f44829 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 15:57:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 11:57:45 -0400 Subject: [Git][ghc/ghc][master] hadrian: fix no_dynamic_libs flavour transformer Message-ID: <645d10791dcaa_352ebabd858817ef@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 1 changed file: - hadrian/src/Flavour.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -243,10 +243,12 @@ enableProfiledGhc flavour = disableDynamicGhcPrograms :: Flavour -> Flavour disableDynamicGhcPrograms flavour = flavour { dynamicGhcPrograms = pure False } --- | Don't build libraries in profiled 'Way's. +-- | Don't build libraries in dynamic 'Way's. disableDynamicLibs :: Flavour -> Flavour disableDynamicLibs flavour = - flavour { libraryWays = prune $ libraryWays flavour + flavour { libraryWays = prune $ libraryWays flavour, + rtsWays = prune $ rtsWays flavour, + dynamicGhcPrograms = pure False } where prune :: Ways -> Ways @@ -306,18 +308,8 @@ enableBootNonmovingGc = addArgs $ mconcat -- for static linking. fullyStatic :: Flavour -> Flavour fullyStatic flavour = - addArgs staticExec - $ flavour { dynamicGhcPrograms = return False - , libraryWays = prune $ libraryWays flavour - , rtsWays = prune $ rtsWays flavour } + addArgs staticExec $ disableDynamicLibs flavour where - -- Remove any Way that contains a WayUnit of Dynamic - prune :: Ways -> Ways - prune = fmap $ Set.filter staticCompatible - - staticCompatible :: Way -> Bool - staticCompatible = not . wayUnit Dynamic - staticExec :: Args {- Some packages, especially iserv, seem to force a set of build ways, - including some that are dynamic (in Rules.BinaryDist). Trying to @@ -326,7 +318,7 @@ fullyStatic flavour = - the Ways will need to include a Way that's not explicitly dynamic - (like "vanilla"). -} - staticExec = staticCompatible <$> getWay ? mconcat + staticExec = mconcat {- - Disable dynamic linking by the built ghc executable because the - statically-linked musl doesn't support dynamic linking, but will View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bb24432ff77e11a0340a7d8586e151e15bba2a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bb24432ff77e11a0340a7d8586e151e15bba2a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 16:28:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 12:28:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add fused multiply-add instructions Message-ID: <645d17a1757df_352eba2fd8534969ab@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0e0c81c6 by Josh Meredith at 2023-05-11T12:28:09-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - fd29f72f by Pierre Le Marre at 2023-05-11T12:28:13-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/447f2e1c9ce714da9a48e075c29f80a4aaddc09f...fd29f72fcda44e644b4dcd7650617affff16eca6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/447f2e1c9ce714da9a48e075c29f80a4aaddc09f...fd29f72fcda44e644b4dcd7650617affff16eca6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 16:29:16 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Thu, 11 May 2023 12:29:16 -0400 Subject: [Git][ghc/ghc][wip/T23083] 95 commits: JS: fix thread-related primops Message-ID: <645d17dcdb67_352eba31c980c102284@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 2a522c3c by Sebastian Graf at 2023-05-11T16:57:37+02:00 Cleanup a TODO introduced in 1f94e0f7 The change must have slipped through review of !4412 - - - - - f5a48086 by Sebastian Graf at 2023-05-11T16:57:37+02:00 More explicit strictness in GHC.Real - - - - - b57798f6 by Sebastian Graf at 2023-05-11T16:57:37+02:00 exprIsTrivial: Factor out shared implementation The duplication between `exprIsTrivial` and `getIdFromTrivialExpr_maybe` has been bugging me for a long time. This patch introduces an inlinable worker function `trivial_expr_fold` acting as the single, shared decision procedure of triviality. It "returns" a Church-encoded `Maybe (Maybe Id)`, so when it is inlined, it fuses to similar code as before. (Better code, even, in the case of `getIdFromTrivialExpr` which presently allocates a `Just` constructor that cancels away after this patch.) - - - - - 90ec0f0a by Sebastian Graf at 2023-05-11T16:57:37+02:00 Simplify: Simplification of arguments in a single function The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. - - - - - 0dcbced7 by Sebastian Graf at 2023-05-11T17:02:07+02:00 Core.Ppr: Omit case binder for empty case alternatives A minor improvement to pretty-printing - - - - - f66f8760 by Sebastian Graf at 2023-05-11T17:02:10+02:00 Inlining literals into boring contexts is OK - - - - - 0ef6bcb7 by Sebastian Graf at 2023-05-11T17:02:10+02:00 Kill SetLevel.notWorthFloating.is_triv (#23270) We have had it since b84ba676034, when it operated on annotated expressions. Nowadays it operates on vanilla `CoreExpr` though, so we should just call `exprIsTrivial`; thus handling empty cases and string literals correctly. - - - - - 1725be52 by Sebastian Graf at 2023-05-11T17:02:10+02:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Fixes #23270. - - - - - 4a9ed48f by Sebastian Graf at 2023-05-11T17:02:10+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - 89b27d7b by Sebastian Graf at 2023-05-11T18:02:58+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - 7d9de751 by Sebastian Graf at 2023-05-11T18:02:58+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be2753a2d1b7e8f26a760c2f5204f453a47d2f33...7d9de75154147c86782f9b7192d4d2764c235021 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be2753a2d1b7e8f26a760c2f5204f453a47d2f33...7d9de75154147c86782f9b7192d4d2764c235021 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 17:01:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 13:01:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.6 Message-ID: <645d1f55671f7_352eba27db4d01122b7@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 17:40:42 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 11 May 2023 13:40:42 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <645d289aa9edc_26a806bcd2c10206a@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: bbf0bd4a by Andrei Borzenkov at 2023-05-11T21:40:34+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - + docs/users_guide/exts/implicit_forall.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/exts/type_signatures.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.stderr - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbf0bd4a21d5ee07eef4f02bea572b35eab93655 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbf0bd4a21d5ee07eef4f02bea572b35eab93655 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 17:41:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 13:41:40 -0400 Subject: [Git][ghc/ghc][wip/T19146] 16 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <645d28d470587_26a806bcd7c102517@gitlab.mail> Ben Gamari pushed to branch wip/T19146 at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 510f3caa by Ben Gamari at 2023-05-11T13:41:35-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - 6db75bdb by Ben Gamari at 2023-05-11T13:41:35-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - e8d48f7b by Ben Gamari at 2023-05-11T13:41:35-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - dc7bd3a3 by Ben Gamari at 2023-05-11T13:41:35-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 439ec7f7 by Ben Gamari at 2023-05-11T13:41:35-04:00 rts: Introduce printGlobalThreads - - - - - e63c33cd by Ben Gamari at 2023-05-11T13:41:36-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Platform.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/SysTools/Cpp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7c3de6759f4a14a1c51c935dc939cc19ce6904b...e63c33cd08e441f2bf125ef5ad4a4c38cec42d47 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7c3de6759f4a14a1c51c935dc939cc19ce6904b...e63c33cd08e441f2bf125ef5ad4a4c38cec42d47 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 18:23:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 14:23:14 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 21 commits: testsuite: Add test for atomicSwapIORef Message-ID: <645d3292e8e85_26a806bcd2c116179@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 165140f4 by Ben Gamari at 2023-05-11T14:23:05-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81bbfec71cda8254b613fd710fb8f7a4596f1d6e...165140f44e87a240c3aa8c501aac044cb4653f11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81bbfec71cda8254b613fd710fb8f7a4596f1d6e...165140f44e87a240c3aa8c501aac044cb4653f11 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 19:08:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 15:08:18 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <645d3d223f354_26a806bccc81326f8@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 8d7f728d by Ben Gamari at 2023-05-11T15:08:11-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,169 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp, isDataConName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (showToHeader) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc ["-package=" ++ pkg_nm, "-dppr-cols=1000"] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing thing + -- Ignore the RHSs of Foreign.C.Types' data constructors as they are + -- platform dependent + | mod_nm == foreignCTypes + , isDataConName nm = True + | otherwise = False + where + nm = getName thing + mod_nm = moduleName $ nameModule nm + foreignCTypes = mkModuleName "Foreign.C.Types" + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing showToHeader thing + | Just thing <- things + , not $ ignoredTyThing thing + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8d7f728d820a62b7daa612d9494f89e8e7ba86c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8d7f728d820a62b7daa612d9494f89e8e7ba86c7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 19:22:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 15:22:45 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <645d40852e56f_26a806bcd7c133542@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 38fe392d by Ben Gamari at 2023-05-11T15:22:31-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,169 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp, isDataConName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (showToHeader) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc ["-package=" ++ pkg_nm, "-dppr-cols=1000"] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing thing + -- Ignore the RHSs of Foreign.C.Types' data constructors as they are + -- platform dependent + | mod_nm == foreignCTypes + , isDataConName nm = True + | otherwise = False + where + nm = getName thing + mod_nm = moduleName $ nameModule nm + foreignCTypes = mkModuleName "Foreign.C.Types" + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing showToHeader thing + | Just thing <- things + , not $ ignoredTyThing thing + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38fe392d82d895fbf702f7a242ebe38ee758ceeb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38fe392d82d895fbf702f7a242ebe38ee758ceeb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 20:35:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 16:35:54 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 13 commits: Add fused multiply-add instructions Message-ID: <645d51aaf367e_26a806bf234140227@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 38fe392d by Ben Gamari at 2023-05-11T15:22:31-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 0dbf5c03 by Ben Gamari at 2023-05-11T15:22:51-04:00 base: Introduce Data.Enum - - - - - e4191a50 by Ben Gamari at 2023-05-11T15:22:51-04:00 base: Add export list to GHC.Num.Integer - - - - - 8e7834ea by Ben Gamari at 2023-05-11T15:22:51-04:00 base: Add export list to GHC.Num - - - - - c5d0cf91 by Ben Gamari at 2023-05-11T15:22:51-04:00 base: Add export list to GHC.Num.Natural - - - - - 06a1c145 by Ben Gamari at 2023-05-11T15:22:51-04:00 base: Introduce Data.Show - - - - - d77a6604 by Ben Gamari at 2023-05-11T15:45:38-04:00 base: Add export list to GHC.Float - - - - - 9d1c4bdc by Ben Gamari at 2023-05-11T16:23:30-04:00 base: Add export list to GHC.Real - - - - - 29058cc8 by Ben Gamari at 2023-05-11T16:23:36-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/SysTools/Cpp.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using.rst - hadrian/src/Flavour.hs - hadrian/src/Packages.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91cb668cc440b13a685c893bbe70a2d094fe1442...29058cc86dcd537032c1e425b760c98a16ef968b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91cb668cc440b13a685c893bbe70a2d094fe1442...29058cc86dcd537032c1e425b760c98a16ef968b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 21:35:10 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 17:35:10 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <645d5f8e1caa8_26a806bcd0414967a@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 5892e6d2 by Ben Gamari at 2023-05-11T17:34:24-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,183 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType, tyConsOfTypes) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp, isDataConName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (showToHeader) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc ["-package=" ++ pkg_nm, "-dppr-cols=1000"] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing thing + -- Ignore the RHSs of Foreign.C.Types' data constructors as they are + -- platform dependent + | mod_nm == foreignCTypes + , isDataConName nm = True + | otherwise = False + where + nm = getName thing + mod_nm = moduleName $ nameModule nm + foreignCTypes = mkModuleName "Foreign.C.Types" + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing showToHeader thing + | Just thing <- things + , not $ ignoredTyThing thing + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +-- | This is a fairly ad-hoc ordering to mostly ensure determinism. +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + , compareListsWith stableNameCmp + (sorted_tycons tys1) + (sorted_tycons tys2) + ] + where + sorted_tycons = + sortBy stableNameCmp . map getName . nonDetEltsUniqSet . tyConsOfTypes + (_, cls1, tys1) = instanceHead inst1 + (_, cls2, tys2) = instanceHead inst2 + +compareListsWith :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering +compareListsWith cmp = go + where + go (x:xs) (y:ys) = cmp x y `mappend` go xs ys + go [] (_:_) = LT + go (_:_) [] = GT + go [] [] = EQ ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5892e6d2c5c079490b133f897c822fb099a1ad22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5892e6d2c5c079490b133f897c822fb099a1ad22 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 22:14:50 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 11 May 2023 18:14:50 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 9 commits: testsuite: Add test to catch changes in core libraries Message-ID: <645d68da9b479_26a806bccf0150339@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 5892e6d2 by Ben Gamari at 2023-05-11T17:34:24-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 6cb9cafa by Ben Gamari at 2023-05-11T17:37:03-04:00 base: Introduce Data.Enum - - - - - 9ddbd1aa by Ben Gamari at 2023-05-11T17:37:08-04:00 base: Add export list to GHC.Num.Integer - - - - - 0523dfaf by Ben Gamari at 2023-05-11T17:37:08-04:00 base: Add export list to GHC.Num - - - - - 40af542a by Ben Gamari at 2023-05-11T17:37:08-04:00 base: Add export list to GHC.Num.Natural - - - - - f1d2b91e by Ben Gamari at 2023-05-11T17:37:08-04:00 base: Introduce Data.Show - - - - - abb31c08 by Ben Gamari at 2023-05-11T17:59:17-04:00 base: Add export list to GHC.Float - - - - - 305ea169 by Ben Gamari at 2023-05-11T17:59:29-04:00 base: Add export list to GHC.Real - - - - - c720b42c by Ben Gamari at 2023-05-11T18:14:05-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 19 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - + libraries/base/Data/Enum.hs - + libraries/base/Data/Show.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== libraries/base/Data/Enum.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum ===================================== libraries/base/Data/Show.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Show +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Show' class. +-- +----------------------------------------------------------------------------- + +module Data.Show + ( Show(..) + -- * 'ShowS' + , ShowS + , shows + , showChar, showString, showMultiLineString + , showParen, showCommaSpace, showSpace + , showLitChar, showLitString + ) where + +import GHC.Show + ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,109 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int + , int2Float + , word2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorFloat + , ceilingFloat + , truncateFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , eqFloat, gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , powerFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , word2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , eqDouble, gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , powerDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Internal + , stgFloatToWord32 + , stgWord32ToFloat + , stgDoubleToWord64 + , stgWord64ToDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Num.hs ===================================== @@ -18,7 +18,9 @@ module GHC.Num - ( module GHC.Num + ( Num(..) + , subtract + , quotRemInteger , module GHC.Num.Integer , module GHC.Num.Natural -- reexported for backward compatibility ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,68 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + , mkRationalWithExponentBase + , FractionalExponentBase(..) + ) where #include "MachDeps.h" ===================================== libraries/base/base.cabal ===================================== @@ -127,6 +127,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 @@ -151,6 +152,7 @@ Library Data.Proxy Data.Ratio Data.Semigroup + Data.Show Data.STRef Data.STRef.Lazy Data.STRef.Strict ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -20,7 +20,131 @@ -- -- The 'Integer' type. -module GHC.Num.Integer where +module GHC.Num.Integer + ( Integer(..) + , integerCheck + , integerCheck# + + -- * Useful constants + , integerZero + , integerOne + + -- * Conversion with... + -- ** 'Int' + , integerFromInt# + , integerFromInt + , integerToInt# + , integerToInt + -- ** 'BigNat' + , integerFromBigNat# + , integerFromBigNatNeg# + , integerFromBigNatSign# + , integerToBigNatSign# + , integerToBigNatClamp# + -- ** 'Word' + , integerFromWord# + , integerFromWord + , integerFromWordNeg# + , integerFromWordSign# + , integerToWord# + , integerToWord + -- ** 'Natural' + , integerFromNatural + , integerToNaturalClamp + , integerToNatural + , integerToNaturalThrow + -- ** 'Int64'/'Word64' + , integerFromInt64# + , integerFromWord64# + , integerToInt64# + , integerToWord64# + -- ** Floating-point + , integerDecodeDouble# + , integerEncodeDouble# + , integerEncodeDouble + , integerEncodeFloat# + -- ** 'Addr#' + , integerToAddr# + , integerToAddr + , integerFromAddr# + , integerFromAddr + -- ** Limbs + , integerFromWordList + , integerToMutableByteArray# + , integerToMutableByteArray + , integerFromByteArray# + , integerFromByteArray + + -- * Predicates + , integerIsNegative# + , integerIsNegative + , integerIsZero + , integerIsOne + + -- * Comparison + , integerNe + , integerEq + , integerLe + , integerLt + , integerGt + , integerGe + , integerEq# + , integerNe# + , integerGt# + , integerLe# + , integerLt# + , integerGe# + , integerCompare + + -- * Arithmetic + , integerSub + , integerAdd + , integerMul + , integerNegate + , integerAbs + , integerSignum + , integerSignum# + , integerQuotRem# + , integerQuotRem + , integerQuot + , integerRem + , integerDivMod# + , integerDivMod + , integerDiv + , integerMod + , integerGcd + , integerLcm + , integerSqr + , integerLog2# + , integerLog2 + , integerLogBaseWord# + , integerLogBaseWord + , integerLogBase# + , integerLogBase + , integerIsPowerOf2# + , integerGcde# + , integerGcde + , integerRecipMod# + , integerPowMod# + + -- * Bit operations + , integerPopCount# + , integerBit# + , integerBit + , integerTestBit# + , integerTestBit + , integerShiftR# + , integerShiftR + , integerShiftL# + , integerShiftL + , integerOr + , integerXor + , integerAnd + , integerComplement + + -- * Miscellaneous + , integerSizeInBase# + ) where #include "MachDeps.h" #include "WordSize.h" ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -8,7 +8,109 @@ #include "MachDeps.h" #include "WordSize.h" -module GHC.Num.Natural where +module GHC.Num.Natural + ( Natural(..) + , naturalCheck# + , naturalCheck + + -- * Useful constants + , naturalZero + , naturalOne + + -- * Predicates + , naturalIsZero + , naturalIsOne + , naturalIsPowerOf2# + + -- * Conversion with... + -- ** 'BigNat' + , naturalFromBigNat# + , naturalToBigNat# + -- ** 'Word' + , naturalFromWord# + , naturalFromWord2# + , naturalFromWord + , naturalToWord# + , naturalToWord + , naturalToWordClamp# + , naturalToWordClamp + , naturalToWordMaybe# + -- ** Limbs + , naturalFromWordList + , naturalToMutableByteArray# + , naturalFromByteArray# + -- ** Floating point + , naturalEncodeDouble# + , naturalEncodeFloat# + -- ** 'Addr#' + , naturalToAddr# + , naturalToAddr + , naturalFromAddr# + , naturalFromAddr + + -- * Comparison + , naturalEq# + , naturalEq + , naturalNe# + , naturalNe + , naturalGe# + , naturalGe + , naturalLe# + , naturalLe + , naturalGt# + , naturalGt + , naturalLt# + , naturalLt + , naturalCompare + + -- * Bit operations + , naturalPopCount# + , naturalPopCount + , naturalShiftR# + , naturalShiftR + , naturalShiftL# + , naturalShiftL + , naturalAnd + , naturalAndNot + , naturalOr + , naturalXor + , naturalTestBit# + , naturalTestBit + , naturalBit# + , naturalBit + , naturalSetBit# + , naturalSetBit + , naturalClearBit# + , naturalClearBit + , naturalComplementBit# + , naturalComplementBit + + -- * Arithmetic + , naturalAdd + , naturalSub + , naturalSubThrow + , naturalSubUnsafe + , naturalMul + , naturalSqr + , naturalSignum + , naturalNegate + , naturalQuotRem# + , naturalQuotRem + , naturalQuot + , naturalRem + , naturalGcd + , naturalLcm + , naturalLog2# + , naturalLog2 + , naturalLogBaseWord# + , naturalLogBaseWord + , naturalLogBase# + , naturalLogBase + , naturalPowMod + + -- * Miscellaneous + , naturalSizeInBase# + ) where import GHC.Prim import GHC.Types ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,183 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType, tyConsOfTypes) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp, isDataConName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (showToHeader) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc ["-package=" ++ pkg_nm, "-dppr-cols=1000"] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing thing + -- Ignore the RHSs of Foreign.C.Types' data constructors as they are + -- platform dependent + | mod_nm == foreignCTypes + , isDataConName nm = True + | otherwise = False + where + nm = getName thing + mod_nm = moduleName $ nameModule nm + foreignCTypes = mkModuleName "Foreign.C.Types" + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing showToHeader thing + | Just thing <- things + , not $ ignoredTyThing thing + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +-- | This is a fairly ad-hoc ordering to mostly ensure determinism. +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + , compareListsWith stableNameCmp + (sorted_tycons tys1) + (sorted_tycons tys2) + ] + where + sorted_tycons = + sortBy stableNameCmp . map getName . nonDetEltsUniqSet . tyConsOfTypes + (_, cls1, tys1) = instanceHead inst1 + (_, cls2, tys2) = instanceHead inst2 + +compareListsWith :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering +compareListsWith cmp = go + where + go (x:xs) (y:ys) = cmp x y `mappend` go xs ys + go [] (_:_) = LT + go (_:_) [] = GT + go [] [] = EQ ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29058cc86dcd537032c1e425b760c98a16ef968b...c720b42c7c679c913bdb197d44ef4b5e92ff9e15 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29058cc86dcd537032c1e425b760c98a16ef968b...c720b42c7c679c913bdb197d44ef4b5e92ff9e15 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 23:26:08 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 11 May 2023 19:26:08 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] More Message-ID: <645d79908dc11_26a806bcd18151166@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 064080f9 by Simon Peyton Jones at 2023-05-12T00:25:49+01:00 More - - - - - 8 changed files: - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Tc.Solver.Types import GHC.Hs.Type( HsIPName(..) ) -import GHC.Builtin.Names ( coercibleTyConKey, heqTyConKey, eqTyConKey, ipClassKey ) +import GHC.Builtin.Names ( coercibleTyConKey, heqTyConKey, eqTyConKey ) import GHC.Core import GHC.Core.Type @@ -56,7 +56,7 @@ import Data.Maybe ( listToMaybe, mapMaybe, isJust ) import Control.Monad.Trans.Maybe( MaybeT, runMaybeT ) import Control.Monad.Trans.Class( lift ) -import Control.Monad( mzero ) +import Control.Monad( mzero, when ) {- ********************************************************************* @@ -65,36 +65,45 @@ import Control.Monad( mzero ) * * ********************************************************************* -} -solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage Ct +solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage () -- NC: this comes from CNonCanonical or CIrredCan -- Precondition: already rewritten by inert set solveDictNC ev cls tys - = do { dict_ct <- Stage $ canDictCt ev cls tys + = do { dict_ct <- simpleStage (canDictCt ev cls tys) ; solveDict dict_ct } -solveDict :: DictCt -> SolverStage Ct +solveDict :: DictCt -> SolverStage () -- Preconditions: `tys` are already rewritten by the inert set -solveDict dict_ct@(DictCt { di_ev = ev, di_class = cls, di_tyargs = tys }) +solveDict dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = tys }) = assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ do { tryInertDicts dict_ct ; tryInstances dict_ct ; tryFunDeps dict_ct ; tryLastResortProhibitedSuperClass dict_ct - ; return (CDictCan dict_ct) } + ; simpleStage (updInertDicts dict_ct) + ; Stage (stopWith (dictCtEvidence dict_ct) "Kept inert DictCt") } -canDictCt :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue DictCt) +updInertDicts :: DictCt -> TcS () +updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev }) + = do { -- See [Kick out existing binding for implicit parameter] + ; when (isGiven ev && isIPClass cls) $ + updInertCans (updDicts (delIPDict dict_ct)) + + -- Add the new constraint to the inert set + ; updInertCans (updDicts (addDict dict_ct)) } + +canDictCt :: CtEvidence -> Class -> [Type] -> TcS DictCt -- Once-only processing of Dict constraints: -- * expand superclasses -- * deal with CallStack --- After this we have a (CDictCan (DictCt ..)) canDictCt ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] = do { dflags <- getDynFlags ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork (listToBag sc_cts) - ; continueWith (DictCt { di_ev = ev, di_class = cls - , di_tyargs = tys, di_pend_sc = doNotExpand }) } + ; return (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = doNotExpand }) } -- doNotExpand: We have already expanded superclasses for /this/ dict -- so set the fuel to doNotExpand to avoid repeating expansion @@ -122,8 +131,8 @@ canDictCt ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; continueWith (DictCt { di_ev = new_ev, di_class = cls - , di_tyargs = tys, di_pend_sc = doNotExpand }) } + ; return (DictCt { di_ev = new_ev, di_cls = cls + , di_tys = tys, di_pend_sc = doNotExpand }) } -- doNotExpand: No superclasses for class CallStack -- See invariants in CDictCan.cc_pend_sc @@ -132,8 +141,8 @@ canDictCt ev cls tys ; let fuel | classHasSCs cls = wantedsFuel dflags | otherwise = doNotExpand -- See Invariants in `CCDictCan.cc_pend_sc` - ; continueWith (DictCt { di_ev = ev, di_class = cls - , di_tyargs = tys, di_pend_sc = fuel }) } + ; return (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = fuel }) } where loc = ctEvLoc ev orig = ctLocOrigin loc @@ -150,6 +159,22 @@ solveCallStack ev ev_cs ; setEvBindIfWanted ev IsCoherent ev_tm } +{- Note [Kick out existing binding for implicit parameter] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have (typecheck/should_compile/ImplicitParamFDs) + flub :: (?x :: Int) => (Int, Integer) + flub = (?x, let ?x = 5 in ?x) +When we are checking the last ?x occurrence, we guess its type +to be a fresh unification variable alpha and emit an (IP "x" alpha) +constraint. But the given (?x :: Int) has been translated to an +IP "x" Int constraint, which has a functional dependency from the +name to the type. So fundep interaction tells us that alpha ~ Int, +and we get a type error. This is bad. + +Instead, we wish to excise any old given for an IP when adding a +new one. +-} + {- ****************************************************************************** * * interactDict @@ -431,7 +456,7 @@ tryInertDicts dict_ct ; try_inert_dicts inerts dict_ct } try_inert_dicts :: InertCans -> DictCt -> TcS (StopOrContinue ()) -try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs = tys }) +try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys }) | Just dict_i <- lookupInertDict inerts (ctEvLoc ev_w) cls tys , let ev_i = dictCtEvidence dict_i loc_i = ctEvLoc ev_i @@ -461,12 +486,14 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_class = cls, di_tyargs ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) ; setEvBindIfWanted ev_i IsCoherent (ctEvTerm ev_w) - ; updInertDicts $ \ ds -> delDict ds cls tys + ; updInertCans (updDicts $ delDict dict_w) ; continueWith () } } } +{- | cls `hasKey` ipClassKey , isGiven ev_w = interactGivenIP inerts dict_w +-} | otherwise = continueWith () @@ -478,31 +505,31 @@ shortCutSolver :: DynFlags -> TcS Bool -- True <=> success shortCutSolver dflags ev_w ev_i | isWanted ev_w - && isGiven ev_i - -- We are about to solve a [W] constraint from a [G] constraint. We take - -- a moment to see if we can get a better solution using an instance. - -- Note that we only do this for the sake of performance. Exactly the same - -- programs should typecheck regardless of whether we take this step or - -- not. See Note [Shortcut solving] + , isGiven ev_i + -- We are about to solve a [W] constraint from a [G] constraint. We take + -- a moment to see if we can get a better solution using an instance. + -- Note that we only do this for the sake of performance. Exactly the same + -- programs should typecheck regardless of whether we take this step or + -- not. See Note [Shortcut solving] - && not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627) + , not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627) - && not (xopt LangExt.IncoherentInstances dflags) - -- If IncoherentInstances is on then we cannot rely on coherence of proofs - -- in order to justify this optimization: The proof provided by the - -- [G] constraint's superclass may be different from the top-level proof. - -- See Note [Shortcut solving: incoherence] + , not (xopt LangExt.IncoherentInstances dflags) + -- If IncoherentInstances is on then we cannot rely on coherence of proofs + -- in order to justify this optimization: The proof provided by the + -- [G] constraint's superclass may be different from the top-level proof. + -- See Note [Shortcut solving: incoherence] - && gopt Opt_SolveConstantDicts dflags - -- Enabled by the -fsolve-constant-dicts flag + , gopt Opt_SolveConstantDicts dflags + -- Enabled by the -fsolve-constant-dicts flag = do { ev_binds_var <- getTcEvBindsVar ; ev_binds <- assertPpr (not (isCoEvBindsVar ev_binds_var )) (ppr ev_w) $ getTcEvBindsMap ev_binds_var ; solved_dicts <- getSolvedDicts - ; mb_stuff <- runMaybeT $ try_solve_from_instance - (ev_binds, solved_dicts) ev_w + ; mb_stuff <- runMaybeT $ + try_solve_from_instance (ev_binds, solved_dicts) ev_w ; case mb_stuff of Nothing -> return False @@ -524,7 +551,6 @@ shortCutSolver dflags ev_w ev_i -> MaybeT TcS (EvBindMap, DictMap CtEvidence) try_solve_from_instance (ev_binds, solved_dicts) ev | let pred = ctEvPred ev - loc = ctEvLoc ev , ClassPred cls tys <- classifyPredType pred = do { inst_res <- lift $ matchGlobalInst dflags True cls tys ; case inst_res of @@ -534,13 +560,13 @@ shortCutSolver dflags ev_w ev_i , cir_what = what } | safeOverlap what , all isTyFamFree preds -- Note [Shortcut solving: type families] - -> do { let solved_dicts' = addDict solved_dicts cls tys ev + -> do { let solved_dicts' = addSolvedDict cls tys ev solved_dicts -- solved_dicts': it is important that we add our goal -- to the cache before we solve! Otherwise we may end -- up in a loop while solving recursive dictionaries. ; lift $ traceTcS "shortCutSolver: found instance" (ppr preds) - ; loc' <- lift $ checkInstanceOK loc what pred + ; loc' <- lift $ checkInstanceOK (ctEvLoc ev) what pred ; lift $ checkReductionDepth loc' pred @@ -552,12 +578,13 @@ shortCutSolver dflags ev_w ev_i ev_binds' = extendEvBinds ev_binds $ mkWantedEvBind (ctEvEvId ev) coherence ev_tm - ; foldlM try_solve_from_instance - (ev_binds', solved_dicts') - (freshGoals evc_vs) } + ; foldlM try_solve_from_instance (ev_binds', solved_dicts') $ + freshGoals evc_vs } _ -> mzero } - | otherwise = mzero + + | otherwise + = mzero -- Use a local cache of solved dicts while emitting EvVars for new work @@ -580,12 +607,13 @@ shortCutSolver dflags ev_w ev_i ********************************************************************** -} -interactGivenIP :: InertCans -> DictCt -> TcS (StopOrContinue a) +{- +interactGivenIP :: InertCans -> DictCt -> TcS (StopOrContinue ()) -- Work item is Given (?x:ty) -- See Note [Shadowing of Implicit Parameters] -interactGivenIP inerts workItem@(DictCt { di_ev = ev, di_class = cls - , di_tyargs = tys }) - = do { updInertCans $ \cans -> cans { inert_dicts = addDict filtered_dicts cls tys workItem } +interactGivenIP inerts workItem@(DictCt { di_ev = ev, di_cls = cls + , di_tys = tys }) + = do { updInertCans $ \cans -> cans { inert_dicts = addDict workItem filtered_dicts } ; stopWith ev "Given IP" } where dicts = inert_dicts inerts @@ -598,10 +626,10 @@ interactGivenIP inerts workItem@(DictCt { di_ev = ev, di_class = cls [] -> pprPanic "interactGivenIP" (ppr workItem) -- Pick out any Given constraints for the same implicit parameter - is_this_ip (DictCt { di_ev = ev, di_tyargs = ip_str':_ }) + is_this_ip (DictCt { di_ev = ev, di_tys = ip_str':_ }) = isGiven ev && ip_str `tcEqType` ip_str' is_this_ip _ = False - +-} {- Note [Shadowing of Implicit Parameters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following example: @@ -678,8 +706,8 @@ tryInstances dict_ct try_instances :: InertSet -> DictCt -> TcS (StopOrContinue ()) -- Try to use type-class instance declarations to simplify the constraint -try_instances inerts work_item@(DictCt { di_ev = ev, di_class = cls - , di_tyargs = xis }) +try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls + , di_tys = xis }) | isGiven ev -- Never use instances for Given constraints = continueWith () -- See Note [No Given/Given fundeps] @@ -694,7 +722,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_class = cls ; case lkup_res of OneInst { cir_what = what } -> do { insertSafeOverlapFailureTcS what work_item - ; addSolvedDict what ev cls xis + ; updSolvedDicts what work_item ; chooseInstance ev lkup_res } _ -> -- NoInstance or NotSure -- We didn't solve it; so try functional dependencies @@ -1199,7 +1227,7 @@ tryLastResortProhibitedSuperClass dict_ct ; last_resort inerts dict_ct } last_resort :: InertSet -> DictCt -> TcS (StopOrContinue ()) -last_resort inerts (DictCt { di_ev = ev_w, di_class = cls, di_tyargs = xis }) +last_resort inerts (DictCt { di_ev = ev_w, di_cls = cls, di_tys = xis }) | let loc_w = ctEvLoc ev_w orig_w = ctLocOrigin loc_w , ScOrigin _ NakedSc <- orig_w -- work_item is definitely Wanted @@ -1477,7 +1505,7 @@ tryFunDeps dict_ct doLocalFunDepImprovement :: DictCt -> TcS Bool -- Add wanted constraints from type-class functional dependencies. -doLocalFunDepImprovement (DictCt { di_ev = work_ev, di_class = cls }) +doLocalFunDepImprovement (DictCt { di_ev = work_ev, di_cls = cls }) = do { inerts <- getInertCans ; foldlM add_fds False (findDictsByClass (inert_dicts inerts) cls) } where @@ -1519,7 +1547,7 @@ doTopFunDepImprovement :: DictCt -> TcS Bool -- and the top-level instance declarations -- See Note [Fundeps with instances, and equality orientation] -- See also Note [Weird fundeps] -doTopFunDepImprovement work_item@(DictCt { di_ev = ev, di_class = cls, di_tyargs = xis }) +doTopFunDepImprovement work_item@(DictCt { di_ev = ev, di_cls = cls, di_tys = xis }) = do { traceTcS "try_fundeps" (ppr work_item) ; instEnvs <- getInstEnvs ; let fundep_eqns = improveFromInstEnv instEnvs mk_ct_loc cls xis @@ -1817,7 +1845,7 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan (DictCt { di_ev = ev, di_class = cls, di_tyargs = tys, di_pend_sc = fuel })) + go (CDictCan (DictCt { di_ev = ev, di_cls = cls, di_tys = tys, di_pend_sc = fuel })) = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always mkStrictSuperClasses fuel ev [] [] cls tys go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) @@ -1999,8 +2027,8 @@ mk_superclasses_of fuel rec_clss ev tvs theta cls tys rec_clss' = rec_clss `extendNameSet` cls_nm mk_this_ct :: ExpansionFuel -> Ct mk_this_ct fuel | null tvs, null theta - = CDictCan (DictCt { di_ev = ev, di_class = cls - , di_tyargs = tys, di_pend_sc = fuel }) + = CDictCan (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = fuel }) -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = fuel | otherwise ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -102,7 +102,7 @@ indeed they are! -} solveEquality :: CtEvidence -> EqRel -> Type -> Type - -> SolverStage Ct + -> SolverStage () solveEquality ev eq_rel ty1 ty2 = do { Pair ty1' ty2' <- zonkEqTypes ev eq_rel ty1 ty2 ; let ev' | debugIsOn = setCtEvPredType ev $ @@ -117,15 +117,21 @@ solveEquality ev eq_rel ty1 ty2 -- An IrredCt equality may be insoluble; but maybe not! -- E.g. m a ~R# m b is not canonical, but may be -- solved by a quantified constraint (T15290) - Left irred_ct -> do { tryInertIrreds irred_ct - ; tryQCsIrredEqCt irred_ct - ; return (CIrredCan irred_ct) } ; + Left irred_ct -> solveIrred irred_ct ; Right eq_ct -> do { tryInertEqs eq_ct ; tryFunDeps eq_ct ; tryQCsEqCt eq_ct - ; return (CEqCan eq_ct) } } } + ; simpleStage (updInertEqs eq_ct) } } } +updInertEqs :: EqCt -> TcS () +updInertEqs eq_ct@(EqCt { eq_lhs = lhs, eq_ev = ev, eq_eq_rel = eq_rel }) + = do { ics <- getInertCans + ; (_, ics') <- kickOutRewritable (ctEvFlavour ev, eq_rel) lhs ics + ; tclvl <- getTcLevel + ; updInertCans (updateGivenEqs tc_lvl (CEqCan eq_ct) . + addEqToCans eq_ct) + } {- ********************************************************************* @@ -294,9 +300,9 @@ canonicaliseEquality ev eq_rel ty1 ty2 vcat [ ppr ev, ppr eq_rel, ppr ty1, ppr ty2 ] ; rdr_env <- getGlobalRdrEnvTcS ; fam_insts <- getFamInstEnvs - ; can_eq_nc' False rdr_env fam_insts ev eq_rel ty1 ty1 ty2 ty2 } + ; can_eq_nc False rdr_env fam_insts ev eq_rel ty1 ty1 ty2 ty2 } -can_eq_nc' +can_eq_nc :: Bool -- True => both input types are rewritten -> GlobalRdrEnv -- needed to see which newtypes are in scope -> FamInstEnvs -- needed to unwrap data instances @@ -307,27 +313,27 @@ can_eq_nc' -> TcS (StopOrContinue (Either IrredCt EqCt)) -- See Note [Comparing nullary type synonyms] in GHC.Core.Type. -can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 +can_eq_nc _flat _rdr_env _envs ev eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 | tc1 == tc2 = canEqReflexive ev eq_rel ty1 -- Expand synonyms first; see Note [Type synonyms and canonicalization] -can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 - | Just ty1' <- coreView ty1 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 - | Just ty2' <- coreView ty2 = can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2' ps_ty2 +can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 + | Just ty1' <- coreView ty1 = can_eq_nc rewritten rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 + | Just ty2' <- coreView ty2 = can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2' ps_ty2 -- need to check for reflexivity in the ReprEq case. -- See Note [Eager reflexivity check] -- Check only when rewritten because the zonk_eq_types check in canEqNC takes -- care of the non-rewritten case. -can_eq_nc' True _rdr_env _envs ev ReprEq ty1 _ ty2 _ +can_eq_nc True _rdr_env _envs ev ReprEq ty1 _ ty2 _ | ty1 `tcEqType` ty2 = canEqReflexive ev ReprEq ty1 -- When working with ReprEq, unwrap newtypes. -- See Note [Unwrap newtypes first] -- This must be above the TyVarTy case, in order to guarantee (TyEq:N) -can_eq_nc' _rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 +can_eq_nc _rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | ReprEq <- eq_rel , Just stuff1 <- tcTopNormaliseNewTypeTF_maybe envs rdr_env ty1 = can_eq_newtype_nc rdr_env envs ev NotSwapped ty1 stuff1 ty2 ps_ty2 @@ -337,10 +343,10 @@ can_eq_nc' _rewritten rdr_env envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 = can_eq_newtype_nc rdr_env envs ev IsSwapped ty2 stuff2 ty1 ps_ty1 -- Then, get rid of casts -can_eq_nc' rewritten rdr_env envs ev eq_rel (CastTy ty1 co1) _ ty2 ps_ty2 +can_eq_nc rewritten rdr_env envs ev eq_rel (CastTy ty1 co1) _ ty2 ps_ty2 | isNothing (canEqLHS_maybe ty2) -- See (W3) in Note [Equalities with incompatible kinds] = canEqCast rewritten rdr_env envs ev eq_rel NotSwapped ty1 co1 ty2 ps_ty2 -can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ +can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ | isNothing (canEqLHS_maybe ty1) -- See (W3) in Note [Equalities with incompatible kinds] = canEqCast rewritten rdr_env envs ev eq_rel IsSwapped ty2 co2 ty1 ps_ty1 @@ -349,14 +355,14 @@ can_eq_nc' rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ ---------------------- -- Literals -can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ +can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ | l1 == l2 = do { setEvBindIfWanted ev IsCoherent (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) ; stopWith ev "Equal LitTy" } -- Decompose FunTy: (s -> t) and (c => t) -- NB: don't decompose (Int -> blah) ~ (Show a => blah) -can_eq_nc' _rewritten _rdr_env _envs ev eq_rel +can_eq_nc _rewritten _rdr_env _envs ev eq_rel (FunTy { ft_mult = am1, ft_af = af1, ft_arg = ty1a, ft_res = ty1b }) _ps_ty1 (FunTy { ft_mult = am2, ft_af = af2, ft_arg = ty2a, ft_res = ty2b }) _ps_ty2 | af1 == af2 -- See Note [Decomposing FunTy] @@ -364,7 +370,7 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel -- Decompose type constructor applications -- NB: we have expanded type synonyms already -can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ +can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ | Just (tc1, tys1) <- tcSplitTyConApp_maybe ty1 , Just (tc2, tys2) <- tcSplitTyConApp_maybe ty2 -- we want to catch e.g. Maybe Int ~ (Int -> Int) here for better @@ -374,7 +380,7 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ , not (isTypeFamilyTyCon tc2) = canTyConApp ev eq_rel tc1 tys1 tc2 tys2 -can_eq_nc' _rewritten _rdr_env _envs ev eq_rel +can_eq_nc _rewritten _rdr_env _envs ev eq_rel s1@(ForAllTy (Bndr _ vis1) _) _ s2@(ForAllTy (Bndr _ vis2) _) _ | vis1 `eqForAllVis` vis2 -- Note [ForAllTy and type equality] @@ -384,7 +390,7 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel -- Use tcSplitAppTy, not matching on AppTy, to catch oversaturated type families -- NB: Only decompose AppTy for nominal equality. -- See Note [Decomposing AppTy equalities] -can_eq_nc' True _rdr_env _envs ev NomEq ty1 _ ty2 _ +can_eq_nc True _rdr_env _envs ev NomEq ty1 _ ty2 _ | Just (t1, s1) <- tcSplitAppTy_maybe ty1 , Just (t2, s2) <- tcSplitAppTy_maybe ty2 = can_eq_app ev t1 s1 t2 s2 @@ -394,13 +400,13 @@ can_eq_nc' True _rdr_env _envs ev NomEq ty1 _ ty2 _ ------------------- -- No similarity in type structure detected. Rewrite and try again. -can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 +can_eq_nc False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 = -- Rewrite the two types and try again do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1 ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2 ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 ; traceTcS "can_eq_nc: go round again" (ppr new_ev $$ ppr xi1 $$ ppr xi2) - ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } + ; can_eq_nc True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } ---------------------------- -- Look for a canonical LHS. @@ -410,7 +416,8 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 -- NB: pattern match on True: we want only rewritten types sent to canEqLHS -- This means we've rewritten any variables and reduced any type family redexes -- See also Note [No top-level newtypes on RHS of representational equalities] -can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 + +can_eq_nc True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 | Just can_eq_lhs1 <- canEqLHS_maybe ty1 = do { traceTcS "can_eq1" (ppr ty1 $$ ppr ty2) ; canEqCanLHS ev eq_rel NotSwapped can_eq_lhs1 ps_ty1 ty2 ps_ty2 } @@ -425,15 +432,15 @@ can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 -- _both_ sides of the equality are AppTy-like... but if one side is -- AppTy-like and the other isn't (and it also isn't a variable or -- saturated type family application, both of which are handled by - -- can_eq_nc'), we're in a failure mode and can just fall through. + -- can_eq_nc), we're in a failure mode and can just fall through. ---------------------------- -- Fall-through. Give up. ---------------------------- -- We've rewritten and the types don't match. Give up. -can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 - = do { traceTcS "can_eq_nc' catch-all case" (ppr ps_ty1 $$ ppr ps_ty2) +can_eq_nc True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 + = do { traceTcS "can_eq_nc catch-all case" (ppr ps_ty1 $$ ppr ps_ty2) ; case eq_rel of -- See Note [Unsolved equalities] ReprEq -> finishCanWithIrred ReprEqReason ev NomEq -> finishCanWithIrred ShapeMismatchReason ev } @@ -665,7 +672,7 @@ can_eq_newtype_nc rdr_env envs ev swapped ty1 ((gres, co1), ty1') ty2 ps_ty2 ; new_ev <- rewriteEqEvidence emptyRewriterSet ev' swapped redn1 (mkReflRedn Representational ps_ty2) - ; can_eq_nc' False rdr_env envs new_ev ReprEq ty1' ty1' ty2 ps_ty2 } + ; can_eq_nc False rdr_env envs new_ev ReprEq ty1' ty1' ty2 ps_ty2 } --------- -- ^ Decompose a type application. @@ -742,7 +749,7 @@ canEqCast rewritten rdr_env envs ev eq_rel swapped ty1 co1 ty2 ps_ty2 ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped (mkGReflLeftRedn role ty1 co1) (mkReflRedn role ps_ty2) - ; can_eq_nc' rewritten rdr_env envs new_ev eq_rel ty1 ty1 ty2 ps_ty2 } + ; can_eq_nc rewritten rdr_env envs new_ev eq_rel ty1 ty1 ty2 ps_ty2 } where role = eqRelRole eq_rel @@ -1029,7 +1036,7 @@ There are two ways in which decomposing (N ty1) ~r (N ty2) could be incomplete: which is unsatisfiable. Unwrapping, though, leads to a solution. Conclusion: always unwrap newtypes before attempting to decompose - them. This is done in can_eq_nc'. Of course, we can't unwrap if the data + them. This is done in can_eq_nc. Of course, we can't unwrap if the data constructor isn't in scope. See Note [Unwrap newtypes first]. * Incompleteness example (EX2): available Givens @@ -1205,7 +1212,7 @@ and all will be well. See also Note [Unwrap newtypes first]. Bottom line: * Always decompose AppTy at nominal role: can_eq_app * Never decompose AppTy at representational role (neither Given nor Wanted): - the lack of an equation in can_eq_nc' + the lack of an equation in can_eq_nc Extra points {1} Decomposing a Given AppTy over a representational role is simply @@ -1734,7 +1741,7 @@ canEqCanLHSFinish, canEqCanLHSFinish_try_unification, -- preserved as much as possible -- Guaranteed preconditions that -- (TyEq:K) handled in canEqCanLHSHomo - -- (TyEq:N) checked in can_eq_nc' + -- (TyEq:N) checked in can_eq_nc -- (TyEq:TV) handled in canEqCanLHS2 --------------------------- @@ -1903,7 +1910,7 @@ canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs ---------------------- swapAndFinish :: CtEvidence -> EqRel -> SwapFlag -> TcType -> CanEqLHS -- ty ~ F tys - -> TcS (StopOrContinue (Either IrredCt EqCt)) + -> TcS (StopOrContinue (Either unused EqCt)) -- We have an equality alpha ~ F tys, that we can't unify e.g because 'tys' -- mentions alpha, it would not be a canonical constraint as-is. -- We want to flip it to (F tys ~ a), whereupon it is canonical @@ -1917,8 +1924,9 @@ swapAndFinish ev eq_rel swapped lhs_ty can_rhs , eq_lhs = can_rhs, eq_rhs = lhs_ty } } ---------------------- -tryIrredInstead :: CheckTyEqResult -> CtEvidence -> EqRel -> SwapFlag - -> CanEqLHS -> TcType -> TcS (StopOrContinue (Either IrredCt a)) +tryIrredInstead :: CheckTyEqResult -> CtEvidence + -> EqRel -> SwapFlag -> CanEqLHS -> TcType + -> TcS (StopOrContinue (Either IrredCt unused)) -- We have a non-canonical equality -- We still swap it if 'swapped' says so, so that it is oriented -- in the direction that the error-reporting machinery @@ -2033,7 +2041,7 @@ Wrinkles: And this is an improvement regardless: because tyvars can, generally, unify with casted types, there's no reason to go through the work of stripping off the cast when the cast appears opposite a tyvar. This is - implemented in the cast case of can_eq_nc'. + implemented in the cast case of can_eq_nc. Historical note: ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -17,9 +17,8 @@ module GHC.Tc.Solver.InertSet ( -- * The inert set InertSet(..), InertCans(..), - InertEqs, emptyInert, - addInertItem, + addInertItem, addInertDict, noMatchableGivenDicts, noGivenNewtypeReprEqs, @@ -27,12 +26,17 @@ module GHC.Tc.Solver.InertSet ( prohibitedSuperClassSolve, -- * Inert equalities + InertEqs, foldTyEqs, delEq, findEq, partitionInertEqs, partitionFunEqs, - foldFunEqs, + foldFunEqs, addEqToCans, + + -- * Inert Dicts + updDicts, delDict, delIPDict, addDict, filterDicts, partitionDicts, + addSolvedDict, -- * Inert Irreds - InertIrreds, delIrred, extendIrreds, foldIrreds, + InertIrreds, delIrred, addIrreds, addIrred, foldIrreds, findMatchingIrreds, -- * Kick-out @@ -66,6 +70,7 @@ import GHC.Core.TyCo.FVs import qualified GHC.Core.TyCo.Rep as Rep import GHC.Core.Class( Class ) import GHC.Core.TyCon +import GHC.Core.Class( classTyCon ) import GHC.Core.Unify import GHC.Utils.Misc ( partitionWith ) @@ -305,8 +310,8 @@ data InertSet -- (We have no way of "kicking out" from the cache, so putting -- wanteds here means we can end up solving a Wanted with itself. Bad) - , inert_solved_dicts :: DictMap CtEvidence - -- All Wanteds, of form ev :: C t1 .. tn + , inert_solved_dicts :: DictMap CtEvidence + -- All Wanteds, of form (C t1 .. tn) -- See Note [Solved dictionaries] -- and Note [Do not add superclasses of solved dictionaries] } @@ -1203,6 +1208,13 @@ instance Outputable InertCans where emptyTyEqs :: InertEqs emptyTyEqs = emptyDVarEnv +addEqToCans :: EqCt -> InertCans -> InertCans +addEqToCans eq_ct@(EqCt { eq_lhs = lhs }) + ics@(IC { inert_funeqs = funeqs, inert_eqs = eqs }) + = case lhs of + TyFamLHS tc tys -> ics { inert_funeqs = addCanFunEq funeqs tc tys eq_ct } + TyVarLHS tv -> ics { inert_eqs = addTyEq eqs tv eq_ct } + addTyEq :: InertEqs -> TcTyVar -> EqCt -> InertEqs addTyEq old_eqs tv ct = extendDVarEnv_C add_eq old_eqs tv [ct] @@ -1216,8 +1228,8 @@ foldTyEqs k eqs z findTyEqs :: InertCans -> TyVar -> [EqCt] findTyEqs icans tv = concat @Maybe (lookupDVarEnv (inert_eqs icans) tv) -delEq :: InertCans -> EqCt -> InertCans -delEq ic (EqCt { eq_lhs = lhs, eq_rhs = rhs }) = case lhs of +delEq :: EqCt -> InertCans -> InertCans +delEq (EqCt { eq_lhs = lhs, eq_rhs = rhs }) ic = case lhs of TyVarLHS tv -> ic { inert_eqs = alterDVarEnv upd (inert_eqs ic) tv } TyFamLHS tf args @@ -1286,23 +1298,78 @@ extendFunEqs fun_eqs eq_ct@(EqCt { eq_lhs = TyFamLHS tc args }) extendFunEqs _ other = pprPanic "extendFunEqs" (ppr other) + +{- ********************************************************************* +* * + Inert Dicts +* * +********************************************************************* -} + +updDicts :: (DictMap DictCt -> DictMap DictCt) -> InertCans -> InertCans +updDicts upd ics = ics { inert_dicts = upd (inert_dicts ics) } + +delDict :: DictCt -> DictMap a -> DictMap a +delDict (DictCt { di_cls = cls, di_tys = tys }) m + = delTcApp m (classTyCon cls) tys + +delIPDict :: DictCt -> DictMap DictCt -> DictMap DictCt +delIPDict (DictCt { di_cls = cls, di_tys = tys }) m + | [ip_str, _] <- tys + = assert (isIPClass cls) $ + filterDicts (doesn't_match ip_str) m + | otherwise + = m + where + doesn't_match :: TcType -> DictCt -> Bool + doesn't_match ip_str (DictCt { di_cls = cls, di_tys = tys }) + | isIPClass cls + , [ip_str', _] <- tys + = not (ip_str `eqType` ip_str') + | otherwise + = True + +addDict :: DictCt -> DictMap DictCt -> DictMap DictCt +addDict item@(DictCt { di_cls = cls, di_tys = tys }) dm + = insertTcApp dm (classTyCon cls) tys item + +addSolvedDict :: Class -> [Type] -> CtEvidence + -> DictMap CtEvidence -> DictMap CtEvidence +addSolvedDict cls tys ev dm + = insertTcApp dm (classTyCon cls) tys ev + +filterDicts :: (DictCt -> Bool) -> DictMap DictCt -> DictMap DictCt +filterDicts f m = filterTcAppMap f m + +partitionDicts :: (DictCt -> Bool) -> DictMap DictCt -> (Bag DictCt, DictMap DictCt) +partitionDicts f m = foldTcAppMap k m (emptyBag, emptyDictMap) + where + k ct (yeses, noes) | f ct = (ct `consBag` yeses, noes) + | otherwise = (yeses, addDict ct noes) + + {- ********************************************************************* * * Inert Irreds * * ********************************************************************* -} -extendIrreds :: [IrredCt] -> InertIrreds -> InertIrreds -extendIrreds extras irreds +addIrreds :: [IrredCt] -> InertIrreds -> InertIrreds +addIrreds extras irreds | null extras = irreds | otherwise = irreds `unionBags` listToBag extras -delIrred :: InertCans -> IrredCt -> InertCans +addIrred :: IrredCt -> InertIrreds -> InertIrreds +addIrred extra irreds = irreds `snocBag` extra + +updIrreds :: (InertIrreds -> InertIrreds) -> InertCans -> InertCans +updIrreds upd ics = ics { inert_irreds = upd (inert_irreds ics) } + +delIrred :: IrredCt -> InertCans -> InertCans -- Remove a particular (Given) Irred, on the instructions of a plugin -- For some reason this is done vis the evidence Id, not the type -- Compare delEq. I have not idea why -delIrred ics (IrredCt { ir_ev = ev }) - = ics { inert_irreds = filterBag keep (inert_irreds ics) } +delIrred (IrredCt { ir_ev = ev }) ics + = updIrreds (filterBag keep) ics where ev_id = ctEvEvId ev keep (IrredCt { ir_ev = ev' }) = ev_id == ctEvEvId ev' @@ -1374,13 +1441,15 @@ addInertItem tc_lvl ics@(IC { inert_irreds = irreds }) ct@(CIrredCan irred) -- equality, so we play safe ics { inert_irreds = irreds `snocBag` irred } -addInertItem _ ics (CDictCan dict@(DictCt { di_class = cls, di_tyargs = tys })) - = ics { inert_dicts = addDict (inert_dicts ics) cls tys dict } +addInertItem _ ics (CDictCan dict_ct) = addInertDict dict_ct ics addInertItem _ _ item = pprPanic "upd_inert set: can't happen! Inserting " $ ppr item -- Can't be CNonCanonical because they only land in inert_irreds +addInertDict :: DictCt -> InertCans -> InertCans +addInertDict dict ics = ics { inert_dicts = addDict dict (inert_dicts ics) } + updateGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans -- Set the inert_given_eq_level to the current level (tclvl) -- if the constraint is a given equality that should prevent ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -3,7 +3,7 @@ {-# LANGUAGE RecursiveDo #-} module GHC.Tc.Solver.Irred( - solveIrred, tryInertIrreds, tryQCsIrredCt + solveIrred ) where import GHC.Prelude @@ -31,11 +31,20 @@ import GHC.Data.Bag * * ********************************************************************* -} -solveIrred :: IrredCt -> SolverStage Ct +solveIrred :: IrredCt -> SolverStage () solveIrred irred = do { tryInertIrreds irred ; tryQCsIrredCt irred - ; return (CIrredCan irred) } + ; simpleStage (updInertIrreds irred) } + + +updInertIrreds :: IrredCt -> TcS () +updInertIrreds irred + = do { tc_lvl <- getTcLevel + ; updInertCans $ (updateGivenEqs tc_lvl (CIrredCan irred) . + updIrreds (addIrred irred)) + ; traceFireTcS (irredCtEvidence irred) + (text "Added Irred to inert set") } {- ********************************************************************* * * @@ -73,7 +82,7 @@ try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) - ; updInertIrreds (\_ -> others) + ; updInertCans (updIrreds (\_ -> others)) ; continueWith () } } | otherwise ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -32,8 +32,8 @@ module GHC.Tc.Solver.Monad ( QCInst(..), -- The pipeline - StopOrContinue(..), continueWith, stopWith, andWhenContinue, - startAgainWith, SolverStage(Stage, runSolverStage), + StopOrContinue(..), continueWith, stopWith, + startAgainWith, SolverStage(Stage, runSolverStage), simpleStage, -- Tracing etc panicTcS, traceTcS, @@ -64,7 +64,7 @@ module GHC.Tc.Solver.Monad ( -- Inerts - updInertTcS, updInertCans, updInertDicts, updInertIrreds, + updInertTcS, updInertCans, getHasGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, getInertInsols, getInnermostGivenEqLevel, @@ -83,7 +83,7 @@ module GHC.Tc.Solver.Monad ( getSafeOverlapFailures, -- Inert solved dictionaries - addSolvedDict, lookupSolvedDict, + updSolvedDicts, lookupSolvedDict, -- Irreds foldIrreds, @@ -239,6 +239,10 @@ instance Monad SolverStage where Stop ev d -> return (Stop ev d) ContinueWith x -> runSolverStage (k x) } +simpleStage :: TcS a -> SolverStage a +-- Always does a ContinueWith; no Stop or StartAgain +simpleStage thing = Stage (do { res <- thing; continueWith res }) + startAgainWith :: Ct -> TcS (StopOrContinue a) startAgainWith ct = return (StartAgain ct) @@ -248,16 +252,6 @@ continueWith ct = return (ContinueWith ct) stopWith :: CtEvidence -> String -> TcS (StopOrContinue a) stopWith ev s = return (Stop ev (text s)) -andWhenContinue :: TcS (StopOrContinue a) - -> (a -> TcS (StopOrContinue a)) - -> TcS (StopOrContinue a) -andWhenContinue tcs1 tcs2 - = do { r <- tcs1 - ; case r of - ContinueWith ct -> tcs2 ct - _ -> return r } -infixr 0 `andWhenContinue` -- allow chaining with ($) - {- ********************************************************************* * * @@ -329,22 +323,6 @@ When adding an equality to the inerts: * Note that unifying a:=ty, is like adding [G] a~ty; just use kickOutRewritable with Nominal, Given. See kickOutAfterUnification. -Note [Kick out existing binding for implicit parameter] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have (typecheck/should_compile/ImplicitParamFDs) - flub :: (?x :: Int) => (Int, Integer) - flub = (?x, let ?x = 5 in ?x) -When we are checking the last ?x occurrence, we guess its type -to be a fresh unification variable alpha and emit an (IP "x" alpha) -constraint. But the given (?x :: Int) has been translated to an -IP "x" Int constraint, which has a functional dependency from the -name to the type. So fundep interaction tells us that alpha ~ Int, -and we get a type error. This is bad. - -Instead, we wish to excise any old given for an IP when adding a -new one. We also must make sure not to float out -any IP constraints outside an implication that binds an IP of -the same name; see GHC.Tc.Solver.floatConstraints. -} addInertCan :: Ct -> TcS () @@ -369,26 +347,6 @@ maybeKickOut ics ct = do { (_, ics') <- kickOutRewritable (ctEvFlavour ev, eq_rel) lhs ics ; return ics' } - -- See [Kick out existing binding for implicit parameter] - | isGivenCt ct - , CDictCan (DictCt { di_class = cls, di_tyargs = [ip_name_strty, _ip_ty] }) <- ct - , isIPClass cls - , Just ip_name <- isStrLitTy ip_name_strty - -- Would this be more efficient if we used findDictsByClass and then delDict? - = let dict_map = inert_dicts ics - dict_map' = filterDicts doesn't_match_ip_name dict_map - - doesn't_match_ip_name :: DictCt -> Bool - doesn't_match_ip_name (DictCt { di_class = cls, di_tyargs = tys }) - | Just (inert_ip_name, _inert_ip_ty) <- isIPPred_maybe cls tys - = inert_ip_name /= ip_name - - | otherwise - = True - - in - return (ics { inert_dicts = dict_map' }) - | otherwise = return ics @@ -479,8 +437,8 @@ kickOutAfterFillingCoercionHole hole -------------- addInertSafehask :: InertCans -> DictCt -> InertCans -addInertSafehask ics item@(DictCt { di_class = cls, di_tyargs = tys }) - = ics { inert_safehask = addDict (inert_dicts ics) cls tys item } +addInertSafehask ics item + = ics { inert_safehask = addDict item (inert_dicts ics) } insertSafeOverlapFailureTcS :: InstanceWhat -> DictCt -> TcS () -- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver @@ -495,15 +453,15 @@ getSafeOverlapFailures ; return $ foldDicts consBag safehask emptyBag } -------------- -addSolvedDict :: InstanceWhat -> CtEvidence -> Class -> [Type] -> TcS () +updSolvedDicts :: InstanceWhat -> DictCt -> TcS () -- Conditionally add a new item in the solved set of the monad -- See Note [Solved dictionaries] in GHC.Tc.Solver.InertSet -addSolvedDict what item cls tys - | isWanted item +updSolvedDicts what dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = tys }) + | isWanted ev , instanceReturnsDictCon what - = do { traceTcS "updSolvedSetTcs:" $ ppr item + = do { traceTcS "updSolvedDicts:" $ ppr dict_ct ; updInertTcS $ \ ics -> - ics { inert_solved_dicts = addDict (inert_solved_dicts ics) cls tys item } } + ics { inert_solved_dicts = addSolvedDict cls tys ev (inert_solved_dicts ics) } } | otherwise = return () @@ -548,21 +506,11 @@ updInertCans :: (InertCans -> InertCans) -> TcS () updInertCans upd_fn = updInertTcS $ \ inerts -> inerts { inert_cans = upd_fn (inert_cans inerts) } -updInertDicts :: (DictMap DictCt -> DictMap DictCt) -> TcS () --- Modify the inert set with the supplied function -updInertDicts upd_fn - = updInertCans $ \ ics -> ics { inert_dicts = upd_fn (inert_dicts ics) } - updInertSafehask :: (DictMap DictCt -> DictMap DictCt) -> TcS () -- Modify the inert set with the supplied function updInertSafehask upd_fn = updInertCans $ \ ics -> ics { inert_safehask = upd_fn (inert_safehask ics) } -updInertIrreds :: (Bag IrredCt -> Bag IrredCt) -> TcS () --- Modify the inert set with the supplied function -updInertIrreds upd_fn - = updInertCans $ \ ics -> ics { inert_irreds = upd_fn (inert_irreds ics) } - getInertEqs :: TcS InertEqs getInertEqs = do { inert <- getInertCans; return (inert_eqs inert) } @@ -629,10 +577,9 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts exhaustAndAdd :: DictCt -> DictMap DictCt -> DictMap DictCt - exhaustAndAdd ct@(DictCt { di_class = cls, di_tyargs = tys }) dicts - -- exhaust the fuel for this constraint before adding it as + exhaustAndAdd ct dicts = addDict (ct {di_pend_sc = doNotExpand}) dicts + -- Exhaust the fuel for this constraint before adding it as -- we don't want to expand these constraints again - = addDict dicts cls tys (ct {di_pend_sc = doNotExpand}) get_pending :: DictCt -> [DictCt] -> [DictCt] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts @@ -739,11 +686,9 @@ removeInertCt :: InertCans -> Ct -> InertCans removeInertCt is ct = case ct of - CDictCan (DictCt { di_class = cl, di_tyargs = tys }) -> - is { inert_dicts = delDict (inert_dicts is) cl tys } - - CEqCan eq_ct -> delEq is eq_ct - CIrredCan ir_ct -> delIrred is ir_ct + CDictCan dict_ct -> is { inert_dicts = delDict dict_ct (inert_dicts is) } + CEqCan eq_ct -> delEq eq_ct is + CIrredCan ir_ct -> delIrred ir_ct is CQuantCan {} -> panic "removeInertCt: CQuantCan" CNonCanonical {} -> panic "removeInertCt: CNonCanonical" @@ -792,9 +737,7 @@ lookupInertDict (IC { inert_dicts = dicts }) loc cls tys lookupSolvedDict :: InertSet -> CtLoc -> Class -> [Type] -> Maybe CtEvidence -- Returns just if exactly this predicate type exists in the solved. lookupSolvedDict (IS { inert_solved_dicts = solved }) loc cls tys - = case findDict solved loc cls tys of - Just ev -> Just ev - _ -> Nothing + = findDict solved loc cls tys --------------------------- lookupFamAppCache :: TyCon -> [Type] -> TcS (Maybe Reduction) ===================================== compiler/GHC/Tc/Solver/Types.hs ===================================== @@ -4,17 +4,17 @@ -- | Utility types used within the constraint solver module GHC.Tc.Solver.Types ( -- Inert CDictCans - DictMap, emptyDictMap, addDict, + DictMap, emptyDictMap, findDictsByTyConKey, findDictsByClass, - addDictsByClass, delDict, foldDicts, filterDicts, findDict, - dictsToBag, partitionDicts, + foldDicts, findDict, + dictsToBag, FunEqMap, emptyFunEqs, findFunEq, insertFunEq, findFunEqsByTyCon, TcAppMap, emptyTcAppMap, isEmptyTcAppMap, insertTcApp, alterTcApp, filterTcAppMap, - tcAppMapToBag, foldTcAppMap, + tcAppMapToBag, foldTcAppMap, delTcApp, EqualCtList, filterEqualCtList, addToEqualCtList @@ -151,28 +151,6 @@ findDictsByTyConKey m tc | Just tm <- lookupUDFM_Directly m tc = foldTM consBag tm emptyBag | otherwise = emptyBag -delDict :: DictMap a -> Class -> [Type] -> DictMap a -delDict m cls tys = delTcApp m (classTyCon cls) tys - -addDict :: DictMap a -> Class -> [Type] -> a -> DictMap a -addDict m cls tys item = insertTcApp m (classTyCon cls) tys item - -addDictsByClass :: DictMap DictCt -> Class -> Bag DictCt -> DictMap DictCt -addDictsByClass m cls items - = extendDTyConEnv m (classTyCon cls) (foldr add emptyTM items) - where - add ct@(DictCt { di_tyargs = tys }) tm = insertTM tys ct tm - -filterDicts :: (DictCt -> Bool) -> DictMap DictCt -> DictMap DictCt -filterDicts f m = filterTcAppMap f m - -partitionDicts :: (DictCt -> Bool) -> DictMap DictCt -> (Bag DictCt, DictMap DictCt) -partitionDicts f m = foldTcAppMap k m (emptyBag, emptyDictMap) - where - k ct (yeses, noes) | f ct = (ct `consBag` yeses, noes) - | otherwise = (yeses, add ct noes) - add ct@(DictCt { di_class = cls, di_tyargs = tys }) m = addDict m cls tys ct - dictsToBag :: DictMap a -> Bag a dictsToBag = tcAppMapToBag ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -196,25 +196,24 @@ assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFue data Ct = CDictCan DictCt - | CNonCanonical CtEvidence -- See Note [NonCanonical Semantics] in GHC.Tc.Solver.Monad | CIrredCan IrredCt -- A "irreducible" constraint (non-canonical) | CEqCan EqCt -- A canonical equality constraint | CQuantCan QCInst -- A quantified constraint - + | CNonCanonical CtEvidence -- See Note [NonCanonical Semantics] in GHC.Tc.Solver.Monad --------------- DictCt -------------- data DictCt -- e.g. Num ty - = DictCt { di_ev :: CtEvidence -- See Note [Ct/evidence invariant] + = DictCt { di_ev :: CtEvidence -- See Note [Ct/evidence invariant] - , di_class :: Class - , di_tyargs :: [Xi] -- di_tyargs are rewritten w.r.t. inerts, so Xi + , di_cls :: Class + , di_tys :: [Xi] -- di_tys are rewritten w.r.t. inerts, so Xi , di_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Dict -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver -- Invariants: di_pend_sc > 0 <=> - -- (a) di_class has superclasses + -- (a) di_cls has superclasses -- (b) those superclasses are not yet explored } @@ -650,7 +649,7 @@ Note [Ct/evidence invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If ct :: Ct, then extra fields of 'ct' cache precisely the ctev_pred field of (cc_ev ct), and is fully rewritten wrt the substitution. Eg for DictCt, - ctev_pred (di_ev ct) = (di_class ct) (di_tyargs ct) + ctev_pred (di_ev ct) = (di_cls ct) (di_tys ct) This holds by construction; look at the unique place where DictCt is built (in GHC.Tc.Solver.Dict.canDictNC). @@ -1065,8 +1064,8 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) might_help_ct ct = not (is_ip ct) - is_ip (CDictCan (DictCt { di_class = cls })) = isIPClass cls - is_ip _ = False + is_ip (CDictCan (DictCt { di_cls = cls })) = isIPClass cls + is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) -- in the return values [Ct] has original fuel while Cts has fuel exhausted ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -2455,10 +2455,10 @@ reduced. -} zonkCt :: Ct -> TcM Ct -- See Note [zonkCt behaviour] -zonkCt (CDictCan dict@(DictCt { di_ev = ev, di_tyargs = args })) +zonkCt (CDictCan dict@(DictCt { di_ev = ev, di_tys = args })) = do { ev' <- zonkCtEvidence ev ; args' <- mapM zonkTcType args - ; return (CDictCan (dict { di_ev = ev', di_tyargs = args' })) } + ; return (CDictCan (dict { di_ev = ev', di_tys = args' })) } zonkCt (CEqCan (EqCt { eq_ev = ev })) = mkNonCanonical <$> zonkCtEvidence ev View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/064080f90fde3135209d8fdfb7f848e0abe84082 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/064080f90fde3135209d8fdfb7f848e0abe84082 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 11 23:31:34 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 11 May 2023 19:31:34 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Add GHC.Tc.Solver.Solve Message-ID: <645d7ad64fde1_26a806be0f0151463@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 7ff41eb2 by Simon Peyton Jones at 2023-05-12T00:31:12+01:00 Add GHC.Tc.Solver.Solve - - - - - 1 changed file: - + compiler/GHC/Tc/Solver/Solve.hs Changes: ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -0,0 +1,693 @@ +{-# LANGUAGE RecursiveDo #-} + +module GHC.Tc.Solver.Solve ( + solveSimpleGivens, -- Solves [Ct] + solveSimpleWanteds -- Solves Cts + ) where + +import GHC.Prelude + +import GHC.Tc.Solver.Dict +import GHC.Tc.Solver.Equality( solveEquality ) +import GHC.Tc.Solver.Irred( solveIrred ) +import GHC.Tc.Solver.Rewrite( rewrite ) +import GHC.Tc.Errors.Types +import GHC.Tc.Utils.TcType +import GHC.Tc.Types.Evidence +import GHC.Tc.Types +import GHC.Tc.Types.Origin +import GHC.Tc.Types.Constraint +import GHC.Tc.Solver.InertSet +import GHC.Tc.Solver.Monad + +import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.Predicate +import GHC.Core.Reduction +import GHC.Core.Coercion +import GHC.Core.Class( classHasSCs ) + +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic ( IntWithInf, intGtLimit ) + +import GHC.Data.Bag + +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Misc + +import GHC.Driver.Session + +import Data.List( deleteFirstsBy ) + +import Control.Monad +import Data.Semigroup as S + +{- +********************************************************************** +* * +* Main Solver * +* * +********************************************************************** + +Note [Basic Simplifier Plan] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +1. Pick an element from the WorkList if there exists one with depth + less than our context-stack depth. + +2. Run it down the 'stage' pipeline. Stages are: + - canonicalization + - inert reactions + - spontaneous reactions + - top-level interactions + Each stage returns a StopOrContinue and may have sideeffected + the inerts or worklist. + + The threading of the stages is as follows: + - If (Stop) is returned by a stage then we start again from Step 1. + - If (ContinueWith ct) is returned by a stage, we feed 'ct' on to + the next stage in the pipeline. +4. If the element has survived (i.e. ContinueWith x) the last stage + then we add it in the inerts and jump back to Step 1. + +If in Step 1 no such element exists, we have exceeded our context-stack +depth and will simply fail. +-} + +solveSimpleGivens :: [Ct] -> TcS () +solveSimpleGivens givens + | null givens -- Shortcut for common case + = return () + | otherwise + = do { traceTcS "solveSimpleGivens {" (ppr givens) + ; go givens + ; traceTcS "End solveSimpleGivens }" empty } + where + go givens = do { solveSimples (listToBag givens) + ; new_givens <- runTcPluginsGiven + ; when (notNull new_givens) $ + go new_givens } + +solveSimpleWanteds :: Cts -> TcS WantedConstraints +-- The result is not necessarily zonked +solveSimpleWanteds simples + = do { traceTcS "solveSimpleWanteds {" (ppr simples) + ; dflags <- getDynFlags + ; (n,wc) <- go 1 (solverIterations dflags) (emptyWC { wc_simple = simples }) + ; traceTcS "solveSimpleWanteds end }" $ + vcat [ text "iterations =" <+> ppr n + , text "residual =" <+> ppr wc ] + ; return wc } + where + go :: Int -> IntWithInf -> WantedConstraints -> TcS (Int, WantedConstraints) + go n limit wc + | n `intGtLimit` limit + = failTcS $ TcRnSimplifierTooManyIterations simples limit wc + | isEmptyBag (wc_simple wc) + = return (n,wc) + + | otherwise + = do { -- Solve + wc1 <- solve_simple_wanteds wc + + -- Run plugins + ; (rerun_plugin, wc2) <- runTcPluginsWanted wc1 + + ; if rerun_plugin + then do { traceTcS "solveSimple going round again:" (ppr rerun_plugin) + ; go (n+1) limit wc2 } -- Loop + else return (n, wc2) } -- Done + + +solve_simple_wanteds :: WantedConstraints -> TcS WantedConstraints +-- Try solving these constraints +-- Affects the unification state (of course) but not the inert set +-- The result is not necessarily zonked +solve_simple_wanteds (WC { wc_simple = simples1, wc_impl = implics1, wc_errors = errs }) + = nestTcS $ + do { solveSimples simples1 + ; (implics2, unsolved) <- getUnsolvedInerts + ; return (WC { wc_simple = unsolved + , wc_impl = implics1 `unionBags` implics2 + , wc_errors = errs }) } + +{- Note [The solveSimpleWanteds loop] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Solving a bunch of simple constraints is done in a loop, +(the 'go' loop of 'solveSimpleWanteds'): + 1. Try to solve them + 2. Try the plugin + 3. If the plugin wants to run again, go back to step 1 +-} + +-- The main solver loop implements Note [Basic Simplifier Plan] +--------------------------------------------------------------- +solveSimples :: Cts -> TcS () +-- Returns the final InertSet in TcS +-- Has no effect on work-list or residual-implications +-- The constraints are initially examined in left-to-right order + +solveSimples cts + = {-# SCC "solveSimples" #-} + do { emitWork cts; solve_loop } + where + solve_loop + = {-# SCC "solve_loop" #-} + do { sel <- selectNextWorkItem + ; case sel of + Nothing -> return () + Just ct -> do { runSolverPipeline ct + ; solve_loop } } + +runSolverPipeline :: Ct -> TcS () +-- Run this item down the pipeline, leaving behind new work and inerts +runSolverPipeline workItem + = do { wl <- getWorkList + ; inerts <- getTcSInerts + ; tclevel <- getTcLevel + ; traceTcS "----------------------------- " empty + ; traceTcS "Start solver pipeline {" $ + vcat [ text "tclevel =" <+> ppr tclevel + , text "work item =" <+> ppr workItem + , text "inerts =" <+> ppr inerts + , text "rest of worklist =" <+> ppr wl ] + + ; bumpStepCountTcS -- One step for each constraint processed + ; solve workItem } + where + solve :: Ct -> TcS () + solve ct + = do { traceTcS "solve {" (text "workitem = " <+> ppr ct) + ; res <- runSolverStage (solveCt ct) + ; traceTcS "end solve }" (ppr res) + ; case res of + StartAgain ct -> do { traceTcS "Go round again" (ppr ct) + ; solve ct } + + Stop ev s -> do { traceFireTcS ev s + ; traceTcS "End solver pipeline }" empty + ; return () } + + ContinueWith {} -> pprPanic "Pipeline finished without solving" (ppr ct) } + +{- +************************************************************************ +* * +* Solving one constraint: solveCt +* * +************************************************************************ + +Note [Canonicalization] +~~~~~~~~~~~~~~~~~~~~~~~ + +Canonicalization converts a simple constraint to a canonical form. It is +unary (i.e. treats individual constraints one at a time). + +Constraints originating from user-written code come into being as +CNonCanonicals. We know nothing about these constraints. So, first: + + Classify CNonCanoncal constraints, depending on whether they + are equalities, class predicates, or other. + +Then proceed depending on the shape of the constraint. Generally speaking, +each constraint gets rewritten and then decomposed into one of several forms +(see type Ct in GHC.Tc.Types). + +When an already-canonicalized constraint gets kicked out of the inert set, +it must be recanonicalized. But we know a bit about its shape from the +last time through, so we can skip the classification step. + +-} + +solveCt :: Ct -> SolverStage () +solveCt (CNonCanonical ev) = solveNC ev +solveCt (CIrredCan (IrredCt { ir_ev = ev })) = solveNC ev + +solveCt (CEqCan (EqCt { eq_ev = ev, eq_eq_rel = eq_rel + , eq_lhs = lhs, eq_rhs = rhs })) + = solveEquality ev eq_rel (canEqLHSType lhs) rhs + +solveCt (CQuantCan (QCI { qci_ev = ev, qci_pend_sc = pend_sc })) + = do { ev <- rewriteEvidence ev + ; case classifyPredType (ctEvPred ev) of + ForAllPred tvs th p -> Stage $ solveForAll ev tvs th p pend_sc + _ -> pprPanic "SolveCt" (ppr ev) } + +solveCt (CDictCan (DictCt { di_ev = ev, di_pend_sc = pend_sc })) + = do { ev <- rewriteEvidence ev + ; case classifyPredType (ctEvPred ev) of + ClassPred cls tys + -> solveDict (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = pend_sc }) + _ -> pprPanic "solveCt" (ppr ev) } + +------------------ +solveNC :: CtEvidence -> SolverStage () +solveNC ev + = -- Instead of rewriting the evidence before classifying, it's possible we + -- can make progress without the rewrite. Try this first. + -- For insolubles (all of which are equalities), do /not/ rewrite the arguments + -- In #14350 doing so led entire-unnecessary and ridiculously large + -- type function expansion. Instead, canEqNC just applies + -- the substitution to the predicate, and may do decomposition; + -- e.g. a ~ [a], where [G] a ~ [Int], can decompose + case classifyPredType (ctEvPred ev) of { + EqPred eq_rel ty1 ty2 -> solveEquality ev eq_rel ty1 ty2 ; + _ -> + + -- Do rewriting on the constraint, especially zonking + do { ev <- rewriteEvidence ev + ; let irred = IrredCt { ir_ev = ev, ir_reason = IrredShapeReason } + + -- And then re-classify + ; case classifyPredType (ctEvPred ev) of + ClassPred cls tys -> solveDictNC ev cls tys + ForAllPred tvs th p -> Stage $ solveForAllNC ev tvs th p + IrredPred {} -> solveIrred irred + EqPred eq_rel ty1 ty2 -> solveEquality ev eq_rel ty1 ty2 + -- This case only happens if (say) `c` is unified with `a ~# b`, + -- but that is rare becuase it requires c :: CONSTRAINT UnliftedRep + + }} + + +{- ********************************************************************* +* * +* Quantified constraints +* * +********************************************************************* -} + +{- Note [Quantified constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The -XQuantifiedConstraints extension allows type-class contexts like this: + + data Rose f x = Rose x (f (Rose f x)) + + instance (Eq a, forall b. Eq b => Eq (f b)) + => Eq (Rose f a) where + (Rose x1 rs1) == (Rose x2 rs2) = x1==x2 && rs1 == rs2 + +Note the (forall b. Eq b => Eq (f b)) in the instance contexts. +This quantified constraint is needed to solve the + [W] (Eq (f (Rose f x))) +constraint which arises form the (==) definition. + +The wiki page is + https://gitlab.haskell.org/ghc/ghc/wikis/quantified-constraints +which in turn contains a link to the GHC Proposal where the change +is specified, and a Haskell Symposium paper about it. + +We implement two main extensions to the design in the paper: + + 1. We allow a variable in the instance head, e.g. + f :: forall m a. (forall b. m b) => D (m a) + Notice the 'm' in the head of the quantified constraint, not + a class. + + 2. We support superclasses to quantified constraints. + For example (contrived): + f :: (Ord b, forall b. Ord b => Ord (m b)) => m a -> m a -> Bool + f x y = x==y + Here we need (Eq (m a)); but the quantified constraint deals only + with Ord. But we can make it work by using its superclass. + +Here are the moving parts + * Language extension {-# LANGUAGE QuantifiedConstraints #-} + and add it to ghc-boot-th:GHC.LanguageExtensions.Type.Extension + + * A new form of evidence, EvDFun, that is used to discharge + such wanted constraints + + * checkValidType gets some changes to accept forall-constraints + only in the right places. + + * Predicate.Pred gets a new constructor ForAllPred, and + and classifyPredType analyses a PredType to decompose + the new forall-constraints + + * GHC.Tc.Solver.Monad.InertCans gets an extra field, inert_insts, + which holds all the Given forall-constraints. In effect, + such Given constraints are like local instance decls. + + * When trying to solve a class constraint, via + GHC.Tc.Solver.Instance.Class.matchInstEnv, use the InstEnv from inert_insts + so that we include the local Given forall-constraints + in the lookup. (See GHC.Tc.Solver.Monad.getInstEnvs.) + + * `solveForAll` deals with solving a forall-constraint. See + Note [Solving a Wanted forall-constraint] + + * We augment the kick-out code to kick out an inert + forall constraint if it can be rewritten by a new + type equality; see GHC.Tc.Solver.Monad.kick_out_rewritable + +Note that a quantified constraint is never /inferred/ +(by GHC.Tc.Solver.simplifyInfer). A function can only have a +quantified constraint in its type if it is given an explicit +type signature. + +-} + +solveForAllNC :: CtEvidence -> [TcTyVar] -> TcThetaType -> TcPredType + -> TcS (StopOrContinue ()) +-- NC: this came from CNonCanonical, so we have not yet expanded superclasses +-- Precondition: already rewritten by inert set +solveForAllNC ev tvs theta pred + | isGiven ev -- See Note [Eagerly expand given superclasses] + , Just (cls, tys) <- cls_pred_tys_maybe + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + ; emitWork (listToBag sc_cts) + ; solveForAll ev tvs theta pred doNotExpand } + -- doNotExpand: as we have already (eagerly) expanded superclasses for this class + + | otherwise + = do { dflags <- getDynFlags + ; let fuel | Just (cls, _) <- cls_pred_tys_maybe + , classHasSCs cls = qcsFuel dflags + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + | otherwise = doNotExpand + ; solveForAll ev tvs theta pred fuel } + where + cls_pred_tys_maybe = getClassPredTys_maybe pred + +solveForAll :: CtEvidence -> [TcTyVar] -> TcThetaType -> PredType -> ExpansionFuel + -> TcS (StopOrContinue ()) +-- Precondition: already rewritten by inert set +solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) + tvs theta pred _fuel + = -- See Note [Solving a Wanted forall-constraint] + setLclEnv (ctLocEnv loc) $ + -- This setLclEnv is important: the emitImplicationTcS uses that + -- TcLclEnv for the implication, and that in turn sets the location + -- for the Givens when solving the constraint (#21006) + do { let empty_subst = mkEmptySubst $ mkInScopeSet $ + tyCoVarsOfTypes (pred:theta) `delVarSetList` tvs + is_qc = IsQC (ctLocOrigin loc) + + -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] + -- in GHC.Tc.Utils.TcType + -- Very like the code in tcSkolDFunType + ; rec { skol_info <- mkSkolemInfo skol_info_anon + ; (subst, skol_tvs) <- tcInstSkolTyVarsX skol_info empty_subst tvs + ; let inst_pred = substTy subst pred + inst_theta = substTheta subst theta + skol_info_anon = InstSkol is_qc (get_size inst_pred) } + + ; given_ev_vars <- mapM newEvVar inst_theta + ; (lvl, (w_id, wanteds)) + <- pushLevelNoWorkList (ppr skol_info) $ + do { let loc' = setCtLocOrigin loc (ScOrigin is_qc NakedSc) + -- Set the thing to prove to have a ScOrigin, so we are + -- careful about its termination checks. + -- See (QC-INV) in Note [Solving a Wanted forall-constraint] + ; wanted_ev <- newWantedEvVarNC loc' rewriters inst_pred + ; return ( ctEvEvId wanted_ev + , unitBag (mkNonCanonical wanted_ev)) } + + ; ev_binds <- emitImplicationTcS lvl (getSkolemInfo skol_info) skol_tvs + given_ev_vars wanteds + + ; setWantedEvTerm dest IsCoherent $ + EvFun { et_tvs = skol_tvs, et_given = given_ev_vars + , et_binds = ev_binds, et_body = w_id } + + ; stopWith ev "Wanted forall-constraint" } + where + -- Getting the size of the head is a bit horrible + -- because of the special treament for class predicates + get_size pred = case classifyPredType pred of + ClassPred cls tys -> pSizeClassPred cls tys + _ -> pSizeType pred + + -- See Note [Solving a Given forall-constraint] +solveForAll ev@(CtGiven {}) tvs _theta pred fuel + = do { addInertForAll qci + ; stopWith ev "Given forall-constraint" } + where + qci = QCI { qci_ev = ev, qci_tvs = tvs + , qci_pred = pred, qci_pend_sc = fuel } + +{- Note [Solving a Wanted forall-constraint] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Solving a wanted forall (quantified) constraint + [W] df :: forall ab. (Eq a, Ord b) => C x a b +is delightfully easy. Just build an implication constraint + forall ab. (g1::Eq a, g2::Ord b) => [W] d :: C x a +and discharge df thus: + df = /\ab. \g1 g2. let in d +where is filled in by solving the implication constraint. +All the machinery is to hand; there is little to do. + +The tricky point is about termination: see #19690. We want to maintain +the invariant (QC-INV): + + (QC-INV) Every quantified constraint returns a non-bottom dictionary + +just as every top-level instance declaration guarantees to return a non-bottom +dictionary. But as #19690 shows, it is possible to get a bottom dicionary +by superclass selection if we aren't careful. The situation is very similar +to that described in Note [Recursive superclasses] in GHC.Tc.TyCl.Instance; +and we use the same solution: + +* Give the Givens a CtOrigin of (GivenOrigin (InstSkol IsQC head_size)) +* Give the Wanted a CtOrigin of (ScOrigin IsQC NakedSc) + +Both of these things are done in solveForAll. Now the mechanism described +in Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance takes over. + +Note [Solving a Given forall-constraint] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For a Given constraint + [G] df :: forall ab. (Eq a, Ord b) => C x a b +we just add it to TcS's local InstEnv of known instances, +via addInertForall. Then, if we look up (C x Int Bool), say, +we'll find a match in the InstEnv. + + +************************************************************************ +* * + Evidence transformation +* * +************************************************************************ +-} + +rewriteEvidence :: CtEvidence -> SolverStage CtEvidence +-- (rewriteEvidence old_ev new_pred co do_next) +-- Main purpose: create new evidence for new_pred; +-- unless new_pred is cached already +-- * Calls do_next with (new_ev :: new_pred), with same wanted/given flag as old_ev +-- * If old_ev was wanted, create a binding for old_ev, in terms of new_ev +-- * If old_ev was given, AND not cached, create a binding for new_ev, in terms of old_ev +-- * Stops if new_ev is already cached +-- +-- Old evidence New predicate is Return new evidence +-- flavour of same flavor +-- ------------------------------------------------------------------- +-- Wanted Already solved or in inert Stop +-- Not do_next new_evidence +-- +-- Given Already in inert Stop +-- Not do_next new_evidence + +{- Note [Rewriting with Refl] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the coercion is just reflexivity then you may re-use the same +evidence variable. But be careful! Although the coercion is Refl, new_pred +may reflect the result of unification alpha := ty, so new_pred might +not _look_ the same as old_pred, and it's vital to proceed from now on +using new_pred. + +The rewriter preserves type synonyms, so they should appear in new_pred +as well as in old_pred; that is important for good error messages. + +If we are rewriting with Refl, then there are no new rewriters to add to +the rewriter set. We check this with an assertion. + -} + + +rewriteEvidence ev + = Stage $ do { traceTcS "rewriteEvidence" (ppr ev) + ; (redn, rewriters) <- rewrite ev (ctEvPred ev) + ; finish_rewrite ev redn rewriters } + +finish_rewrite :: CtEvidence -- ^ old evidence + -> Reduction -- ^ new predicate + coercion, of type ~ new predicate + -> RewriterSet -- ^ See Note [Wanteds rewrite Wanteds] + -- in GHC.Tc.Types.Constraint + -> TcS (StopOrContinue CtEvidence) +finish_rewrite old_ev (Reduction co new_pred) rewriters + | isReflCo co -- See Note [Rewriting with Refl] + = assert (isEmptyRewriterSet rewriters) $ + continueWith (setCtEvPredType old_ev new_pred) + +finish_rewrite ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) + (Reduction co new_pred) rewriters + = assert (isEmptyRewriterSet rewriters) $ -- this is a Given, not a wanted + do { new_ev <- newGivenEvVar loc (new_pred, new_tm) + ; continueWith new_ev } + where + -- mkEvCast optimises ReflCo + new_tm = mkEvCast (evId old_evar) + (downgradeRole Representational (ctEvRole ev) co) + +finish_rewrite ev@(CtWanted { ctev_dest = dest + , ctev_loc = loc + , ctev_rewriters = rewriters }) + (Reduction co new_pred) new_rewriters + = do { mb_new_ev <- newWanted loc rewriters' new_pred + ; massert (coercionRole co == ctEvRole ev) + ; setWantedEvTerm dest IsCoherent $ + mkEvCast (getEvExpr mb_new_ev) + (downgradeRole Representational (ctEvRole ev) (mkSymCo co)) + ; case mb_new_ev of + Fresh new_ev -> continueWith new_ev + Cached _ -> stopWith ev "Cached wanted" } + where + rewriters' = rewriters S.<> new_rewriters + +{- ******************************************************************* +* * +* Typechecker plugins +* * +******************************************************************* -} + +-- | Extract the (inert) givens and invoke the plugins on them. +-- Remove solved givens from the inert set and emit insolubles, but +-- return new work produced so that 'solveSimpleGivens' can feed it back +-- into the main solver. +runTcPluginsGiven :: TcS [Ct] +runTcPluginsGiven + = do { solvers <- getTcPluginSolvers + ; if null solvers then return [] else + do { givens <- getInertGivens + ; if null givens then return [] else + do { p <- runTcPluginSolvers solvers (givens,[]) + ; let (solved_givens, _) = pluginSolvedCts p + insols = map (ctIrredCt PluginReason) (pluginBadCts p) + ; updInertCans (removeInertCts solved_givens) + ; updInertIrreds (addIrreds insols) + ; return (pluginNewCts p) } } } + +-- | Given a bag of (rewritten, zonked) wanteds, invoke the plugins on +-- them and produce an updated bag of wanteds (possibly with some new +-- work) and a bag of insolubles. The boolean indicates whether +-- 'solveSimpleWanteds' should feed the updated wanteds back into the +-- main solver. +runTcPluginsWanted :: WantedConstraints -> TcS (Bool, WantedConstraints) +runTcPluginsWanted wc@(WC { wc_simple = simples1 }) + | isEmptyBag simples1 + = return (False, wc) + | otherwise + = do { solvers <- getTcPluginSolvers + ; if null solvers then return (False, wc) else + + do { given <- getInertGivens + ; wanted <- zonkSimples simples1 -- Plugin requires zonked inputs + ; p <- runTcPluginSolvers solvers (given, bagToList wanted) + ; let (_, solved_wanted) = pluginSolvedCts p + (_, unsolved_wanted) = pluginInputCts p + new_wanted = pluginNewCts p + insols = pluginBadCts p + +-- SLPJ: I'm deeply suspicious of this +-- ; updInertCans (removeInertCts $ solved_givens) + + ; mapM_ setEv solved_wanted + ; return ( notNull (pluginNewCts p) + , wc { wc_simple = listToBag new_wanted `andCts` + listToBag unsolved_wanted `andCts` + listToBag insols } ) } } + where + setEv :: (EvTerm,Ct) -> TcS () + setEv (ev,ct) = case ctEvidence ct of + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest IsCoherent ev -- TODO: plugins should be able to signal non-coherence + _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" + +-- | A pair of (given, wanted) constraints to pass to plugins +type SplitCts = ([Ct], [Ct]) + +-- | A solved pair of constraints, with evidence for wanteds +type SolvedCts = ([Ct], [(EvTerm,Ct)]) + +-- | Represents collections of constraints generated by typechecker +-- plugins +data TcPluginProgress = TcPluginProgress + { pluginInputCts :: SplitCts + -- ^ Original inputs to the plugins with solved/bad constraints + -- removed, but otherwise unmodified + , pluginSolvedCts :: SolvedCts + -- ^ Constraints solved by plugins + , pluginBadCts :: [Ct] + -- ^ Constraints reported as insoluble by plugins + , pluginNewCts :: [Ct] + -- ^ New constraints emitted by plugins + } + +getTcPluginSolvers :: TcS [TcPluginSolver] +getTcPluginSolvers + = do { tcg_env <- getGblEnv; return (tcg_tc_plugin_solvers tcg_env) } + +-- | Starting from a pair of (given, wanted) constraints, +-- invoke each of the typechecker constraint-solving plugins in turn and return +-- +-- * the remaining unmodified constraints, +-- * constraints that have been solved, +-- * constraints that are insoluble, and +-- * new work. +-- +-- Note that new work generated by one plugin will not be seen by +-- other plugins on this pass (but the main constraint solver will be +-- re-invoked and they will see it later). There is no check that new +-- work differs from the original constraints supplied to the plugin: +-- the plugin itself should perform this check if necessary. +runTcPluginSolvers :: [TcPluginSolver] -> SplitCts -> TcS TcPluginProgress +runTcPluginSolvers solvers all_cts + = do { ev_binds_var <- getTcEvBindsVar + ; foldM (do_plugin ev_binds_var) initialProgress solvers } + where + do_plugin :: EvBindsVar -> TcPluginProgress -> TcPluginSolver -> TcS TcPluginProgress + do_plugin ev_binds_var p solver = do + result <- runTcPluginTcS (uncurry (solver ev_binds_var) (pluginInputCts p)) + return $ progress p result + + progress :: TcPluginProgress -> TcPluginSolveResult -> TcPluginProgress + progress p + (TcPluginSolveResult + { tcPluginInsolubleCts = bad_cts + , tcPluginSolvedCts = solved_cts + , tcPluginNewCts = new_cts + } + ) = + p { pluginInputCts = discard (bad_cts ++ map snd solved_cts) (pluginInputCts p) + , pluginSolvedCts = add solved_cts (pluginSolvedCts p) + , pluginNewCts = new_cts ++ pluginNewCts p + , pluginBadCts = bad_cts ++ pluginBadCts p + } + + initialProgress = TcPluginProgress all_cts ([], []) [] [] + + discard :: [Ct] -> SplitCts -> SplitCts + discard cts (xs, ys) = + (xs `without` cts, ys `without` cts) + + without :: [Ct] -> [Ct] -> [Ct] + without = deleteFirstsBy eq_ct + + eq_ct :: Ct -> Ct -> Bool + eq_ct c c' = ctFlavour c == ctFlavour c' + && ctPred c `tcEqType` ctPred c' + + add :: [(EvTerm,Ct)] -> SolvedCts -> SolvedCts + add xs scs = foldl' addOne scs xs + + addOne :: SolvedCts -> (EvTerm,Ct) -> SolvedCts + addOne (givens, wanteds) (ev,ct) = case ctEvidence ct of + CtGiven {} -> (ct:givens, wanteds) + CtWanted {} -> (givens, (ev,ct):wanteds) + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ff41eb237aa5df96f54f473df150a020f7a35fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ff41eb237aa5df96f54f473df150a020f7a35fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 03:08:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 23:08:45 -0400 Subject: [Git][ghc/ghc][master] JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <645dadbda67a9_26a806bf2341626f5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - 9 changed files: - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs Changes: ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,13 +6,15 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS , identsV , identsE -- * Saturation - , jsSaturate + , satJStat + , satJExpr -- * Generic traversal (via compos) , JMacro(..) , JMGadt(..) @@ -21,8 +23,6 @@ module GHC.JS.Transform , composOpM , composOpM_ , composOpFold - , satJExpr - , satJStat ) where @@ -33,11 +33,12 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) +import Data.List (sortBy) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique.Map +import GHC.Types.Unique.FM {-# INLINE identsS #-} @@ -205,69 +206,62 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) +satJStat :: Maybe FastString -> JStat -> Sat.JStat +satJStat str x = evalState (jsSaturateS x) (newIdentSupply str) + +satJExpr :: Maybe FastString -> JExpr -> Sat.JExpr +satJExpr str x = evalState (jsSaturateE x) (newIdentSupply str) + +jsSaturateS :: JStat -> State [Ident] Sat.JStat +jsSaturateS = \case + DeclStat i rhs -> Sat.DeclStat i <$> mapM jsSaturateE rhs + ReturnStat e -> Sat.ReturnStat <$> jsSaturateE e + IfStat c t e -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e + WhileStat is_do c e -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e + ForStat init p step body -> Sat.ForStat <$> jsSaturateS init <*> jsSaturateE p + <*> jsSaturateS step <*> jsSaturateS body + ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body + SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct + <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps + <*> jsSaturateS def + TryStat t i c f -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f + BlockStat bs -> fmap Sat.BlockStat $! mapM jsSaturateS bs + ApplStat rator rand -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand + UOpStat rator rand -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand + AssignStat lhs rhs -> Sat.AssignStat <$> jsSaturateE lhs <*> pure Sat.AssignOp <*> jsSaturateE rhs + LabelStat lbl stmt -> Sat.LabelStat lbl <$> jsSaturateS stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + FuncStat i args body -> Sat.FuncStat i args <$> jsSaturateS body + UnsatBlock us -> jsSaturateS =<< runIdentSupply us + +jsSaturateE :: JExpr -> State [Ident] Sat.JExpr +jsSaturateE = \case + ValExpr v -> Sat.ValExpr <$> jsSaturateV v + SelExpr obj i -> Sat.SelExpr <$> jsSaturateE obj <*> pure i + IdxExpr o i -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i + InfixExpr op l r -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r + UOpExpr op r -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r + IfExpr c t e -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e + ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands + UnsatExpr us -> jsSaturateE =<< runIdentSupply us + +jsSaturateV :: JVal -> State [Ident] Sat.JVal +jsSaturateV = \case + JVar i -> return $ Sat.JVar i + JList xs -> Sat.JList <$> mapM jsSaturateE xs + JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) + JInt i -> return $ Sat.JInt i + JStr s -> return $ Sat.JStr s + JRegEx f -> return $ Sat.JRegEx f + JHash m -> Sat.JHash <$> mapUniqMapM satHash m where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v - - --------------------------------------------------------------------------------- --- Translation --- --------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForStat init p step body) = Sat.ForStat - (witness init) (satJExpr p) - (witness step) (witness body) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) Sat.AssignOp (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness (FuncStat i args body) = Sat.FuncStat i args (witness body) - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - - -satJExpr :: JExpr -> Sat.JExpr -satJExpr = go - where - go (ValExpr v) = Sat.ValExpr (satJVal v) - go (SelExpr obj i) = Sat.SelExpr (satJExpr obj) i - go (IdxExpr o i) = Sat.IdxExpr (satJExpr o) (satJExpr i) - go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r) - go (UOpExpr op r) = Sat.UOpExpr (satJUOp op) (satJExpr r) - go (IfExpr c t e) = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e) - go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands) - go UnsatExpr{} = error "satJExpr: discovered an Unsat...impossibly" + satHash (i, x) = (i,) . (i,) <$> jsSaturateE x + compareHash (i,_) (j,_) = lexicalCompareFS i j + -- By lexically sorting the elements, the non-determinism introduced by nonDetEltsUFM is avoided + mapUniqMapM f (UniqMap m) = UniqMap . listToUFM <$> (mapM f . sortBy compareHash $ nonDetEltsUFM m) + JFunc args body -> Sat.JFunc args <$> jsSaturateS body + UnsatVal us -> jsSaturateV =<< runIdentSupply us satJOp :: JOp -> Sat.Op satJOp = go @@ -313,15 +307,3 @@ satJUOp = go go PreDecOp = Sat.PreDecOp go PostDecOp = Sat.PostDecOp -satJVal :: JVal -> Sat.JVal -satJVal = go - where - go (JVar i) = Sat.JVar i - go (JList xs) = Sat.JList (satJExpr <$> xs) - go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) - go (JInt i) = Sat.JInt i - go (JStr f) = Sat.JStr f - go (JRegEx f) = Sat.JRegEx f - go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) - go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,10 +134,9 @@ genUnits m ss spt_entries foreign_stubs = do glbl <- State.gets gsGlobal staticInit <- initStaticPtrs spt_entries - let stat = ( jsOptimize - . satJStat - . jsSaturate (Just $ modulePrefix m 1) - $ mconcat (reverse glbl) <> staticInit) + let stat = ( jsOptimize . + satJStat (Just $ modulePrefix m 1) + $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] let oi = ObjUnit { oiSymbols = syms @@ -210,8 +209,7 @@ genUnits m ss spt_entries foreign_stubs = do si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 let stat = jsOptimize - . satJStat - $ jsSaturate (Just $ modulePrefix m n) body + $ satJStat (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -249,8 +247,7 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = jsOptimize - . satJStat - . jsSaturate (Just $ modulePrefix m n) + . satJStat (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps let oi = ObjUnit @@ -339,7 +336,7 @@ genToplevelRhs i rhs = case rhs of eid@(TxtI eidt) <- identForEntryId i (TxtI idt) <- identForId i body <- genBody (initExprCtx i) R2 args body typ - global_occs <- globalOccs (jsSaturate (Just "ghcjs_tmp_sat_") body) + global_occs <- globalOccs (satJStat (Just "ghcjs_tmp_sat_") body) let lidents = map global_ident global_occs let lids = map global_id global_occs let lidents' = map identFS lidents ===================================== compiler/GHC/StgToJS/CoreUtils.hs ===================================== @@ -253,7 +253,7 @@ assocPrimReps (r:rs) vs = case (primRepSize r,vs) of (NoSlot, xs) -> (r,[]) : assocPrimReps rs xs (OneSlot, x:xs) -> (r,[x]) : assocPrimReps rs xs (TwoSlots, x:y:xs) -> (r,[x,y]) : assocPrimReps rs xs - err -> pprPanic "assocPrimReps" (ppr $ fmap (map satJExpr) $ err) + err -> pprPanic "assocPrimReps" (ppr $ map (satJExpr Nothing) <$> err) -- | Associate the given values to the Id's PrimReps, taking into account the -- number of slots per PrimRep ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -60,8 +60,8 @@ genCon ctx con args | xs <- concatMap typex_expr (ctxTarget ctx) = pprPanic "genCon: unhandled DataCon" (ppr (con - , fmap satJExpr args - , fmap satJExpr xs + , satJExpr Nothing <$> args + , satJExpr Nothing <$> xs )) -- | Allocate a data constructor. Allocate in this context means bind the data @@ -90,7 +90,7 @@ allocUnboxedCon con = \case | isBoolDataCon con && dataConTag con == 2 -> true_ [x] | isUnboxableCon con -> x - xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, fmap satJExpr xs)) + xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, satJExpr Nothing <$> xs)) -- | Allocate an entry function. See 'GHC.StgToJS.hs' for the object layout. allocDynamicE :: Bool -- ^ csInlineAlloc from StgToJSConfig ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -899,7 +899,7 @@ caseCond = \case DataAlt da -> return $ Just (toJExpr $ dataConTag da) LitAlt l -> genLit l >>= \case [e] -> pure (Just e) - es -> pprPanic "caseCond: expected single-variable literal" (ppr $ fmap satJExpr es) + es -> pprPanic "caseCond: expected single-variable literal" (ppr $ satJExpr Nothing <$> es) -- fixme use single tmp var for all branches -- | Load parameters from constructor ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,8 +177,8 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a -saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) +saturateFFI :: Int -> JStat -> Sat.JStat +saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack => ExprCtx ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -333,7 +333,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -31,6 +31,7 @@ import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform import GHC.JS.Optimizer +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,8 +299,8 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat -rtsDecls = jsSaturate (Just "h$RTSD") $ +rtsDecls :: Sat.JStat +rtsDecls = satJStat (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -314,15 +315,15 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . jsOptimize . satJStat . rts +rtsText = show . pretty . jsOptimize . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . jsOptimize . satJStat $ rtsDecls +rtsDeclsText = show . pretty . jsOptimize $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat -rts = jsSaturate (Just "h$RTS") . rts' +rts :: StgToJSConfig -> Sat.JStat +rts = satJStat (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ed493a3d8f13a80d98026a5ccfacd8cfe4ac182 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ed493a3d8f13a80d98026a5ccfacd8cfe4ac182 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 03:09:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 23:09:25 -0400 Subject: [Git][ghc/ghc][master] Doc: Fix out-of-sync using-optimisation page Message-ID: <645dade56356a_26a806aa3dfb816614e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - 1 changed file: - docs/users_guide/using-optimisation.rst Changes: ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -117,9 +117,9 @@ The easiest way to see what ``-O`` (etc.) “really mean” is to run with single: -fno-\* options (GHC) These flags turn on and off individual optimisations. Flags marked as -on by default are enabled by ``-O``, and as such you shouldn't -need to set any of them explicitly. A flag ``-fwombat`` can be negated -by saying ``-fno-wombat``. +*on* by default are enabled at all optimisation levels by default, and +as such you shouldn't need to set any of them explicitly. A flag +``-fwombat`` can be negated by saying ``-fno-wombat``. .. ghc-flag:: -fcore-constant-folding :shortdesc: Enable constant folding in Core. Implied by :ghc-flag:`-O`. @@ -127,7 +127,7 @@ by saying ``-fno-wombat``. :reverse: -fno-core-constant-folding :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables Core-level constant folding, i.e. propagation of values that can be computed at compile time. @@ -138,7 +138,7 @@ by saying ``-fno-wombat``. :reverse: -fno-case-merge :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Merge immediately-nested case expressions that scrutinise the same variable. For example, :: @@ -162,7 +162,7 @@ by saying ``-fno-wombat``. :reverse: -fno-case-folding :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Allow constant folding in case expressions that scrutinise some primops: For example, :: @@ -185,7 +185,7 @@ by saying ``-fno-wombat``. :reverse: -fno-call-arity :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enable call-arity analysis. @@ -195,7 +195,7 @@ by saying ``-fno-wombat``. :reverse: -fno-exitification :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the floating of exit paths out of recursive functions. @@ -205,7 +205,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cmm-elim-common-blocks :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the common block elimination optimisation in the code generator. This optimisation attempts to find identical @@ -217,7 +217,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cmm-sink :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the sinking pass in the code generator. This optimisation attempts to find identical Cmm blocks and @@ -231,7 +231,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cmm-static-pred :category: - :default: off but enabled with :ghc-flag:`-O`. + :default: off but enabled by :ghc-flag:`-O`. This enables static control flow prediction on the final Cmm code. If enabled GHC will apply certain heuristics to identify @@ -244,7 +244,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cmm-control-flow :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables some control flow optimisations in the Cmm code generator, merging basic blocks and avoiding jumps right after jumps. @@ -255,7 +255,7 @@ by saying ``-fno-wombat``. :reverse: -fno-asm-shortcutting :category: - :default: off + :default: off but enabled by :ghc-flag:`-O2`. This enables shortcutting at the assembly stage of the code generator. In simpler terms shortcutting means if a block of instructions A only consists @@ -268,12 +268,12 @@ by saying ``-fno-wombat``. does nothing on macOS. .. ghc-flag:: -fblock-layout-cfg - :shortdesc: Use the new cfg based block layout algorithm. + :shortdesc: Use the new cfg based block layout algorithm. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-block-layout-cfg :category: - :default: off but enabled with :ghc-flag:`-O`. + :default: off but enabled by :ghc-flag:`-O`. The new algorithm considers all outgoing edges of a basic blocks for code layout instead of only the last jump instruction. @@ -326,7 +326,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cpr-anal :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Turn on CPR analysis, which enables the worker/wrapper transformation (cf. :ghc-flag:`-fworker-wrapper`) to unbox the result of a function, such as :: @@ -386,7 +386,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cse :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the common-sub-expression elimination optimisation. Switching this off can be useful if you have some @@ -394,12 +394,12 @@ by saying ``-fno-wombat``. .. ghc-flag:: -fstg-cse :shortdesc: Enable common sub-expression elimination on the STG - intermediate language + intermediate language. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-stg-cse :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the common-sub-expression elimination optimisation on the STG intermediate language, where it is able to common up some subexpressions @@ -422,7 +422,7 @@ by saying ``-fno-wombat``. :reverse: -fno-dicts-strict :category: - :default: off + :default: off but enabled by :ghc-flag:`-O2`. Make dictionaries strict. @@ -447,7 +447,7 @@ by saying ``-fno-wombat``. Behaviour is unconditionally enabled starting with 9.2 .. ghc-flag:: -fdo-eta-reduction - :shortdesc: Enable eta-reduction. Implied by :ghc-flag:`-O`. + :shortdesc: Enable eta-reduction. Always enabled by default. :type: dynamic :reverse: -fno-do-eta-reduction :category: @@ -518,7 +518,7 @@ by saying ``-fno-wombat``. :reverse: -fno-float-in :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Float let-bindings inwards, nearer their binding site. See `Let-floating: moving bindings to give faster programs @@ -544,7 +544,7 @@ by saying ``-fno-wombat``. :reverse: -fno-full-laziness :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Run the full laziness optimisation (also known as let-floating), which floats let-bindings outside enclosing lambdas, @@ -591,7 +591,7 @@ by saying ``-fno-wombat``. :reverse: -fno-ignore-asserts :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Causes GHC to ignore uses of the function ``Exception.assert`` in source code (in other words, rewriting ``Exception.assert p e`` to ``e`` (see @@ -603,7 +603,7 @@ by saying ``-fno-wombat``. :reverse: -fno-ignore-interface-pragmas :category: - :default: off + :default: Implied by :ghc-flag:`-O0`, otherwise off. Tells GHC to ignore all inessential information when reading interface files. That is, even if :file:`M.hi` contains unfolding or @@ -632,7 +632,7 @@ by saying ``-fno-wombat``. :reverse: -fno-liberate-case :category: - :default: off but enabled with :ghc-flag:`-O2`. + :default: off but enabled by :ghc-flag:`-O2`. Turn on the liberate-case transformation. This unrolls recursive function once in its own RHS, to avoid repeated case analysis of free variables. It's @@ -657,7 +657,7 @@ by saying ``-fno-wombat``. :reverse: -fno-loopification :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. When this optimisation is enabled the code generator will turn all self-recursive saturated tail calls into local jumps rather than @@ -1074,7 +1074,7 @@ by saying ``-fno-wombat``. :reverse: -fno-specialise :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Specialise each type-class-overloaded function defined in this module for the types at which it is called in this @@ -1101,12 +1101,12 @@ by saying ``-fno-wombat``. .. ghc-flag:: -fcross-module-specialise :shortdesc: Turn on specialisation of overloaded functions imported from - other modules. + other modules. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-cross-module-specialise :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Specialise ``INLINABLE`` (:ref:`inlinable-pragma`) type-class-overloaded functions imported from other modules for the types at @@ -1136,7 +1136,7 @@ by saying ``-fno-wombat``. :reverse: -fno-inline-generics :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. :since: 9.2.1 .. index:: @@ -1175,12 +1175,12 @@ by saying ``-fno-wombat``. .. ghc-flag:: -fsolve-constant-dicts :shortdesc: When solving constraints, try to eagerly solve - super classes using available dictionaries. + super classes using available dictionaries. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-solve-constant-dicts :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. When solving constraints, try to eagerly solve super classes using available dictionaries. @@ -1229,7 +1229,7 @@ by saying ``-fno-wombat``. :reverse: -fno-stg-lift-lams :category: - :default: on + :default: off but enabled by :ghc-flag:`-O2`. Enables the late lambda lifting optimisation on the STG intermediate language. This selectively lifts local functions to @@ -1281,7 +1281,7 @@ by saying ``-fno-wombat``. :reverse: -fno-strictness :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Turn on demand analysis. @@ -1441,7 +1441,7 @@ by saying ``-fno-wombat``. :reverse: -fno-unbox-small-strict-fields :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. .. index:: single: strict constructor fields @@ -1654,10 +1654,13 @@ by saying ``-fno-wombat``. .. ghc-flag:: -fworker-wrapper - :shortdesc: Enable the worker/wrapper transformation. + :shortdesc: Enable the worker/wrapper transformation. Implied by :ghc-flag:`-O` + and by :ghc-flag:`-fstrictness`. :type: dynamic :category: + :default: off but enabled by :ghc-flag:`-O`. + Enable the worker/wrapper transformation after a demand analysis pass. Exploits strictness and absence information by unboxing strict arguments View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a856d98eb13401b78fa7eba9a54ea4c501ebb0a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a856d98eb13401b78fa7eba9a54ea4c501ebb0a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 03:40:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 11 May 2023 23:40:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <645db54a2bf4c_26a806ad15efc1718f9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - 3e6521f9 by sheaf at 2023-05-11T23:40:27-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - 1e71df74 by Krzysztof Gogolewski at 2023-05-11T23:40:39-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - 62706fd4 by Ben Gamari at 2023-05-11T23:40:40-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - 967f1758 by Bodigrim at 2023-05-11T23:40:42-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 29 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - docs/users_guide/debugging.rst - docs/users_guide/using-optimisation.rst - hadrian/bindist/Makefile - libraries/base/changelog.md - testsuite/driver/testlib.py - + testsuite/tests/simplCore/should_compile/T23267.hs - + testsuite/tests/simplCore/should_compile/T23267.script - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/simplCore/should_run/T23056.hs - + testsuite/tests/simplCore/should_run/T23056.script - + testsuite/tests/simplCore/should_run/T23056.stdout - testsuite/tests/simplCore/should_run/all.T - + testsuite/tests/typecheck/should_fail/T23308.hs - + testsuite/tests/typecheck/should_fail/T23308.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1505,7 +1505,7 @@ piResultTys ty orig_args@(arg:args) -- c.f. #15473 pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args) -applyTysX :: [TyVar] -> Type -> [Type] -> Type +applyTysX :: HasDebugCallStack => [TyVar] -> Type -> [Type] -> Type -- applyTysX beta-reduces (/\tvs. body_ty) arg_tys -- Assumes that (/\tvs. body_ty) is closed applyTysX tvs body_ty arg_tys ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -387,6 +387,7 @@ data GeneralFlag | Opt_KeepGoing | Opt_ByteCode | Opt_ByteCodeAndObjectCode + | Opt_UnoptimizedCoreForInterpreter | Opt_LinkRts -- output style opts ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3573,6 +3573,7 @@ fFlagsDeps = [ flagSpec "write-ide-info" Opt_WriteHie, flagSpec "unbox-small-strict-fields" Opt_UnboxSmallStrictFields, flagSpec "unbox-strict-fields" Opt_UnboxStrictFields, + flagSpec "unoptimized-core-for-interpreter" Opt_UnoptimizedCoreForInterpreter, flagSpec "version-macros" Opt_VersionMacros, flagSpec "worker-wrapper" Opt_WorkerWrapper, flagSpec "worker-wrapper-cbv" Opt_WorkerWrapperUnlift, -- See Note [Worker/wrapper for strict arguments] @@ -3896,7 +3897,8 @@ defaultFlags settings Opt_DumpWithWays, Opt_CompactUnwind, Opt_ShowErrorContext, - Opt_SuppressStgReps + Opt_SuppressStgReps, + Opt_UnoptimizedCoreForInterpreter ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] @@ -4976,6 +4978,7 @@ makeDynFlagsConsistent dflags "Enabling -fPIC as it is always on for this platform" | backendForcesOptimization0 (backend dflags) + , gopt Opt_UnoptimizedCoreForInterpreter dflags , let (dflags', changed) = updOptLevelChanged 0 dflags , changed = loop dflags' ("Optimization flags are incompatible with the " ++ ===================================== compiler/GHC/JS/Transform.hs ===================================== @@ -6,13 +6,15 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} module GHC.JS.Transform ( identsS , identsV , identsE -- * Saturation - , jsSaturate + , satJStat + , satJExpr -- * Generic traversal (via compos) , JMacro(..) , JMGadt(..) @@ -21,8 +23,6 @@ module GHC.JS.Transform , composOpM , composOpM_ , composOpFold - , satJExpr - , satJStat ) where @@ -33,11 +33,12 @@ import GHC.JS.Unsat.Syntax import Data.Functor.Identity import Control.Monad -import Control.Arrow ((***)) +import Data.List (sortBy) import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique.Map +import GHC.Types.Unique.FM {-# INLINE identsS #-} @@ -205,69 +206,62 @@ jmcompos ret app f' v = -- | Given an optional prefix, fills in all free variable names with a supply -- of names generated by the prefix. -jsSaturate :: (JMacro a) => Maybe FastString -> a -> a -jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str) - -jsSaturate_ :: (JMacro a) => a -> IdentSupply a -jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e) +satJStat :: Maybe FastString -> JStat -> Sat.JStat +satJStat str x = evalState (jsSaturateS x) (newIdentSupply str) + +satJExpr :: Maybe FastString -> JExpr -> Sat.JExpr +satJExpr str x = evalState (jsSaturateE x) (newIdentSupply str) + +jsSaturateS :: JStat -> State [Ident] Sat.JStat +jsSaturateS = \case + DeclStat i rhs -> Sat.DeclStat i <$> mapM jsSaturateE rhs + ReturnStat e -> Sat.ReturnStat <$> jsSaturateE e + IfStat c t e -> Sat.IfStat <$> jsSaturateE c <*> jsSaturateS t <*> jsSaturateS e + WhileStat is_do c e -> Sat.WhileStat is_do <$> jsSaturateE c <*> jsSaturateS e + ForStat init p step body -> Sat.ForStat <$> jsSaturateS init <*> jsSaturateE p + <*> jsSaturateS step <*> jsSaturateS body + ForInStat is_each i iter body -> Sat.ForInStat is_each i <$> jsSaturateE iter <*> jsSaturateS body + SwitchStat struct ps def -> Sat.SwitchStat <$> jsSaturateE struct + <*> mapM (\(p1, p2) -> (,) <$> jsSaturateE p1 <*> jsSaturateS p2) ps + <*> jsSaturateS def + TryStat t i c f -> Sat.TryStat <$> jsSaturateS t <*> pure i <*> jsSaturateS c <*> jsSaturateS f + BlockStat bs -> fmap Sat.BlockStat $! mapM jsSaturateS bs + ApplStat rator rand -> Sat.ApplStat <$> jsSaturateE rator <*> mapM jsSaturateE rand + UOpStat rator rand -> Sat.UOpStat (satJUOp rator) <$> jsSaturateE rand + AssignStat lhs rhs -> Sat.AssignStat <$> jsSaturateE lhs <*> pure Sat.AssignOp <*> jsSaturateE rhs + LabelStat lbl stmt -> Sat.LabelStat lbl <$> jsSaturateS stmt + BreakStat m_l -> return $ Sat.BreakStat $! m_l + ContinueStat m_l -> return $ Sat.ContinueStat $! m_l + FuncStat i args body -> Sat.FuncStat i args <$> jsSaturateS body + UnsatBlock us -> jsSaturateS =<< runIdentSupply us + +jsSaturateE :: JExpr -> State [Ident] Sat.JExpr +jsSaturateE = \case + ValExpr v -> Sat.ValExpr <$> jsSaturateV v + SelExpr obj i -> Sat.SelExpr <$> jsSaturateE obj <*> pure i + IdxExpr o i -> Sat.IdxExpr <$> jsSaturateE o <*> jsSaturateE i + InfixExpr op l r -> Sat.InfixExpr (satJOp op) <$> jsSaturateE l <*> jsSaturateE r + UOpExpr op r -> Sat.UOpExpr (satJUOp op) <$> jsSaturateE r + IfExpr c t e -> Sat.IfExpr <$> jsSaturateE c <*> jsSaturateE t <*> jsSaturateE e + ApplExpr rator rands -> Sat.ApplExpr <$> jsSaturateE rator <*> mapM jsSaturateE rands + UnsatExpr us -> jsSaturateE =<< runIdentSupply us + +jsSaturateV :: JVal -> State [Ident] Sat.JVal +jsSaturateV = \case + JVar i -> return $ Sat.JVar i + JList xs -> Sat.JList <$> mapM jsSaturateE xs + JDouble d -> return $ Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) + JInt i -> return $ Sat.JInt i + JStr s -> return $ Sat.JStr s + JRegEx f -> return $ Sat.JRegEx f + JHash m -> Sat.JHash <$> mapUniqMapM satHash m where - go :: forall a. JMGadt a -> State [Ident] (JMGadt a) - go v = case v of - JMGStat (UnsatBlock us) -> go =<< (JMGStat <$> runIdentSupply us) - JMGExpr (UnsatExpr us) -> go =<< (JMGExpr <$> runIdentSupply us) - JMGVal (UnsatVal us) -> go =<< (JMGVal <$> runIdentSupply us) - _ -> composOpM go v - - --------------------------------------------------------------------------------- --- Translation --- --------------------------------------------------------------------------------- -satJStat :: JStat -> Sat.JStat -satJStat = witness . proof - where proof = jsSaturate Nothing - - -- This is an Applicative but we can't use it because no type variables :( - witness :: JStat -> Sat.JStat - witness (DeclStat i rhs) = Sat.DeclStat i (fmap satJExpr rhs) - witness (ReturnStat e) = Sat.ReturnStat (satJExpr e) - witness (IfStat c t e) = Sat.IfStat (satJExpr c) (witness t) (witness e) - witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e) - witness (ForStat init p step body) = Sat.ForStat - (witness init) (satJExpr p) - (witness step) (witness body) - witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i - (satJExpr iter) - (witness body) - witness (SwitchStat struct ps def) = Sat.SwitchStat - (satJExpr struct) - (map (satJExpr *** witness) ps) - (witness def) - witness (TryStat t i c f) = Sat.TryStat (witness t) i (witness c) (witness f) - witness (BlockStat bs) = Sat.BlockStat $! fmap witness bs - witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand) - witness (UOpStat rator rand) = Sat.UOpStat (satJUOp rator) (satJExpr rand) - witness (AssignStat lhs rhs) = Sat.AssignStat (satJExpr lhs) Sat.AssignOp (satJExpr rhs) - witness (LabelStat lbl stmt) = Sat.LabelStat lbl (witness stmt) - witness (BreakStat Nothing) = Sat.BreakStat Nothing - witness (BreakStat (Just l)) = Sat.BreakStat $! Just l - witness (ContinueStat Nothing) = Sat.ContinueStat Nothing - witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l - witness (FuncStat i args body) = Sat.FuncStat i args (witness body) - witness UnsatBlock{} = error "satJStat: discovered an Unsat...impossibly" - - -satJExpr :: JExpr -> Sat.JExpr -satJExpr = go - where - go (ValExpr v) = Sat.ValExpr (satJVal v) - go (SelExpr obj i) = Sat.SelExpr (satJExpr obj) i - go (IdxExpr o i) = Sat.IdxExpr (satJExpr o) (satJExpr i) - go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r) - go (UOpExpr op r) = Sat.UOpExpr (satJUOp op) (satJExpr r) - go (IfExpr c t e) = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e) - go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands) - go UnsatExpr{} = error "satJExpr: discovered an Unsat...impossibly" + satHash (i, x) = (i,) . (i,) <$> jsSaturateE x + compareHash (i,_) (j,_) = lexicalCompareFS i j + -- By lexically sorting the elements, the non-determinism introduced by nonDetEltsUFM is avoided + mapUniqMapM f (UniqMap m) = UniqMap . listToUFM <$> (mapM f . sortBy compareHash $ nonDetEltsUFM m) + JFunc args body -> Sat.JFunc args <$> jsSaturateS body + UnsatVal us -> jsSaturateV =<< runIdentSupply us satJOp :: JOp -> Sat.Op satJOp = go @@ -313,15 +307,3 @@ satJUOp = go go PreDecOp = Sat.PreDecOp go PostDecOp = Sat.PostDecOp -satJVal :: JVal -> Sat.JVal -satJVal = go - where - go (JVar i) = Sat.JVar i - go (JList xs) = Sat.JList (satJExpr <$> xs) - go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d)) - go (JInt i) = Sat.JInt i - go (JStr f) = Sat.JStr f - go (JRegEx f) = Sat.JRegEx f - go (JHash m) = Sat.JHash (satJExpr <$> m) - go (JFunc args body) = Sat.JFunc args (satJStat body) - go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly" ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -134,10 +134,9 @@ genUnits m ss spt_entries foreign_stubs = do glbl <- State.gets gsGlobal staticInit <- initStaticPtrs spt_entries - let stat = ( jsOptimize - . satJStat - . jsSaturate (Just $ modulePrefix m 1) - $ mconcat (reverse glbl) <> staticInit) + let stat = ( jsOptimize . + satJStat (Just $ modulePrefix m 1) + $ mconcat (reverse glbl) <> staticInit) let syms = [moduleGlobalSymbol m] let oi = ObjUnit { oiSymbols = syms @@ -210,8 +209,7 @@ genUnits m ss spt_entries foreign_stubs = do si <- State.gets (ggsStatic . gsGroup) let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 let stat = jsOptimize - . satJStat - $ jsSaturate (Just $ modulePrefix m n) body + $ satJStat (Just $ modulePrefix m n) body let ids = [bnd] syms <- (\(TxtI i) -> [i]) <$> identForId bnd let oi = ObjUnit @@ -249,8 +247,7 @@ genUnits m ss spt_entries foreign_stubs = do topDeps = collectTopIds decl required = hasExport decl stat = jsOptimize - . satJStat - . jsSaturate (Just $ modulePrefix m n) + . satJStat (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps let oi = ObjUnit @@ -339,7 +336,7 @@ genToplevelRhs i rhs = case rhs of eid@(TxtI eidt) <- identForEntryId i (TxtI idt) <- identForId i body <- genBody (initExprCtx i) R2 args body typ - global_occs <- globalOccs (jsSaturate (Just "ghcjs_tmp_sat_") body) + global_occs <- globalOccs (satJStat (Just "ghcjs_tmp_sat_") body) let lidents = map global_ident global_occs let lids = map global_id global_occs let lidents' = map identFS lidents ===================================== compiler/GHC/StgToJS/CoreUtils.hs ===================================== @@ -253,7 +253,7 @@ assocPrimReps (r:rs) vs = case (primRepSize r,vs) of (NoSlot, xs) -> (r,[]) : assocPrimReps rs xs (OneSlot, x:xs) -> (r,[x]) : assocPrimReps rs xs (TwoSlots, x:y:xs) -> (r,[x,y]) : assocPrimReps rs xs - err -> pprPanic "assocPrimReps" (ppr $ fmap (map satJExpr) $ err) + err -> pprPanic "assocPrimReps" (ppr $ map (satJExpr Nothing) <$> err) -- | Associate the given values to the Id's PrimReps, taking into account the -- number of slots per PrimRep ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -60,8 +60,8 @@ genCon ctx con args | xs <- concatMap typex_expr (ctxTarget ctx) = pprPanic "genCon: unhandled DataCon" (ppr (con - , fmap satJExpr args - , fmap satJExpr xs + , satJExpr Nothing <$> args + , satJExpr Nothing <$> xs )) -- | Allocate a data constructor. Allocate in this context means bind the data @@ -90,7 +90,7 @@ allocUnboxedCon con = \case | isBoolDataCon con && dataConTag con == 2 -> true_ [x] | isUnboxableCon con -> x - xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, fmap satJExpr xs)) + xs -> pprPanic "allocUnboxedCon: not an unboxed constructor" (ppr (con, satJExpr Nothing <$> xs)) -- | Allocate an entry function. See 'GHC.StgToJS.hs' for the object layout. allocDynamicE :: Bool -- ^ csInlineAlloc from StgToJSConfig ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -899,7 +899,7 @@ caseCond = \case DataAlt da -> return $ Just (toJExpr $ dataConTag da) LitAlt l -> genLit l >>= \case [e] -> pure (Just e) - es -> pprPanic "caseCond: expected single-variable literal" (ppr $ fmap satJExpr es) + es -> pprPanic "caseCond: expected single-variable literal" (ppr $ satJExpr Nothing <$> es) -- fixme use single tmp var for all branches -- | Load parameters from constructor ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Arg import GHC.StgToJS.ExprCtx @@ -176,8 +177,8 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) arg_ty = stgArgType a r = uTypeVt arg_ty -saturateFFI :: JMacro a => Int -> a -> a -saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) +saturateFFI :: Int -> JStat -> Sat.JStat +saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) genForeignCall :: HasDebugCallStack => ExprCtx ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -333,7 +333,7 @@ renderLinker h mods jsFiles = do pure (mod_mod, mod_size) -- commoned up metadata - !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat meta) + !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat Nothing meta) -- module exports mapM_ (putBS . cmc_exports) compacted_mods ===================================== compiler/GHC/StgToJS/Monad.hs ===================================== @@ -25,6 +25,7 @@ where import GHC.Prelude import GHC.JS.Unsat.Syntax +import qualified GHC.JS.Syntax as Sat import GHC.JS.Transform import GHC.StgToJS.Types @@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc -- | Return number of occurrences of every global id used in the given JStat. -- Sort by increasing occurrence count. -globalOccs :: JStat -> G [GlobalOcc] +globalOccs :: Sat.JStat -> G [GlobalOcc] globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache -- build a map form Ident Unique to (Ident, Id, Count) @@ -180,4 +181,4 @@ globalOccs jst = do let g = GlobalOcc i gid 1 in go (addToUFM_C inc gids i g) is - pure $ go emptyUFM (identsS $ satJStat jst) + pure $ go emptyUFM (identsS jst) ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -31,6 +31,7 @@ import GHC.JS.Unsat.Syntax import GHC.JS.Make import GHC.JS.Transform import GHC.JS.Optimizer +import qualified GHC.JS.Syntax as Sat import GHC.StgToJS.Apply import GHC.StgToJS.Closure @@ -298,8 +299,8 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: JStat -rtsDecls = jsSaturate (Just "h$RTSD") $ +rtsDecls :: Sat.JStat +rtsDecls = satJStat (Just "h$RTSD") $ mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -314,15 +315,15 @@ rtsDecls = jsSaturate (Just "h$RTSD") $ -- | print the embedded RTS to a String rtsText :: StgToJSConfig -> String -rtsText = show . pretty . jsOptimize . satJStat . rts +rtsText = show . pretty . jsOptimize . rts -- | print the RTS declarations to a String. rtsDeclsText :: String -rtsDeclsText = show . pretty . jsOptimize . satJStat $ rtsDecls +rtsDeclsText = show . pretty . jsOptimize $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' -rts :: StgToJSConfig -> JStat -rts = jsSaturate (Just "h$RTS") . rts' +rts :: StgToJSConfig -> Sat.JStat +rts = satJStat (Just "h$RTS") . rts' -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -4516,31 +4516,40 @@ checkNewDataCon :: DataCon -> TcM () -- But they are caught earlier, by GHC.Tc.Gen.HsType.checkDataKindSig checkNewDataCon con = do { show_linear_types <- xopt LangExt.LinearTypes <$> getDynFlags - - ; checkTc (isSingleton arg_tys) $ - TcRnIllegalNewtype con show_linear_types (DoesNotHaveSingleField $ length arg_tys) - - ; checkTc (ok_mult (scaledMult arg_ty1)) $ - TcRnIllegalNewtype con show_linear_types IsNonLinear - - ; checkTc (null eq_spec) $ - TcRnIllegalNewtype con show_linear_types IsGADT - - ; checkTc (null theta) $ + ; checkNoErrs $ + -- Fail here if the newtype is invalid: subsequent code in + -- checkValidDataCon can fall over if it comes across an invalid newtype. + do { case arg_tys of + [Scaled arg_mult _] -> + unless (ok_mult arg_mult) $ + addErrTc $ + TcRnIllegalNewtype con show_linear_types IsNonLinear + _ -> + addErrTc $ + TcRnIllegalNewtype con show_linear_types (DoesNotHaveSingleField $ length arg_tys) + + -- Add an error if the newtype is a GADt or has existentials. + -- + -- If the newtype is a GADT, the GADT error is enough; + -- we don't need to *also* complain about existentials. + ; if not (null eq_spec) + then addErrTc $ TcRnIllegalNewtype con show_linear_types IsGADT + else unless (null ex_tvs) $ + addErrTc $ + TcRnIllegalNewtype con show_linear_types HasExistentialTyVar + + ; unless (null theta) $ + addErrTc $ TcRnIllegalNewtype con show_linear_types HasConstructorContext - ; checkTc (null ex_tvs) $ - TcRnIllegalNewtype con show_linear_types HasExistentialTyVar - - ; checkTc (all ok_bang (dataConSrcBangs con)) $ - TcRnIllegalNewtype con show_linear_types HasStrictnessAnnotation - } + ; unless (all ok_bang (dataConSrcBangs con)) $ + addErrTc $ + TcRnIllegalNewtype con show_linear_types HasStrictnessAnnotation } } where + (_univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig con - (arg_ty1 : _) = arg_tys - ok_bang (HsSrcBang _ _ SrcStrict) = False ok_bang (HsSrcBang _ _ SrcLazy) = False ok_bang _ = True ===================================== compiler/GHC/Tc/TyCl/Build.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Tc.TyCl.Build ( import GHC.Prelude import GHC.Iface.Env -import GHC.Builtin.Types( isCTupleTyConName, unboxedUnitTy ) +import GHC.Builtin.Types import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad @@ -65,11 +65,12 @@ mkNewTyConRhs tycon_name tycon con tvs = tyConTyVars tycon roles = tyConRoles tycon res_kind = tyConResKind tycon - con_arg_ty = case dataConRepArgTys con of - [arg_ty] -> scaledThing arg_ty - tys -> pprPanic "mkNewTyConRhs" (ppr con <+> ppr tys) - rhs_ty = substTyWith (dataConUnivTyVars con) - (mkTyVarTys tvs) con_arg_ty + rhs_ty + -- Only try if the newtype is actually valid (see "otherwise" below). + | [Scaled _ arg_ty] <- dataConRepArgTys con + , null $ dataConExTyCoVars con + = substTyWith (dataConUnivTyVars con) + (mkTyVarTys tvs) arg_ty -- Instantiate the newtype's RHS with the -- type variables from the tycon -- NB: a newtype DataCon has a type that must look like @@ -78,6 +79,13 @@ mkNewTyConRhs tycon_name tycon con -- the newtype arising from class Foo a => Bar a where {} -- has a single argument (Foo a) that is a *type class*, so -- dataConInstOrigArgTys returns []. + | otherwise + -- If the newtype is invalid (e.g. doesn't have a single argument), + -- we fake up a type here. The newtype will get rejected once we're + -- outside the knot-tied loop, in GHC.Tc.TyCl.checkNewDataCon. + -- See the various test cases in T23308. + = unitTy -- Might be ill-kinded, but checkNewDataCon should reject this + -- whole declaration soon enough, before that causes any problems. -- Eta-reduce the newtype -- See Note [Newtype eta] in GHC.Core.TyCon ===================================== docs/users_guide/debugging.rst ===================================== @@ -1146,3 +1146,17 @@ Other be terminated. This helps narrowing down if an issue is due to tag inference if things go wrong. Which would otherwise be quite difficult. +.. ghc-flag:: -funoptimized-core-for-interpreter + :shortdesc: Disable optimizations with the interpreter + :reverse: -fno-unoptimized-core-for-interpreter + :type: dynamic + + :since: 9.8.1 + + default: enabled + + At the moment, ghci disables optimizations, because not all passes + are compatible with the interpreter. + This option can be used to override this check, e.g. + ``ghci -O2 -fno-unoptimized-core-for-interpreter``. + It is not recommended for normal use and can cause a compiler panic. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -117,9 +117,9 @@ The easiest way to see what ``-O`` (etc.) “really mean” is to run with single: -fno-\* options (GHC) These flags turn on and off individual optimisations. Flags marked as -on by default are enabled by ``-O``, and as such you shouldn't -need to set any of them explicitly. A flag ``-fwombat`` can be negated -by saying ``-fno-wombat``. +*on* by default are enabled at all optimisation levels by default, and +as such you shouldn't need to set any of them explicitly. A flag +``-fwombat`` can be negated by saying ``-fno-wombat``. .. ghc-flag:: -fcore-constant-folding :shortdesc: Enable constant folding in Core. Implied by :ghc-flag:`-O`. @@ -127,7 +127,7 @@ by saying ``-fno-wombat``. :reverse: -fno-core-constant-folding :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables Core-level constant folding, i.e. propagation of values that can be computed at compile time. @@ -138,7 +138,7 @@ by saying ``-fno-wombat``. :reverse: -fno-case-merge :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Merge immediately-nested case expressions that scrutinise the same variable. For example, :: @@ -162,7 +162,7 @@ by saying ``-fno-wombat``. :reverse: -fno-case-folding :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Allow constant folding in case expressions that scrutinise some primops: For example, :: @@ -185,7 +185,7 @@ by saying ``-fno-wombat``. :reverse: -fno-call-arity :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enable call-arity analysis. @@ -195,7 +195,7 @@ by saying ``-fno-wombat``. :reverse: -fno-exitification :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the floating of exit paths out of recursive functions. @@ -205,7 +205,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cmm-elim-common-blocks :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the common block elimination optimisation in the code generator. This optimisation attempts to find identical @@ -217,7 +217,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cmm-sink :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the sinking pass in the code generator. This optimisation attempts to find identical Cmm blocks and @@ -231,7 +231,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cmm-static-pred :category: - :default: off but enabled with :ghc-flag:`-O`. + :default: off but enabled by :ghc-flag:`-O`. This enables static control flow prediction on the final Cmm code. If enabled GHC will apply certain heuristics to identify @@ -244,7 +244,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cmm-control-flow :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables some control flow optimisations in the Cmm code generator, merging basic blocks and avoiding jumps right after jumps. @@ -255,7 +255,7 @@ by saying ``-fno-wombat``. :reverse: -fno-asm-shortcutting :category: - :default: off + :default: off but enabled by :ghc-flag:`-O2`. This enables shortcutting at the assembly stage of the code generator. In simpler terms shortcutting means if a block of instructions A only consists @@ -268,12 +268,12 @@ by saying ``-fno-wombat``. does nothing on macOS. .. ghc-flag:: -fblock-layout-cfg - :shortdesc: Use the new cfg based block layout algorithm. + :shortdesc: Use the new cfg based block layout algorithm. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-block-layout-cfg :category: - :default: off but enabled with :ghc-flag:`-O`. + :default: off but enabled by :ghc-flag:`-O`. The new algorithm considers all outgoing edges of a basic blocks for code layout instead of only the last jump instruction. @@ -326,7 +326,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cpr-anal :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Turn on CPR analysis, which enables the worker/wrapper transformation (cf. :ghc-flag:`-fworker-wrapper`) to unbox the result of a function, such as :: @@ -386,7 +386,7 @@ by saying ``-fno-wombat``. :reverse: -fno-cse :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the common-sub-expression elimination optimisation. Switching this off can be useful if you have some @@ -394,12 +394,12 @@ by saying ``-fno-wombat``. .. ghc-flag:: -fstg-cse :shortdesc: Enable common sub-expression elimination on the STG - intermediate language + intermediate language. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-stg-cse :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Enables the common-sub-expression elimination optimisation on the STG intermediate language, where it is able to common up some subexpressions @@ -422,7 +422,7 @@ by saying ``-fno-wombat``. :reverse: -fno-dicts-strict :category: - :default: off + :default: off but enabled by :ghc-flag:`-O2`. Make dictionaries strict. @@ -447,7 +447,7 @@ by saying ``-fno-wombat``. Behaviour is unconditionally enabled starting with 9.2 .. ghc-flag:: -fdo-eta-reduction - :shortdesc: Enable eta-reduction. Implied by :ghc-flag:`-O`. + :shortdesc: Enable eta-reduction. Always enabled by default. :type: dynamic :reverse: -fno-do-eta-reduction :category: @@ -518,7 +518,7 @@ by saying ``-fno-wombat``. :reverse: -fno-float-in :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Float let-bindings inwards, nearer their binding site. See `Let-floating: moving bindings to give faster programs @@ -544,7 +544,7 @@ by saying ``-fno-wombat``. :reverse: -fno-full-laziness :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Run the full laziness optimisation (also known as let-floating), which floats let-bindings outside enclosing lambdas, @@ -591,7 +591,7 @@ by saying ``-fno-wombat``. :reverse: -fno-ignore-asserts :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Causes GHC to ignore uses of the function ``Exception.assert`` in source code (in other words, rewriting ``Exception.assert p e`` to ``e`` (see @@ -603,7 +603,7 @@ by saying ``-fno-wombat``. :reverse: -fno-ignore-interface-pragmas :category: - :default: off + :default: Implied by :ghc-flag:`-O0`, otherwise off. Tells GHC to ignore all inessential information when reading interface files. That is, even if :file:`M.hi` contains unfolding or @@ -632,7 +632,7 @@ by saying ``-fno-wombat``. :reverse: -fno-liberate-case :category: - :default: off but enabled with :ghc-flag:`-O2`. + :default: off but enabled by :ghc-flag:`-O2`. Turn on the liberate-case transformation. This unrolls recursive function once in its own RHS, to avoid repeated case analysis of free variables. It's @@ -657,7 +657,7 @@ by saying ``-fno-wombat``. :reverse: -fno-loopification :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. When this optimisation is enabled the code generator will turn all self-recursive saturated tail calls into local jumps rather than @@ -1074,7 +1074,7 @@ by saying ``-fno-wombat``. :reverse: -fno-specialise :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Specialise each type-class-overloaded function defined in this module for the types at which it is called in this @@ -1101,12 +1101,12 @@ by saying ``-fno-wombat``. .. ghc-flag:: -fcross-module-specialise :shortdesc: Turn on specialisation of overloaded functions imported from - other modules. + other modules. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-cross-module-specialise :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Specialise ``INLINABLE`` (:ref:`inlinable-pragma`) type-class-overloaded functions imported from other modules for the types at @@ -1136,7 +1136,7 @@ by saying ``-fno-wombat``. :reverse: -fno-inline-generics :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. :since: 9.2.1 .. index:: @@ -1175,12 +1175,12 @@ by saying ``-fno-wombat``. .. ghc-flag:: -fsolve-constant-dicts :shortdesc: When solving constraints, try to eagerly solve - super classes using available dictionaries. + super classes using available dictionaries. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-solve-constant-dicts :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. When solving constraints, try to eagerly solve super classes using available dictionaries. @@ -1229,7 +1229,7 @@ by saying ``-fno-wombat``. :reverse: -fno-stg-lift-lams :category: - :default: on + :default: off but enabled by :ghc-flag:`-O2`. Enables the late lambda lifting optimisation on the STG intermediate language. This selectively lifts local functions to @@ -1281,7 +1281,7 @@ by saying ``-fno-wombat``. :reverse: -fno-strictness :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. Turn on demand analysis. @@ -1441,7 +1441,7 @@ by saying ``-fno-wombat``. :reverse: -fno-unbox-small-strict-fields :category: - :default: on + :default: off but enabled by :ghc-flag:`-O`. .. index:: single: strict constructor fields @@ -1654,10 +1654,13 @@ by saying ``-fno-wombat``. .. ghc-flag:: -fworker-wrapper - :shortdesc: Enable the worker/wrapper transformation. + :shortdesc: Enable the worker/wrapper transformation. Implied by :ghc-flag:`-O` + and by :ghc-flag:`-fstrictness`. :type: dynamic :category: + :default: off but enabled by :ghc-flag:`-O`. + Enable the worker/wrapper transformation after a demand analysis pass. Exploits strictness and absence information by unboxing strict arguments ===================================== hadrian/bindist/Makefile ===================================== @@ -78,7 +78,7 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk - $(call removeFiles,$@) + @rm -f $@ @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ ===================================== libraries/base/changelog.md ===================================== @@ -26,6 +26,7 @@ which provides a mechanism for custom type errors that reports the errors in a more predictable behaviour than `TypeError`. * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) + * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== testsuite/driver/testlib.py ===================================== @@ -387,7 +387,7 @@ def expect_fail_for( ways: List[WayName] ): def expect_broken( bug: IssueNumber ): """ - This test is a expected not to work due to the indicated issue number. + This test is expected not to work due to the indicated issue number. """ def helper( name: TestName, opts ): record_broken(name, opts, bug) ===================================== testsuite/tests/simplCore/should_compile/T23267.hs ===================================== @@ -0,0 +1,25 @@ +module T23267 where + +data N = Z | S N + +union :: N -> () +union Z = () +union t = splitS t + +splitS :: N -> () +splitS Z = () +splitS (S l) = splitS l + +{- Results in this error: + +*** Core Lint errors : in result of SpecConstr *** +T23267.hs:10:1: warning: + Out of scope: l_aBE :: N + [LclId] + In the RHS of $ssplitS_sJx :: N -> () + In the body of lambda with binder sc_sJw :: N + Substitution: +-} ===================================== testsuite/tests/simplCore/should_compile/T23267.script ===================================== @@ -0,0 +1 @@ +:load T23267 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) ===================================== testsuite/tests/simplCore/should_run/T23056.hs ===================================== @@ -0,0 +1,10 @@ +module Main where + +fun :: IO () +fun = pure () +{-# noinline fun #-} + +{-# rules "fun" fun = putStrLn "fun" #-} + +main :: IO () +main = fun ===================================== testsuite/tests/simplCore/should_run/T23056.script ===================================== @@ -0,0 +1,2 @@ +:load T23056 +main ===================================== testsuite/tests/simplCore/should_run/T23056.stdout ===================================== @@ -0,0 +1 @@ +fun ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -112,3 +112,4 @@ test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint']) test('T23184', normal, compile_and_run, ['-O']) test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases']) test('T23289', normal, compile_and_run, ['']) +test('T23056', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23056.script']) ===================================== testsuite/tests/typecheck/should_fail/T23308.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE DataKinds, UnliftedNewtypes, TypeFamilies #-} + +module T23308 where + +import Data.Proxy +import GHC.Exts + +-- Check that we don't panic in the middle of typechecking +-- when there is an invalid newtype in a knot-tied group of TyCons. + +data A1 = A1 !B1 +newtype B1 = B1 C1 C1 +data C1 = C1 A1 + + +data A2 = A2 !B2 +newtype B2 where { B2 :: forall (x :: C2). Proxy x -> B2 } +data C2 = C2 A2 + +type F2' :: forall {k}. k -> TYPE WordRep +type family F2' a where {} +data A2' = A2' !B2' +newtype B2' where { B2' :: forall (x :: C2'). F2' x -> B2' } +data C2' = C2' A2' + + +data A3 = A3 !B3 +newtype B3 where { B3 :: forall (x :: C2). B2 } +data C3 = C3 A3 + + +data A4 = A4 !(B4 Int) +newtype B4 a where { B4 :: C4 -> B4 Int } +data C4 = C4 A4 + + +data A5 = A5 !(B5 Int) +newtype B5 a where { B5 :: Num a => B5 (a, a) } +data C5 = C5 A5 ===================================== testsuite/tests/typecheck/should_fail/T23308.stderr ===================================== @@ -0,0 +1,50 @@ + +T23308.hs:12:14: error: [GHC-23517] + • A newtype constructor must have exactly one field + but ‘B1’ has two + B1 :: C1 -> C1 -> B1 + • In the definition of data constructor ‘B1’ + In the newtype declaration for ‘B1’ + +T23308.hs:17:20: error: [GHC-07525] + • A newtype constructor must not have existential type variables + B2 :: forall (x :: C2). Proxy x -> B2 + • In the definition of data constructor ‘B2’ + In the newtype declaration for ‘B2’ + +T23308.hs:23:21: error: [GHC-07525] + • A newtype constructor must not have existential type variables + B2' :: forall (x :: C2'). F2' x -> B2' + • In the definition of data constructor ‘B2'’ + In the newtype declaration for ‘B2'’ + +T23308.hs:28:20: error: [GHC-45219] + • Data constructor ‘B3’ returns type ‘B2’ + instead of an instance of its parent type ‘B3’ + • In the definition of data constructor ‘B3’ + In the newtype declaration for ‘B3’ + +T23308.hs:33:22: error: [GHC-89498] + • A newtype must not be a GADT + B4 :: C4 -> B4 Int + • In the definition of data constructor ‘B4’ + In the newtype declaration for ‘B4’ + +T23308.hs:38:22: error: [GHC-17440] + • A newtype constructor must not have a context in its type + B5 :: forall a. Num a => B5 (a, a) + • In the definition of data constructor ‘B5’ + In the newtype declaration for ‘B5’ + +T23308.hs:38:22: error: [GHC-89498] + • A newtype must not be a GADT + B5 :: forall a. Num a => B5 (a, a) + • In the definition of data constructor ‘B5’ + In the newtype declaration for ‘B5’ + +T23308.hs:38:22: error: [GHC-23517] + • A newtype constructor must have exactly one field + but ‘B5’ has none + B5 :: forall a. Num a => B5 (a, a) + • In the definition of data constructor ‘B5’ + In the newtype declaration for ‘B5’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -676,6 +676,7 @@ test('PatSynExistential', normal, compile_fail, ['']) test('PatSynArity', normal, compile_fail, ['']) test('PatSynUnboundVar', normal, compile_fail, ['']) test('T21444', normal, compile_fail, ['']) +test('T23308', normal, compile_fail, ['']) test('MultiAssocDefaults', normal, compile_fail, ['']) test('LazyFieldsDisabled', normal, compile_fail, ['']) test('TyfamsDisabled', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd29f72fcda44e644b4dcd7650617affff16eca6...967f1758b97889e6d30ca429b5f07b00ff6ec6e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd29f72fcda44e644b4dcd7650617affff16eca6...967f1758b97889e6d30ca429b5f07b00ff6ec6e7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 07:08:52 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 12 May 2023 03:08:52 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <645de604d33a7_26a806b65b7001880ea@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: b2ca3e41 by Andrei Borzenkov at 2023-05-12T11:08:21+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - + docs/users_guide/exts/implicit_forall.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/exts/type_signatures.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.stderr - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2ca3e4195208507480496600214141542585acb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2ca3e4195208507480496600214141542585acb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 07:12:56 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 12 May 2023 03:12:56 -0400 Subject: [Git][ghc/ghc][wip/compact-sourcetext] 3 commits: Use compact representation for SourceNotes Message-ID: <645de6f8bc794_26a806ad15ee8188747@gitlab.mail> Zubin pushed to branch wip/compact-sourcetext at Glasgow Haskell Compiler / GHC Commits: 0a1070eb by Zubin Duggal at 2023-05-12T12:42:27+05:30 Use compact representation for SourceNotes Metric Decrease: hard_hole_fits - - - - - 58ec6172 by Zubin Duggal at 2023-05-12T12:42:41+05:30 Use compact representation for UsageFile (#22744) - - - - - 403a9818 by Zubin Duggal at 2023-05-12T12:42:41+05:30 testsuite: add test for T22744 - - - - - 22 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Types/IPE.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/Module/Deps.hs - testsuite/tests/perf/compiler/Makefile - testsuite/tests/perf/compiler/all.T - + testsuite/tests/perf/compiler/genT22744 Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -839,7 +839,7 @@ data InfoProvEnt = InfoProvEnt -- The rendered Haskell type of the closure the table represents , infoProvModule :: !Module -- Origin module - , infoTableProv :: !(Maybe (RealSrcSpan, String)) } + , infoTableProv :: !(Maybe (RealSrcSpan, LexicalFastString)) } -- Position and information about the info table deriving (Eq, Ord) ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1496,7 +1496,7 @@ withSourceNote :: Located a -> Located b -> CmmParse c -> CmmParse c withSourceNote a b parse = do name <- getName case combineSrcSpans (getLoc a) (getLoc b) of - RealSrcSpan span _ -> code (emitTick (SourceNote span name)) >> parse + RealSrcSpan span _ -> code (emitTick (SourceNote span $ LexicalFastString $ mkFastString name)) >> parse _other -> parse -- ----------------------------------------------------------------------------- ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -144,10 +144,10 @@ basicBlockCodeGen block = do -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of - Just (SourceNote span name) + Just (SourceNote span (LexicalFastString name)) -> do fileId <- getFileId (srcSpanFile span) let line = srcSpanStartLine span; col = srcSpanStartCol span - return $ unitOL $ LOCATION fileId line col name + return $ unitOL $ LOCATION fileId line col (unpackFS name) _ -> return nilOL (mid_instrs,mid_bid) <- stmtsToInstrs id stmts (!tail_instrs,_) <- stmtToInstrs mid_bid tail ===================================== compiler/GHC/CmmToAsm/Dwarf.hs ===================================== @@ -6,6 +6,7 @@ import GHC.Prelude import GHC.Cmm.CLabel import GHC.Cmm.Expr +import GHC.Data.FastString import GHC.Settings.Config ( cProjectName, cProjectVersion ) import GHC.Types.Tickish ( CmmTickish, GenTickish(..) ) import GHC.Cmm.DebugBlock @@ -177,7 +178,8 @@ procToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo procToDwarf config prc = DwarfSubprogram { dwChildren = map (blockToDwarf config) (dblBlocks prc) , dwName = case dblSourceTick prc of - Just s at SourceNote{} -> sourceName s + Just s at SourceNote{} -> case sourceName s of + LexicalFastString s -> unpackFS s _otherwise -> show (dblLabel prc) , dwLabel = dblCLabel prc , dwParent = fmap mkAsmTempDieLabel ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -129,10 +129,10 @@ basicBlockCodeGen block = do -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of - Just (SourceNote span name) + Just (SourceNote span (LexicalFastString name)) -> do fileid <- getFileId (srcSpanFile span) let line = srcSpanStartLine span; col =srcSpanStartCol span - return $ unitOL $ LOCATION fileid line col name + return $ unitOL $ LOCATION fileid line col (unpackFS name) _ -> return nilOL mid_instrs <- stmtsToInstrs stmts tail_instrs <- stmtToInstrs tail ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -196,10 +196,10 @@ basicBlockCodeGen block = do -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of - Just (SourceNote span name) + Just (SourceNote span (LexicalFastString name)) -> do fileId <- getFileId (srcSpanFile span) let line = srcSpanStartLine span; col = srcSpanStartCol span - return $ unitOL $ LOCATION fileId line col name + return $ unitOL $ LOCATION fileId line col (unpackFS name) _ -> return nilOL (mid_instrs,mid_bid) <- stmtsToInstrs id stmts (!tail_instrs,_) <- stmtToInstrs mid_bid tail ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -578,7 +578,7 @@ toIfaceOneShot id | isId id toIfaceTickish :: CoreTickish -> Maybe IfaceTickish toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push) toIfaceTickish (HpcTick modl ix) = Just (IfaceHpcTick modl ix) -toIfaceTickish (SourceNote src names) = Just (IfaceSource src names) +toIfaceTickish (SourceNote src (LexicalFastString names)) = Just (IfaceSource src names) toIfaceTickish (Breakpoint {}) = Nothing -- Ignore breakpoints, since they are relevant only to GHCi, and -- should not be serialised (#8333) ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -314,7 +314,7 @@ mkDataConWorkers generate_debug_info mod_loc data_tycons | Just file <- ml_hs_file mod_loc = tick (span1 file) | otherwise = tick (span1 "???") where tick span = Tick $ SourceNote span $ - renderWithContext defaultSDocContext $ ppr name + LexicalFastString $ mkFastString $ renderWithContext defaultSDocContext $ ppr name span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1 {- ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -1182,24 +1182,23 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do , tick_label = boxLabel } - cc_name | topOnly = head decl_path - | otherwise = concat (intersperse "." decl_path) + cc_name | topOnly = mkFastString $ head decl_path + | otherwise = mkFastString $ concat (intersperse "." decl_path) env <- getEnv case tickishType env of HpcTicks -> HpcTick (this_mod env) <$> addMixEntry me ProfNotes -> do - let nm = mkFastString cc_name - flavour <- mkHpcCCFlavour <$> getCCIndexM nm - let cc = mkUserCC nm (this_mod env) pos flavour + flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name + let cc = mkUserCC cc_name (this_mod env) pos flavour count = countEntries && tte_countEntries env return $ ProfNote cc count True{-scopes-} Breakpoints -> Breakpoint noExtField <$> addMixEntry me <*> pure ids SourceNotes | RealSrcSpan pos' _ <- pos -> - return $ SourceNote pos' cc_name + return $ SourceNote pos' $ LexicalFastString cc_name _otherwise -> panic "mkTickish: bad source span!" ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Data.Maybe +import GHC.Data.FastString import Data.IORef import Data.List (sortBy) @@ -86,7 +87,7 @@ mkUsageInfo uc plugins fc unit_env this_mod dir_imp_mods used_names dependent_fi let all_home_ids = ue_all_home_unit_ids unit_env mod_usages <- mk_mod_usage_info uc hu all_home_ids this_mod dir_imp_mods used_names - let usages = mod_usages ++ [ UsageFile { usg_file_path = f + let usages = mod_usages ++ [ UsageFile { usg_file_path = mkFastString f , usg_file_hash = hash , usg_file_label = Nothing } | (f, hash) <- zip dependent_files hashes ] @@ -174,7 +175,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do msg m = moduleNameString (moduleName m) ++ "[TH] changed" - fing mmsg fn = UsageFile fn <$> lookupFileCache fc fn <*> pure mmsg + fing mmsg fn = UsageFile (mkFastString fn) <$> lookupFileCache fc fn <*> pure mmsg unlinkedToUsage m ul = case nameOfObject_maybe ul of ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -1175,7 +1175,7 @@ pprUsage usage at UsageHomeModule{} ) pprUsage usage at UsageFile{} = hsep [text "addDependentFile", - doubleQuotes (text (usg_file_path usage)), + doubleQuotes (ftext (usg_file_path usage)), ppr (usg_file_hash usage)] pprUsage usage at UsageMergedRequirement{} = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)] ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -771,12 +771,12 @@ checkModUsage fc UsageFile{ usg_file_path = file, usg_file_label = mlabel } = liftIO $ handleIO handler $ do - new_hash <- lookupFileCache fc file + new_hash <- lookupFileCache fc $ unpackFS file if (old_hash /= new_hash) then return recomp else return UpToDate where - reason = FileChanged file + reason = FileChanged $ unpackFS file recomp = needsRecompileBecause $ fromMaybe reason $ fmap CustomReason mlabel handler = if debugIsOn then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -45,6 +45,7 @@ module GHC.Iface.Syntax ( import GHC.Prelude +import GHC.Data.FastString import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey, constraintKindTyConKey ) import GHC.Types.Unique ( hasKey ) @@ -577,7 +578,7 @@ data IfaceExpr data IfaceTickish = IfaceHpcTick Module Int -- from HpcTick x | IfaceSCC CostCentre Bool Bool -- from ProfNote - | IfaceSource RealSrcSpan String -- from SourceNote + | IfaceSource RealSrcSpan FastString -- from SourceNote -- no breakpoints: we never export these into interface files data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1651,7 +1651,7 @@ tcIfaceExpr (IfaceTick tickish expr) = do tcIfaceTickish :: IfaceTickish -> IfM lcl CoreTickish tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix) tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push) -tcIfaceTickish (IfaceSource src name) = return (SourceNote src name) +tcIfaceTickish (IfaceSource src name) = return (SourceNote src (LexicalFastString name)) ------------------------- tcIfaceLit :: Literal -> IfL Literal ===================================== compiler/GHC/Stg/Debug.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Types.Tickish import GHC.Core.DataCon import GHC.Types.IPE import GHC.Unit.Module -import GHC.Types.Name ( getName, getOccName, occNameString, nameSrcSpan) +import GHC.Types.Name ( getName, getOccName, occNameFS, nameSrcSpan) import GHC.Data.FastString import Control.Monad (when) @@ -29,7 +29,7 @@ import Control.Applicative import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty(..)) -data SpanWithLabel = SpanWithLabel RealSrcSpan String +data SpanWithLabel = SpanWithLabel RealSrcSpan LexicalFastString data StgDebugOpts = StgDebugOpts { stgDebug_infoTableMap :: !Bool @@ -74,7 +74,7 @@ collectStgRhs bndr (StgRhsClosure ext cc us bs e t) = do -- If the name has a span, use that initially as the source position in-case -- we don't get anything better. with_span = case nameSrcSpan name of - RealSrcSpan pos _ -> withSpan (pos, occNameString (getOccName name)) + RealSrcSpan pos _ -> withSpan (pos, LexicalFastString $ occNameFS (getOccName name)) _ -> id e' <- with_span $ collectExpr e recordInfo bndr e' @@ -92,7 +92,7 @@ recordInfo bndr new_rhs = do -- A span from the ticks surrounding the new_rhs best_span = quickSourcePos thisFile new_rhs -- A back-up span if the bndr had a source position, many do not (think internally generated ids) - bndr_span = (\s -> SpanWithLabel s (occNameString (getOccName bndr))) + bndr_span = (\s -> SpanWithLabel s (LexicalFastString $ occNameFS (getOccName bndr))) <$> srcSpanToRealSrcSpan (nameSrcSpan (getName bndr)) recordStgIdPosition bndr best_span bndr_span ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,15 +1,17 @@ module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where +import Data.Coerce import GHC.Prelude import GHC.Platform import GHC.Unit.Module import GHC.Utils.Outputable import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) -import GHC.Data.FastString (fastStringToShortText) +import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..)) import GHC.Cmm.CLabel import GHC.Cmm.Expr import GHC.Cmm.Utils + import GHC.StgToCmm.Config import GHC.StgToCmm.Lit (newByteStringCLit) import GHC.StgToCmm.Monad @@ -67,7 +69,7 @@ toCgIPE platform ctx module_name ipe = do table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe)) closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe) type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe - let label_str = maybe "" snd (infoTableProv ipe) + let label_str = maybe "" (unpackFS . coerce . snd) (infoTableProv ipe) let (src_loc_file, src_loc_span) = case infoTableProv ipe of Nothing -> (mempty, "") ===================================== compiler/GHC/Types/IPE.hs ===================================== @@ -9,6 +9,7 @@ module GHC.Types.IPE ( import GHC.Prelude import GHC.Types.Name +import GHC.Data.FastString import GHC.Types.SrcLoc import GHC.Core.DataCon @@ -20,7 +21,7 @@ import qualified Data.Map.Strict as Map -- | Position and information about an info table. -- For return frames these are the contents of a 'CoreSyn.SourceNote'. -type IpeSourceLocation = (RealSrcSpan, String) +type IpeSourceLocation = (RealSrcSpan, LexicalFastString) -- | A map from a 'Name' to the best approximate source position that -- name arose from. ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Types.Tickish ( ) where import GHC.Prelude +import GHC.Data.FastString import GHC.Core.Type @@ -153,8 +154,8 @@ data GenTickish pass = -- necessary to enable optimizations. | SourceNote { sourceSpan :: RealSrcSpan -- ^ Source covered - , sourceName :: String -- ^ Name for source location - -- (uses same names as CCs) + , sourceName :: LexicalFastString -- ^ Name for source location + -- (uses same names as CCs) } deriving instance Eq (GenTickish 'TickishPassCore) ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -21,6 +21,8 @@ where import GHC.Prelude +import GHC.Data.FastString + import GHC.Types.SafeHaskell import GHC.Types.Name @@ -275,7 +277,7 @@ data Usage -- | A file upon which the module depends, e.g. a CPP #include, or using TH's -- 'addDependentFile' | UsageFile { - usg_file_path :: FilePath, + usg_file_path :: FastString, -- ^ External file dependency. From a CPP #include or TH -- addDependentFile. Should be absolute. usg_file_hash :: Fingerprint, ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -32,3 +32,8 @@ MultiLayerModulesTH_OneShot_Prep: MultiLayerModulesTH_Make_Prep InstanceMatching: ./genMatchingTest 0 '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface Defs.hs + +T22744: + ./genT22744 + '$(TEST_HC)' $(TEST_HC_OPTS) T22744.hs + ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -670,3 +670,14 @@ test('RecordUpdPerf', ], multimod_compile, ['RecordUpdPerf', '-fno-code -v0']) + +test('T22744', + [ collect_compiler_stats('peak_megabytes_allocated',20), + req_interp, + pre_cmd('$MAKE -s --no-print-directory T22744'), + extra_files(['genT22744']), + compile_timeout_multiplier(2) + ], + multimod_compile, + ['T22744', '-v0']) + ===================================== testsuite/tests/perf/compiler/genT22744 ===================================== @@ -0,0 +1,28 @@ +#!/usr/bin/env bash + +NUMDEP=10000 +NUMMOD=100 + +seq 1 $NUMDEP | xargs -I{} touch foo{} + +cat > T22744.hs << EOF +module Main where +EOF + +for i in $(seq $NUMMOD); do + cat > M$i.hs << EOF +{-# LANGUAGE TemplateHaskell #-} +module M$i where +import Language.Haskell.TH.Syntax +import Control.Monad + +\$(do forM_ [1..$NUMDEP] $ \i -> addDependentFile $ "foo" ++ show i + return []) +EOF + echo "import M$i" >> T22744.hs +done + +cat >> T22744.hs << EOF +main = pure () +EOF + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4e26c8014d983576310f91ac67b588692d65a4a...403a9818044974ce86415909caef836ff98338fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4e26c8014d983576310f91ac67b588692d65a4a...403a9818044974ce86415909caef836ff98338fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 07:58:49 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 12 May 2023 03:58:49 -0400 Subject: [Git][ghc/ghc][wip/t22884] error messages: Don't display ghci specific hints for missing packages Message-ID: <645df1b994053_26a806b65b6ec19465b@gitlab.mail> Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: bf113d74 by Matthew Pickering at 2023-05-12T08:58:40+01:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 26 changed files: - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Ppr.hs - ghc/GHCi/UI/Exception.hs - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - + testsuite/tests/package/T22884.hs - + testsuite/tests/package/T22884.stderr - + testsuite/tests/package/T22884_interactive.script - + testsuite/tests/package/T22884_interactive.stderr - testsuite/tests/package/T4806.stderr - + testsuite/tests/package/T4806_interactive.script - + testsuite/tests/package/T4806_interactive.stderr - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/all.T - testsuite/tests/package/package01e.stderr - testsuite/tests/package/package06e.stderr - testsuite/tests/package/package07e.stderr - testsuite/tests/package/package08e.stderr - testsuite/tests/perf/compiler/parsing001.stderr - testsuite/tests/plugins/T11244.stderr - testsuite/tests/plugins/plugins03.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr - testsuite/tests/typecheck/should_fail/tcfail082.stderr Changes: ===================================== compiler/GHC/Iface/Errors/Ppr.hs ===================================== @@ -19,6 +19,11 @@ module GHC.Iface.Errors.Ppr , missingInterfaceErrorReason , missingInterfaceErrorDiagnostic , readInterfaceErrorDiagnostic + + , lookingForHerald + , cantFindErrorX + , mayShowLocations + , pkgHiddenHint ) where @@ -129,34 +134,34 @@ cantFindError :: IfaceMessageOpts -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindError opts = cantFindErrorX (pkg_hidden_hint (ifaceBuildingCabalPackage opts)) (mayShowLocations (ifaceShowTriedFiles opts)) - where - pkg_hidden_hint using_cabal (Just pkg) - | using_cabal == YesBuildingCabalPackage - = text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - -- MP: This is ghci specific, remove - | otherwise - = text "You can run" <+> - quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> - text "to expose it." $$ - text "(Note: this unloads all the modules in the current scope.)" - pkg_hidden_hint _ Nothing = empty - -mayShowLocations :: Bool -> [FilePath] -> SDoc -mayShowLocations verbose files +cantFindError opts = + cantFindErrorX + (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts)) + (mayShowLocations "-v" (ifaceShowTriedFiles opts)) + + +pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage + -> UnitInfo -> SDoc +pkgHiddenHint _hint YesBuildingCabalPackage pkg + = text "Perhaps you need to add" <+> + quotes (ppr (unitPackageName pkg)) <+> + text "to the build-depends in your .cabal file." +pkgHiddenHint hint _not_cabal pkg + = hint pkg + +mayShowLocations :: String -> Bool -> [FilePath] -> SDoc +mayShowLocations option verbose files | null files = empty | not verbose = - text "Use -v (or `:set -v` in ghci) " <> + text "Use" <+> text option <+> text "to see a list of the files searched for." | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) -- | General version of cantFindError which has some holes which allow GHC/GHCi to display slightly different -- error messages. -cantFindErrorX :: (Maybe UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc -cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstalled mod_name cfir) = +cantFindErrorX :: (UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc +cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInstalled mod_name cfir) = let ambig = isAmbiguousInstalledReason cfir find_or_load = isLoadOrFindReason cfir ppr_what = prettyCantFindWhat find_or_load mod_or_interface ambig @@ -184,11 +189,11 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal text "There are files missing in the " <> quotes (ppr pkg) <+> text "package," $$ text "try running 'ghc-pkg check'." $$ - mayShowLocations files + may_show_locations files MissingPackageWayFiles build pkg files -> text "Perhaps you haven't installed the " <> text build <+> text "libraries for package " <> quotes (ppr pkg) <> char '?' $$ - mayShowLocations files + may_show_locations files ModuleSuggestion ms fps -> let pp_suggestions :: [ModuleSuggestion] -> SDoc @@ -230,7 +235,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> ppr (mkUnit pkg)) | otherwise = empty - in pp_suggestions ms $$ mayShowLocations fps + in pp_suggestions ms $$ may_show_locations fps NotAModule -> text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> vcat (map text fps) MultiplePackages mods @@ -248,7 +253,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal vcat (map pkg_hidden pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ vcat (map unusable unusables) $$ - mayShowLocations files + may_show_locations files where pprMod (m, o) = text "it is bound as" <+> ppr m <+> text "by" <+> pprOrigin m o @@ -268,7 +273,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal <+> quotes (ppr uid) --FIXME: we don't really want to show the unit id here we should -- show the source package id or installed package id if it's ambiguous - <> dot $$ pkg_hidden_hint uif + <> dot $$ maybe empty pkg_hidden_hint uif mod_hidden pkg = @@ -285,21 +290,21 @@ interfaceErrorDiagnostic opts = \ case Can'tFindNameInInterface name relevant_tyThings -> missingDeclInInterface name relevant_tyThings Can'tFindInterface err looking_for -> - case looking_for of - LookingForName {} -> - missingInterfaceErrorDiagnostic opts err - LookingForModule {} -> - missingInterfaceErrorDiagnostic opts err - LookingForHiBoot mod -> - hang (text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon) - 2 (missingInterfaceErrorDiagnostic opts err) - LookingForSig sig -> - hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) - 2 (missingInterfaceErrorDiagnostic opts err) + hangNotEmpty (lookingForHerald looking_for) 2 (missingInterfaceErrorDiagnostic opts err) CircularImport mod -> text "Circular imports: module" <+> quotes (ppr mod) <+> text "depends on itself" +lookingForHerald :: InterfaceLookingFor -> SDoc +lookingForHerald looking_for = + case looking_for of + LookingForName {} -> empty + LookingForModule {} -> empty + LookingForHiBoot mod -> + text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon + LookingForSig sig -> + text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon + readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc readInterfaceErrorDiagnostic = \ case ExceptionOccurred fp ex -> ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,6 +21,10 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) , pprTyThingUsedWrong + + -- | Useful when overriding message printing. + , messageWithInfoDiagnosticMessage + , messageWithHsDocContext ) where @@ -126,12 +130,8 @@ instance Diagnostic TcRnMessage where (tcOptsShowContext opts) (diagnosticMessage opts msg) TcRnWithHsDocContext ctxt msg - -> if tcOptsShowContext opts - then main_msg `unionDecoratedSDoc` ctxt_msg - else main_msg - where - main_msg = diagnosticMessage opts msg - ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + -> messageWithHsDocContext opts ctxt (diagnosticMessage opts msg) + TcRnSolverReport msg _ _ -> mkSimpleDecorated $ pprSolverReportWithCtxt msg TcRnRedundantConstraints redundants (info, show_info) @@ -3259,6 +3259,14 @@ messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important = in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc` mkDecorated err_info' +messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc +messageWithHsDocContext opts ctxt main_msg = do + if tcOptsShowContext opts + then main_msg `unionDecoratedSDoc` ctxt_msg + else main_msg + where + ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc dodgy_msg kind tc ie = vcat [ text "The" <+> kind <+> text "item" <+> quotes (ppr ie) <+> text "suggests that" ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -4,14 +4,28 @@ module GHCi.UI.Exception(printGhciException, GHCiMessage(..)) where import GHC.Prelude -import GHC.Utils.Logger -import Control.Monad.IO.Class -import GHC.Driver.Session -import GHC.Types.SourceError -import GHC.Driver.Errors.Types -import GHC.Types.Error + import GHC.Driver.Config.Diagnostic import GHC.Driver.Errors +import GHC.Driver.Errors.Types +import GHC.Driver.Session + +import GHC.Iface.Errors.Ppr +import GHC.Iface.Errors.Types + +import GHC.Tc.Errors.Ppr +import GHC.Tc.Errors.Types + +import GHC.Types.Error +import GHC.Types.SourceError + +import GHC.Unit.State + +import GHC.Utils.Logger +import GHC.Utils.Outputable + +import Control.Monad.IO.Class + -- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting -- for some error messages. @@ -24,15 +38,67 @@ printGhciException err = do liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err)) -newtype GHCiMessage = GHCiMessage { getGhciMessage :: GhcMessage } +newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage } instance Diagnostic GHCiMessage where type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage - diagnosticMessage opts (GHCiMessage msg) = diagnosticMessage opts msg + diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg diagnosticReason (GHCiMessage msg) = diagnosticReason msg diagnosticHints (GHCiMessage msg) = diagnosticHints msg diagnosticCode (GHCiMessage msg) = diagnosticCode msg + +-- Modifications to error messages which we want to display in GHCi +ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc +ghciDiagnosticMessage ghc_opts msg = + case msg of + GhcTcRnMessage tc_msg -> + case tcRnMessage (tcMessageOpts ghc_opts) tc_msg of + Nothing -> diagnosticMessage ghc_opts msg + Just sdoc -> sdoc + GhcDriverMessage (DriverInterfaceError err) -> + case ghciInterfaceError err of + Just sdoc -> mkSimpleDecorated sdoc + Nothing -> diagnosticMessage ghc_opts msg + GhcDriverMessage {} -> diagnosticMessage ghc_opts msg + GhcPsMessage {} -> diagnosticMessage ghc_opts msg + GhcDsMessage {} -> diagnosticMessage ghc_opts msg + GhcUnknownMessage {} -> diagnosticMessage ghc_opts msg + where + tcRnMessage tc_opts tc_msg = + case tc_msg of + TcRnInterfaceError err -> mkSimpleDecorated <$> (ghciInterfaceError err) + TcRnMessageWithInfo unit_state msg_with_info -> + case msg_with_info of + TcRnMessageDetailed err_info wrapped_msg + -> messageWithInfoDiagnosticMessage unit_state err_info + (tcOptsShowContext tc_opts) + <$> tcRnMessage tc_opts wrapped_msg + TcRnWithHsDocContext ctxt wrapped_msg -> + messageWithHsDocContext tc_opts ctxt <$> tcRnMessage tc_opts wrapped_msg + _ -> Nothing + + opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts) + + ghciInterfaceError (Can'tFindInterface err looking_for) = + hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err + ghciInterfaceError _ = Nothing + + ghciMissingInterfaceErrorDiagnostic reason = + case reason of + CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi) + _ -> Nothing + where + + may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts) + + pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts) + where + hidden_msg pkg = + text "You can run" <+> + quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> + text "to expose it." $$ + text "(Note: this unloads all the modules in the current scope.)" ===================================== testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr ===================================== @@ -2,4 +2,4 @@ module-visibility-import/MV.hs:5:1: error: [GHC-87110] Could not load module ‘MV2’. it is a hidden module in the package ‘mv’ - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.stderr ===================================== @@ -18,7 +18,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z A.hs:3:1: error: [GHC-87110] Could not find module ‘B’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. == Dep_DM_AB == Dep_Error_DM_AB @@ -27,7 +27,7 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z A.hs:3:1: error: [GHC-87110] Could not find module ‘B’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. == Dep_MD_AB == Dep_Error_MD_AB ===================================== testsuite/tests/ghc-e/should_run/T2636.stderr ===================================== @@ -1,4 +1,4 @@ T2636.hs:1:1: error: [GHC-87110] Could not find module ‘MissingModule’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use :set -v to see a list of the files searched for. ===================================== testsuite/tests/module/mod1.stderr ===================================== @@ -1,4 +1,4 @@ mod1.hs:3:1: error: [GHC-87110] Could not find module ‘N’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/module/mod2.stderr ===================================== @@ -1,4 +1,4 @@ mod2.hs:3:1: error: [GHC-87110] Could not find module ‘N’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T22884.hs ===================================== @@ -0,0 +1,3 @@ +module T22884 where + +import Data.Text ===================================== testsuite/tests/package/T22884.stderr ===================================== @@ -0,0 +1,5 @@ + +T22884.hs:3:1: error: [GHC-87110] + Could not load module ‘Data.Text’. + It is a member of the hidden package ‘text-2.0.2’. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T22884_interactive.script ===================================== @@ -0,0 +1,3 @@ +:set -hide-all-packages + +import Data.Text ===================================== testsuite/tests/package/T22884_interactive.stderr ===================================== @@ -0,0 +1,6 @@ + +: error: [GHC-87110] + Could not load module ‘Data.Text’. + It is a member of the hidden package ‘text-2.0.2’. + You can run ‘:set -package text’ to expose it. + (Note: this unloads all the modules in the current scope.) ===================================== testsuite/tests/package/T4806.stderr ===================================== @@ -3,4 +3,4 @@ T4806.hs:1:1: error: [GHC-87110] Could not load module ‘Data.Map’. It is a member of the package ‘containers-0.6.7’ which is ignored due to an -ignore-package flag - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/T4806_interactive.script ===================================== @@ -0,0 +1,3 @@ +:set -ignore-package containers + +:l T4806.hs ===================================== testsuite/tests/package/T4806_interactive.stderr ===================================== @@ -0,0 +1,6 @@ + +T4806.hs:1:1: error: [GHC-87110] + Could not load module ‘Data.Map’. + It is a member of the package ‘containers-0.6.7’ + which is ignored due to an -ignore-package flag + Use :set -v to see a list of the files searched for. ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -4,4 +4,4 @@ T4806a.hs:1:1: error: [GHC-87110] It is a member of the package ‘containers-0.6.7’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: deepseq-1.4.8.1 template-haskell-2.20.0.0 - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/all.T ===================================== @@ -20,3 +20,6 @@ test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers']) test('T4806a', normalise_version('deepseq', 'containers', 'template-haskell'), compile_fail, ['-ignore-package deepseq']) +test('T22884', normalise_version('text'), compile_fail, ['-hide-package text']) +test('T22884_interactive', normalise_version('text'), ghci_script, ['T22884_interactive.script']) +test('T4806_interactive', [extra_files(['T4806.hs']), normalise_version('containers')], ghci_script, ['T4806_interactive.script']) ===================================== testsuite/tests/package/package01e.stderr ===================================== @@ -2,13 +2,9 @@ package01e.hs:2:1: error: [GHC-87110] Could not load module ‘Data.Map’. It is a member of the hidden package ‘containers-0.6.7’. - You can run ‘:set -package containers’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package01e.hs:3:1: error: [GHC-87110] Could not load module ‘Data.IntMap’. It is a member of the hidden package ‘containers-0.6.7’. - You can run ‘:set -package containers’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package06e.stderr ===================================== @@ -2,13 +2,9 @@ package06e.hs:2:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package06e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package07e.stderr ===================================== @@ -5,25 +5,19 @@ package07e.hs:2:1: error: [GHC-61948] GHC.Hs.Type (needs flag -package-id ghc-9.7) GHC.Tc.Types (needs flag -package-id ghc-9.7) GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:4:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Utils’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package07e.hs:5:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/package/package08e.stderr ===================================== @@ -5,25 +5,19 @@ package08e.hs:2:1: error: [GHC-61948] GHC.Hs.Type (needs flag -package-id ghc-9.7) GHC.Tc.Types (needs flag -package-id ghc-9.7) GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:3:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Type’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:4:1: error: [GHC-87110] Could not load module ‘GHC.Hs.Utils’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. package08e.hs:5:1: error: [GHC-87110] Could not load module ‘GHC.Types.Unique.FM’. It is a member of the hidden package ‘ghc-9.7’. - You can run ‘:set -package ghc’ to expose it. - (Note: this unloads all the modules in the current scope.) - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/perf/compiler/parsing001.stderr ===================================== @@ -1,4 +1,4 @@ parsing001.hs:3:1: error: [GHC-87110] Could not find module ‘Wibble’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/plugins/T11244.stderr ===================================== @@ -1,5 +1,3 @@ : Could not load module ‘RuleDefiningPlugin’. It is a member of the hidden package ‘rule-defining-plugin-0.1’. -You can run ‘:set -package rule-defining-plugin’ to expose it. -(Note: this unloads all the modules in the current scope.) -Use -v (or `:set -v` in ghci) to see a list of the files searched for. +Use -v to see a list of the files searched for. ===================================== testsuite/tests/plugins/plugins03.stderr ===================================== @@ -1,2 +1,2 @@ : Could not find module ‘Simple.NonExistentPlugin’. -Use -v (or `:set -v` in ghci) to see a list of the files searched for. +Use -v to see a list of the files searched for. ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr ===================================== @@ -4,4 +4,4 @@ SafeLang07.hs:2:14: warning: SafeLang07.hs:15:1: error: [GHC-87110] Could not find module ‘SafeLang07_A’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. ===================================== testsuite/tests/typecheck/should_fail/tcfail082.stderr ===================================== @@ -1,12 +1,12 @@ tcfail082.hs:2:1: error: [GHC-87110] Could not find module ‘Data82’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. tcfail082.hs:3:1: error: [GHC-87110] Could not find module ‘Inst82_1’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. tcfail082.hs:4:1: error: [GHC-87110] Could not find module ‘Inst82_2’. - Use -v (or `:set -v` in ghci) to see a list of the files searched for. + Use -v to see a list of the files searched for. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf113d74d7da6cedc897ebb5536e1f162cd7c4e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf113d74d7da6cedc897ebb5536e1f162cd7c4e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 10:11:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 06:11:19 -0400 Subject: [Git][ghc/ghc][master] Don't panic in mkNewTyConRhs Message-ID: <645e10c72c3b2_26a806b279b782268c7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - 6 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - + testsuite/tests/typecheck/should_fail/T23308.hs - + testsuite/tests/typecheck/should_fail/T23308.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1505,7 +1505,7 @@ piResultTys ty orig_args@(arg:args) -- c.f. #15473 pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args) -applyTysX :: [TyVar] -> Type -> [Type] -> Type +applyTysX :: HasDebugCallStack => [TyVar] -> Type -> [Type] -> Type -- applyTysX beta-reduces (/\tvs. body_ty) arg_tys -- Assumes that (/\tvs. body_ty) is closed applyTysX tvs body_ty arg_tys ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -4516,31 +4516,40 @@ checkNewDataCon :: DataCon -> TcM () -- But they are caught earlier, by GHC.Tc.Gen.HsType.checkDataKindSig checkNewDataCon con = do { show_linear_types <- xopt LangExt.LinearTypes <$> getDynFlags - - ; checkTc (isSingleton arg_tys) $ - TcRnIllegalNewtype con show_linear_types (DoesNotHaveSingleField $ length arg_tys) - - ; checkTc (ok_mult (scaledMult arg_ty1)) $ - TcRnIllegalNewtype con show_linear_types IsNonLinear - - ; checkTc (null eq_spec) $ - TcRnIllegalNewtype con show_linear_types IsGADT - - ; checkTc (null theta) $ + ; checkNoErrs $ + -- Fail here if the newtype is invalid: subsequent code in + -- checkValidDataCon can fall over if it comes across an invalid newtype. + do { case arg_tys of + [Scaled arg_mult _] -> + unless (ok_mult arg_mult) $ + addErrTc $ + TcRnIllegalNewtype con show_linear_types IsNonLinear + _ -> + addErrTc $ + TcRnIllegalNewtype con show_linear_types (DoesNotHaveSingleField $ length arg_tys) + + -- Add an error if the newtype is a GADt or has existentials. + -- + -- If the newtype is a GADT, the GADT error is enough; + -- we don't need to *also* complain about existentials. + ; if not (null eq_spec) + then addErrTc $ TcRnIllegalNewtype con show_linear_types IsGADT + else unless (null ex_tvs) $ + addErrTc $ + TcRnIllegalNewtype con show_linear_types HasExistentialTyVar + + ; unless (null theta) $ + addErrTc $ TcRnIllegalNewtype con show_linear_types HasConstructorContext - ; checkTc (null ex_tvs) $ - TcRnIllegalNewtype con show_linear_types HasExistentialTyVar - - ; checkTc (all ok_bang (dataConSrcBangs con)) $ - TcRnIllegalNewtype con show_linear_types HasStrictnessAnnotation - } + ; unless (all ok_bang (dataConSrcBangs con)) $ + addErrTc $ + TcRnIllegalNewtype con show_linear_types HasStrictnessAnnotation } } where + (_univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig con - (arg_ty1 : _) = arg_tys - ok_bang (HsSrcBang _ _ SrcStrict) = False ok_bang (HsSrcBang _ _ SrcLazy) = False ok_bang _ = True ===================================== compiler/GHC/Tc/TyCl/Build.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Tc.TyCl.Build ( import GHC.Prelude import GHC.Iface.Env -import GHC.Builtin.Types( isCTupleTyConName, unboxedUnitTy ) +import GHC.Builtin.Types import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad @@ -65,11 +65,12 @@ mkNewTyConRhs tycon_name tycon con tvs = tyConTyVars tycon roles = tyConRoles tycon res_kind = tyConResKind tycon - con_arg_ty = case dataConRepArgTys con of - [arg_ty] -> scaledThing arg_ty - tys -> pprPanic "mkNewTyConRhs" (ppr con <+> ppr tys) - rhs_ty = substTyWith (dataConUnivTyVars con) - (mkTyVarTys tvs) con_arg_ty + rhs_ty + -- Only try if the newtype is actually valid (see "otherwise" below). + | [Scaled _ arg_ty] <- dataConRepArgTys con + , null $ dataConExTyCoVars con + = substTyWith (dataConUnivTyVars con) + (mkTyVarTys tvs) arg_ty -- Instantiate the newtype's RHS with the -- type variables from the tycon -- NB: a newtype DataCon has a type that must look like @@ -78,6 +79,13 @@ mkNewTyConRhs tycon_name tycon con -- the newtype arising from class Foo a => Bar a where {} -- has a single argument (Foo a) that is a *type class*, so -- dataConInstOrigArgTys returns []. + | otherwise + -- If the newtype is invalid (e.g. doesn't have a single argument), + -- we fake up a type here. The newtype will get rejected once we're + -- outside the knot-tied loop, in GHC.Tc.TyCl.checkNewDataCon. + -- See the various test cases in T23308. + = unitTy -- Might be ill-kinded, but checkNewDataCon should reject this + -- whole declaration soon enough, before that causes any problems. -- Eta-reduce the newtype -- See Note [Newtype eta] in GHC.Core.TyCon ===================================== testsuite/tests/typecheck/should_fail/T23308.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE DataKinds, UnliftedNewtypes, TypeFamilies #-} + +module T23308 where + +import Data.Proxy +import GHC.Exts + +-- Check that we don't panic in the middle of typechecking +-- when there is an invalid newtype in a knot-tied group of TyCons. + +data A1 = A1 !B1 +newtype B1 = B1 C1 C1 +data C1 = C1 A1 + + +data A2 = A2 !B2 +newtype B2 where { B2 :: forall (x :: C2). Proxy x -> B2 } +data C2 = C2 A2 + +type F2' :: forall {k}. k -> TYPE WordRep +type family F2' a where {} +data A2' = A2' !B2' +newtype B2' where { B2' :: forall (x :: C2'). F2' x -> B2' } +data C2' = C2' A2' + + +data A3 = A3 !B3 +newtype B3 where { B3 :: forall (x :: C2). B2 } +data C3 = C3 A3 + + +data A4 = A4 !(B4 Int) +newtype B4 a where { B4 :: C4 -> B4 Int } +data C4 = C4 A4 + + +data A5 = A5 !(B5 Int) +newtype B5 a where { B5 :: Num a => B5 (a, a) } +data C5 = C5 A5 ===================================== testsuite/tests/typecheck/should_fail/T23308.stderr ===================================== @@ -0,0 +1,50 @@ + +T23308.hs:12:14: error: [GHC-23517] + • A newtype constructor must have exactly one field + but ‘B1’ has two + B1 :: C1 -> C1 -> B1 + • In the definition of data constructor ‘B1’ + In the newtype declaration for ‘B1’ + +T23308.hs:17:20: error: [GHC-07525] + • A newtype constructor must not have existential type variables + B2 :: forall (x :: C2). Proxy x -> B2 + • In the definition of data constructor ‘B2’ + In the newtype declaration for ‘B2’ + +T23308.hs:23:21: error: [GHC-07525] + • A newtype constructor must not have existential type variables + B2' :: forall (x :: C2'). F2' x -> B2' + • In the definition of data constructor ‘B2'’ + In the newtype declaration for ‘B2'’ + +T23308.hs:28:20: error: [GHC-45219] + • Data constructor ‘B3’ returns type ‘B2’ + instead of an instance of its parent type ‘B3’ + • In the definition of data constructor ‘B3’ + In the newtype declaration for ‘B3’ + +T23308.hs:33:22: error: [GHC-89498] + • A newtype must not be a GADT + B4 :: C4 -> B4 Int + • In the definition of data constructor ‘B4’ + In the newtype declaration for ‘B4’ + +T23308.hs:38:22: error: [GHC-17440] + • A newtype constructor must not have a context in its type + B5 :: forall a. Num a => B5 (a, a) + • In the definition of data constructor ‘B5’ + In the newtype declaration for ‘B5’ + +T23308.hs:38:22: error: [GHC-89498] + • A newtype must not be a GADT + B5 :: forall a. Num a => B5 (a, a) + • In the definition of data constructor ‘B5’ + In the newtype declaration for ‘B5’ + +T23308.hs:38:22: error: [GHC-23517] + • A newtype constructor must have exactly one field + but ‘B5’ has none + B5 :: forall a. Num a => B5 (a, a) + • In the definition of data constructor ‘B5’ + In the newtype declaration for ‘B5’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -676,6 +676,7 @@ test('PatSynExistential', normal, compile_fail, ['']) test('PatSynArity', normal, compile_fail, ['']) test('PatSynUnboundVar', normal, compile_fail, ['']) test('T21444', normal, compile_fail, ['']) +test('T23308', normal, compile_fail, ['']) test('MultiAssocDefaults', normal, compile_fail, ['']) test('LazyFieldsDisabled', normal, compile_fail, ['']) test('TyfamsDisabled', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c176ad1835ccfe55e2bde875b4a35e9d226ff657 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c176ad1835ccfe55e2bde875b4a35e9d226ff657 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 10:11:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 06:11:55 -0400 Subject: [Git][ghc/ghc][master] Allow Core optimizations when interpreting bytecode Message-ID: <645e10eb87dd2_26a806b0a1a94230467@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - 11 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/debugging.rst - testsuite/driver/testlib.py - + testsuite/tests/simplCore/should_compile/T23267.hs - + testsuite/tests/simplCore/should_compile/T23267.script - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/simplCore/should_run/T23056.hs - + testsuite/tests/simplCore/should_run/T23056.script - + testsuite/tests/simplCore/should_run/T23056.stdout - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -387,6 +387,7 @@ data GeneralFlag | Opt_KeepGoing | Opt_ByteCode | Opt_ByteCodeAndObjectCode + | Opt_UnoptimizedCoreForInterpreter | Opt_LinkRts -- output style opts ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3573,6 +3573,7 @@ fFlagsDeps = [ flagSpec "write-ide-info" Opt_WriteHie, flagSpec "unbox-small-strict-fields" Opt_UnboxSmallStrictFields, flagSpec "unbox-strict-fields" Opt_UnboxStrictFields, + flagSpec "unoptimized-core-for-interpreter" Opt_UnoptimizedCoreForInterpreter, flagSpec "version-macros" Opt_VersionMacros, flagSpec "worker-wrapper" Opt_WorkerWrapper, flagSpec "worker-wrapper-cbv" Opt_WorkerWrapperUnlift, -- See Note [Worker/wrapper for strict arguments] @@ -3896,7 +3897,8 @@ defaultFlags settings Opt_DumpWithWays, Opt_CompactUnwind, Opt_ShowErrorContext, - Opt_SuppressStgReps + Opt_SuppressStgReps, + Opt_UnoptimizedCoreForInterpreter ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] @@ -4976,6 +4978,7 @@ makeDynFlagsConsistent dflags "Enabling -fPIC as it is always on for this platform" | backendForcesOptimization0 (backend dflags) + , gopt Opt_UnoptimizedCoreForInterpreter dflags , let (dflags', changed) = updOptLevelChanged 0 dflags , changed = loop dflags' ("Optimization flags are incompatible with the " ++ ===================================== docs/users_guide/debugging.rst ===================================== @@ -1146,3 +1146,17 @@ Other be terminated. This helps narrowing down if an issue is due to tag inference if things go wrong. Which would otherwise be quite difficult. +.. ghc-flag:: -funoptimized-core-for-interpreter + :shortdesc: Disable optimizations with the interpreter + :reverse: -fno-unoptimized-core-for-interpreter + :type: dynamic + + :since: 9.8.1 + + default: enabled + + At the moment, ghci disables optimizations, because not all passes + are compatible with the interpreter. + This option can be used to override this check, e.g. + ``ghci -O2 -fno-unoptimized-core-for-interpreter``. + It is not recommended for normal use and can cause a compiler panic. ===================================== testsuite/driver/testlib.py ===================================== @@ -387,7 +387,7 @@ def expect_fail_for( ways: List[WayName] ): def expect_broken( bug: IssueNumber ): """ - This test is a expected not to work due to the indicated issue number. + This test is expected not to work due to the indicated issue number. """ def helper( name: TestName, opts ): record_broken(name, opts, bug) ===================================== testsuite/tests/simplCore/should_compile/T23267.hs ===================================== @@ -0,0 +1,25 @@ +module T23267 where + +data N = Z | S N + +union :: N -> () +union Z = () +union t = splitS t + +splitS :: N -> () +splitS Z = () +splitS (S l) = splitS l + +{- Results in this error: + +*** Core Lint errors : in result of SpecConstr *** +T23267.hs:10:1: warning: + Out of scope: l_aBE :: N + [LclId] + In the RHS of $ssplitS_sJx :: N -> () + In the body of lambda with binder sc_sJw :: N + Substitution: +-} ===================================== testsuite/tests/simplCore/should_compile/T23267.script ===================================== @@ -0,0 +1 @@ +:load T23267 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) ===================================== testsuite/tests/simplCore/should_run/T23056.hs ===================================== @@ -0,0 +1,10 @@ +module Main where + +fun :: IO () +fun = pure () +{-# noinline fun #-} + +{-# rules "fun" fun = putStrLn "fun" #-} + +main :: IO () +main = fun ===================================== testsuite/tests/simplCore/should_run/T23056.script ===================================== @@ -0,0 +1,2 @@ +:load T23056 +main ===================================== testsuite/tests/simplCore/should_run/T23056.stdout ===================================== @@ -0,0 +1 @@ +fun ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -112,3 +112,4 @@ test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint']) test('T23184', normal, compile_and_run, ['-O']) test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases']) test('T23289', normal, compile_and_run, ['']) +test('T23056', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23056.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab63daac0e0ed8749514e38d714cfcd4562f4326 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab63daac0e0ed8749514e38d714cfcd4562f4326 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 10:12:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 06:12:32 -0400 Subject: [Git][ghc/ghc][master] hadrian: Fix mention of non-existent removeFiles function Message-ID: <645e1110d591e_26a806b0a1a94237040@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -78,7 +78,7 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk - $(call removeFiles,$@) + @rm -f $@ @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6cf9433e3d41e239265eaeff0fd02e6b45d5427 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6cf9433e3d41e239265eaeff0fd02e6b45d5427 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 10:13:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 06:13:11 -0400 Subject: [Git][ghc/ghc][master] Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog Message-ID: <645e11379443c_26a806b65b714240346@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -26,6 +26,7 @@ which provides a mechanism for custom type errors that reports the errors in a more predictable behaviour than `TypeError`. * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) + * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb60ec18eff7943fb9f22b2d2ad29709b56ce02d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb60ec18eff7943fb9f22b2d2ad29709b56ce02d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 10:31:59 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Fri, 12 May 2023 06:31:59 -0400 Subject: [Git][ghc/ghc][wip/T23362] 27 commits: testsuite: Add test for atomicSwapIORef Message-ID: <645e159f6e3e4_26a806b279b8c243431@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23362 at Glasgow Haskell Compiler / GHC Commits: b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - fafdc13b by Krzysztof Gogolewski at 2023-05-12T12:29:36+02:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50e82f6fe83f2eca5e095b78393c7e50a11bdbf5...fafdc13b2cfef26d7d41b530aef114bebcf4d82d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50e82f6fe83f2eca5e095b78393c7e50a11bdbf5...fafdc13b2cfef26d7d41b530aef114bebcf4d82d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 10:39:54 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 06:39:54 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 13 commits: configure: Rip out Solaris dyld check Message-ID: <645e177a2115b_26a806b279b78243655@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: bcb74211 by Ben Gamari at 2023-05-12T11:38:49+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 66277dfd by Ben Gamari at 2023-05-12T11:39:33+01:00 Move via-C flags into GHC - - - - - 3cc5f193 by Ben Gamari at 2023-05-12T11:39:33+01:00 Rip out runtime linker/compiler checks - - - - - ca3f61a6 by Ben Gamari at 2023-05-12T11:39:33+01:00 configure: Rip out toolchain selection logic - - - - - 5fc46adc by Ben Gamari at 2023-05-12T11:39:33+01:00 Fixes - - - - - f24cb043 by Rodrigo Mesquita at 2023-05-12T11:39:33+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 11b985be by Rodrigo Mesquita at 2023-05-12T11:39:33+01:00 Re-introduce ld-override option - - - - - 64fb9f87 by Rodrigo Mesquita at 2023-05-12T11:39:33+01:00 ROMES:WIP - - - - - 5f23a7a0 by Rodrigo Mesquita at 2023-05-12T11:39:33+01:00 ghc-toolchain library and usage in hadrian flags - - - - - f7e13e2a by Rodrigo Mesquita at 2023-05-12T11:39:33+01:00 ROMES: WIP - - - - - bdc410d7 by Rodrigo Mesquita at 2023-05-12T11:39:33+01:00 Re-introduce flags in hadrian config - - - - - 3feca64c by Rodrigo Mesquita at 2023-05-12T11:39:33+01:00 ROMES WIP - - - - - f39dea85 by Rodrigo Mesquita at 2023-05-12T11:39:33+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Packages.hs - − m4/check_for_gold_t22266.m4 - − m4/check_ld_copy_bug.m4 - − m4/find_ld.m4 - − m4/find_merge_objects.m4 - m4/fp_cpp_cmd_with_args.m4 - − m4/fp_find_nm.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48620a416e8764beeb69d1fa5f975f6fbf6f0a06...f39dea85f6af5960406c14181ddd6dc50a4a1af2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48620a416e8764beeb69d1fa5f975f6fbf6f0a06...f39dea85f6af5960406c14181ddd6dc50a4a1af2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 10:45:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 06:45:17 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 43 commits: rts: Fix data-race in hs_init_ghc Message-ID: <645e18bd33243_26a806132f9dc0247234@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 6acf4c6d by Ben Gamari at 2023-05-12T11:43:41+01:00 ghc-toolchain: Initial commit - - - - - 519fb7ae by Ben Gamari at 2023-05-12T11:43:41+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 22aad8a4 by Ben Gamari at 2023-05-12T11:43:41+01:00 Move via-C flags into GHC - - - - - 9ebcf655 by Ben Gamari at 2023-05-12T11:44:21+01:00 Rip out runtime linker/compiler checks - - - - - 18666055 by Ben Gamari at 2023-05-12T11:44:22+01:00 configure: Rip out toolchain selection logic - - - - - a511952b by Ben Gamari at 2023-05-12T11:44:22+01:00 Fixes - - - - - 9482a102 by Rodrigo Mesquita at 2023-05-12T11:44:22+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - b0d16f22 by Rodrigo Mesquita at 2023-05-12T11:44:22+01:00 Re-introduce ld-override option - - - - - ff99eef9 by Rodrigo Mesquita at 2023-05-12T11:44:22+01:00 ROMES:WIP - - - - - 19f186b3 by Rodrigo Mesquita at 2023-05-12T11:44:22+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 96a84ddf by Rodrigo Mesquita at 2023-05-12T11:44:22+01:00 ROMES: WIP - - - - - 49ab29a0 by Rodrigo Mesquita at 2023-05-12T11:44:23+01:00 Re-introduce flags in hadrian config - - - - - 29ee68e8 by Rodrigo Mesquita at 2023-05-12T11:44:23+01:00 ROMES WIP - - - - - 72da3a97 by Rodrigo Mesquita at 2023-05-12T11:44:23+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f39dea85f6af5960406c14181ddd6dc50a4a1af2...72da3a97a8441714bca5cce0b57b14e4dc8fccaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f39dea85f6af5960406c14181ddd6dc50a4a1af2...72da3a97a8441714bca5cce0b57b14e4dc8fccaf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 10:58:07 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 12 May 2023 06:58:07 -0400 Subject: [Git][ghc/ghc][wip/compact-sourcetext] 3 commits: Use compact representation for SourceNotes Message-ID: <645e1bbf40456_26a8061309eee02494a5@gitlab.mail> Zubin pushed to branch wip/compact-sourcetext at Glasgow Haskell Compiler / GHC Commits: 61be3880 by Zubin Duggal at 2023-05-12T16:27:50+05:30 Use compact representation for SourceNotes Metric Decrease: hard_hole_fits - - - - - ff95b6d5 by Zubin Duggal at 2023-05-12T16:27:50+05:30 Use compact representation for UsageFile (#22744) - - - - - 44027418 by Zubin Duggal at 2023-05-12T16:27:50+05:30 testsuite: add test for T22744 - - - - - 22 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Types/IPE.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/Module/Deps.hs - testsuite/tests/perf/compiler/Makefile - testsuite/tests/perf/compiler/all.T - + testsuite/tests/perf/compiler/genT22744 Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -839,7 +839,7 @@ data InfoProvEnt = InfoProvEnt -- The rendered Haskell type of the closure the table represents , infoProvModule :: !Module -- Origin module - , infoTableProv :: !(Maybe (RealSrcSpan, String)) } + , infoTableProv :: !(Maybe (RealSrcSpan, LexicalFastString)) } -- Position and information about the info table deriving (Eq, Ord) ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1496,7 +1496,7 @@ withSourceNote :: Located a -> Located b -> CmmParse c -> CmmParse c withSourceNote a b parse = do name <- getName case combineSrcSpans (getLoc a) (getLoc b) of - RealSrcSpan span _ -> code (emitTick (SourceNote span name)) >> parse + RealSrcSpan span _ -> code (emitTick (SourceNote span $ LexicalFastString $ mkFastString name)) >> parse _other -> parse -- ----------------------------------------------------------------------------- ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -144,10 +144,10 @@ basicBlockCodeGen block = do -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of - Just (SourceNote span name) + Just (SourceNote span (LexicalFastString name)) -> do fileId <- getFileId (srcSpanFile span) let line = srcSpanStartLine span; col = srcSpanStartCol span - return $ unitOL $ LOCATION fileId line col name + return $ unitOL $ LOCATION fileId line col (unpackFS name) _ -> return nilOL (mid_instrs,mid_bid) <- stmtsToInstrs id stmts (!tail_instrs,_) <- stmtToInstrs mid_bid tail ===================================== compiler/GHC/CmmToAsm/Dwarf.hs ===================================== @@ -6,6 +6,7 @@ import GHC.Prelude import GHC.Cmm.CLabel import GHC.Cmm.Expr +import GHC.Data.FastString import GHC.Settings.Config ( cProjectName, cProjectVersion ) import GHC.Types.Tickish ( CmmTickish, GenTickish(..) ) import GHC.Cmm.DebugBlock @@ -177,7 +178,8 @@ procToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo procToDwarf config prc = DwarfSubprogram { dwChildren = map (blockToDwarf config) (dblBlocks prc) , dwName = case dblSourceTick prc of - Just s at SourceNote{} -> sourceName s + Just s at SourceNote{} -> case sourceName s of + LexicalFastString s -> unpackFS s _otherwise -> show (dblLabel prc) , dwLabel = dblCLabel prc , dwParent = fmap mkAsmTempDieLabel ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -129,10 +129,10 @@ basicBlockCodeGen block = do -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of - Just (SourceNote span name) + Just (SourceNote span (LexicalFastString name)) -> do fileid <- getFileId (srcSpanFile span) let line = srcSpanStartLine span; col =srcSpanStartCol span - return $ unitOL $ LOCATION fileid line col name + return $ unitOL $ LOCATION fileid line col (unpackFS name) _ -> return nilOL mid_instrs <- stmtsToInstrs stmts tail_instrs <- stmtToInstrs tail ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -196,10 +196,10 @@ basicBlockCodeGen block = do -- Generate location directive dbg <- getDebugBlock (entryLabel block) loc_instrs <- case dblSourceTick =<< dbg of - Just (SourceNote span name) + Just (SourceNote span (LexicalFastString name)) -> do fileId <- getFileId (srcSpanFile span) let line = srcSpanStartLine span; col = srcSpanStartCol span - return $ unitOL $ LOCATION fileId line col name + return $ unitOL $ LOCATION fileId line col (unpackFS name) _ -> return nilOL (mid_instrs,mid_bid) <- stmtsToInstrs id stmts (!tail_instrs,_) <- stmtToInstrs mid_bid tail ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -578,7 +578,7 @@ toIfaceOneShot id | isId id toIfaceTickish :: CoreTickish -> Maybe IfaceTickish toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push) toIfaceTickish (HpcTick modl ix) = Just (IfaceHpcTick modl ix) -toIfaceTickish (SourceNote src names) = Just (IfaceSource src names) +toIfaceTickish (SourceNote src (LexicalFastString names)) = Just (IfaceSource src names) toIfaceTickish (Breakpoint {}) = Nothing -- Ignore breakpoints, since they are relevant only to GHCi, and -- should not be serialised (#8333) ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -314,7 +314,7 @@ mkDataConWorkers generate_debug_info mod_loc data_tycons | Just file <- ml_hs_file mod_loc = tick (span1 file) | otherwise = tick (span1 "???") where tick span = Tick $ SourceNote span $ - renderWithContext defaultSDocContext $ ppr name + LexicalFastString $ mkFastString $ renderWithContext defaultSDocContext $ ppr name span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1 {- ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -1182,24 +1182,23 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do , tick_label = boxLabel } - cc_name | topOnly = head decl_path - | otherwise = concat (intersperse "." decl_path) + cc_name | topOnly = mkFastString $ head decl_path + | otherwise = mkFastString $ concat (intersperse "." decl_path) env <- getEnv case tickishType env of HpcTicks -> HpcTick (this_mod env) <$> addMixEntry me ProfNotes -> do - let nm = mkFastString cc_name - flavour <- mkHpcCCFlavour <$> getCCIndexM nm - let cc = mkUserCC nm (this_mod env) pos flavour + flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name + let cc = mkUserCC cc_name (this_mod env) pos flavour count = countEntries && tte_countEntries env return $ ProfNote cc count True{-scopes-} Breakpoints -> Breakpoint noExtField <$> addMixEntry me <*> pure ids SourceNotes | RealSrcSpan pos' _ <- pos -> - return $ SourceNote pos' cc_name + return $ SourceNote pos' $ LexicalFastString cc_name _otherwise -> panic "mkTickish: bad source span!" ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Data.Maybe +import GHC.Data.FastString import Data.IORef import Data.List (sortBy) @@ -86,7 +87,7 @@ mkUsageInfo uc plugins fc unit_env this_mod dir_imp_mods used_names dependent_fi let all_home_ids = ue_all_home_unit_ids unit_env mod_usages <- mk_mod_usage_info uc hu all_home_ids this_mod dir_imp_mods used_names - let usages = mod_usages ++ [ UsageFile { usg_file_path = f + let usages = mod_usages ++ [ UsageFile { usg_file_path = mkFastString f , usg_file_hash = hash , usg_file_label = Nothing } | (f, hash) <- zip dependent_files hashes ] @@ -174,7 +175,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do msg m = moduleNameString (moduleName m) ++ "[TH] changed" - fing mmsg fn = UsageFile fn <$> lookupFileCache fc fn <*> pure mmsg + fing mmsg fn = UsageFile (mkFastString fn) <$> lookupFileCache fc fn <*> pure mmsg unlinkedToUsage m ul = case nameOfObject_maybe ul of ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -1175,7 +1175,7 @@ pprUsage usage at UsageHomeModule{} ) pprUsage usage at UsageFile{} = hsep [text "addDependentFile", - doubleQuotes (text (usg_file_path usage)), + doubleQuotes (ftext (usg_file_path usage)), ppr (usg_file_hash usage)] pprUsage usage at UsageMergedRequirement{} = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)] ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -771,12 +771,12 @@ checkModUsage fc UsageFile{ usg_file_path = file, usg_file_label = mlabel } = liftIO $ handleIO handler $ do - new_hash <- lookupFileCache fc file + new_hash <- lookupFileCache fc $ unpackFS file if (old_hash /= new_hash) then return recomp else return UpToDate where - reason = FileChanged file + reason = FileChanged $ unpackFS file recomp = needsRecompileBecause $ fromMaybe reason $ fmap CustomReason mlabel handler = if debugIsOn then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -45,6 +45,7 @@ module GHC.Iface.Syntax ( import GHC.Prelude +import GHC.Data.FastString import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey, constraintKindTyConKey ) import GHC.Types.Unique ( hasKey ) @@ -577,7 +578,7 @@ data IfaceExpr data IfaceTickish = IfaceHpcTick Module Int -- from HpcTick x | IfaceSCC CostCentre Bool Bool -- from ProfNote - | IfaceSource RealSrcSpan String -- from SourceNote + | IfaceSource RealSrcSpan FastString -- from SourceNote -- no breakpoints: we never export these into interface files data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1651,7 +1651,7 @@ tcIfaceExpr (IfaceTick tickish expr) = do tcIfaceTickish :: IfaceTickish -> IfM lcl CoreTickish tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix) tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push) -tcIfaceTickish (IfaceSource src name) = return (SourceNote src name) +tcIfaceTickish (IfaceSource src name) = return (SourceNote src (LexicalFastString name)) ------------------------- tcIfaceLit :: Literal -> IfL Literal ===================================== compiler/GHC/Stg/Debug.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Types.Tickish import GHC.Core.DataCon import GHC.Types.IPE import GHC.Unit.Module -import GHC.Types.Name ( getName, getOccName, occNameString, nameSrcSpan) +import GHC.Types.Name ( getName, getOccName, occNameFS, nameSrcSpan) import GHC.Data.FastString import Control.Monad (when) @@ -29,7 +29,7 @@ import Control.Applicative import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty(..)) -data SpanWithLabel = SpanWithLabel RealSrcSpan String +data SpanWithLabel = SpanWithLabel RealSrcSpan LexicalFastString data StgDebugOpts = StgDebugOpts { stgDebug_infoTableMap :: !Bool @@ -74,7 +74,7 @@ collectStgRhs bndr (StgRhsClosure ext cc us bs e t) = do -- If the name has a span, use that initially as the source position in-case -- we don't get anything better. with_span = case nameSrcSpan name of - RealSrcSpan pos _ -> withSpan (pos, occNameString (getOccName name)) + RealSrcSpan pos _ -> withSpan (pos, LexicalFastString $ occNameFS (getOccName name)) _ -> id e' <- with_span $ collectExpr e recordInfo bndr e' @@ -92,7 +92,7 @@ recordInfo bndr new_rhs = do -- A span from the ticks surrounding the new_rhs best_span = quickSourcePos thisFile new_rhs -- A back-up span if the bndr had a source position, many do not (think internally generated ids) - bndr_span = (\s -> SpanWithLabel s (occNameString (getOccName bndr))) + bndr_span = (\s -> SpanWithLabel s (LexicalFastString $ occNameFS (getOccName bndr))) <$> srcSpanToRealSrcSpan (nameSrcSpan (getName bndr)) recordStgIdPosition bndr best_span bndr_span ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -5,11 +5,12 @@ import GHC.Platform import GHC.Unit.Module import GHC.Utils.Outputable import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) -import GHC.Data.FastString (fastStringToShortText) +import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..)) import GHC.Cmm.CLabel import GHC.Cmm.Expr import GHC.Cmm.Utils + import GHC.StgToCmm.Config import GHC.StgToCmm.Lit (newByteStringCLit) import GHC.StgToCmm.Monad @@ -67,7 +68,7 @@ toCgIPE platform ctx module_name ipe = do table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe)) closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe) type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe - let label_str = maybe "" snd (infoTableProv ipe) + let label_str = maybe "" ((\(LexicalFastString s) -> unpackFS s) . snd) (infoTableProv ipe) let (src_loc_file, src_loc_span) = case infoTableProv ipe of Nothing -> (mempty, "") ===================================== compiler/GHC/Types/IPE.hs ===================================== @@ -9,6 +9,7 @@ module GHC.Types.IPE ( import GHC.Prelude import GHC.Types.Name +import GHC.Data.FastString import GHC.Types.SrcLoc import GHC.Core.DataCon @@ -20,7 +21,7 @@ import qualified Data.Map.Strict as Map -- | Position and information about an info table. -- For return frames these are the contents of a 'CoreSyn.SourceNote'. -type IpeSourceLocation = (RealSrcSpan, String) +type IpeSourceLocation = (RealSrcSpan, LexicalFastString) -- | A map from a 'Name' to the best approximate source position that -- name arose from. ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Types.Tickish ( ) where import GHC.Prelude +import GHC.Data.FastString import GHC.Core.Type @@ -153,8 +154,8 @@ data GenTickish pass = -- necessary to enable optimizations. | SourceNote { sourceSpan :: RealSrcSpan -- ^ Source covered - , sourceName :: String -- ^ Name for source location - -- (uses same names as CCs) + , sourceName :: LexicalFastString -- ^ Name for source location + -- (uses same names as CCs) } deriving instance Eq (GenTickish 'TickishPassCore) ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -21,6 +21,8 @@ where import GHC.Prelude +import GHC.Data.FastString + import GHC.Types.SafeHaskell import GHC.Types.Name @@ -275,7 +277,7 @@ data Usage -- | A file upon which the module depends, e.g. a CPP #include, or using TH's -- 'addDependentFile' | UsageFile { - usg_file_path :: FilePath, + usg_file_path :: FastString, -- ^ External file dependency. From a CPP #include or TH -- addDependentFile. Should be absolute. usg_file_hash :: Fingerprint, ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -32,3 +32,8 @@ MultiLayerModulesTH_OneShot_Prep: MultiLayerModulesTH_Make_Prep InstanceMatching: ./genMatchingTest 0 '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface Defs.hs + +T22744: + ./genT22744 + '$(TEST_HC)' $(TEST_HC_OPTS) T22744.hs + ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -670,3 +670,14 @@ test('RecordUpdPerf', ], multimod_compile, ['RecordUpdPerf', '-fno-code -v0']) + +test('T22744', + [ collect_compiler_stats('peak_megabytes_allocated',20), + req_interp, + pre_cmd('$MAKE -s --no-print-directory T22744'), + extra_files(['genT22744']), + compile_timeout_multiplier(2) + ], + multimod_compile, + ['T22744', '-v0']) + ===================================== testsuite/tests/perf/compiler/genT22744 ===================================== @@ -0,0 +1,28 @@ +#!/usr/bin/env bash + +NUMDEP=10000 +NUMMOD=100 + +seq 1 $NUMDEP | xargs -I{} touch foo{} + +cat > T22744.hs << EOF +module Main where +EOF + +for i in $(seq $NUMMOD); do + cat > M$i.hs << EOF +{-# LANGUAGE TemplateHaskell #-} +module M$i where +import Language.Haskell.TH.Syntax +import Control.Monad + +\$(do forM_ [1..$NUMDEP] $ \i -> addDependentFile $ "foo" ++ show i + return []) +EOF + echo "import M$i" >> T22744.hs +done + +cat >> T22744.hs << EOF +main = pure () +EOF + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/403a9818044974ce86415909caef836ff98338fa...44027418ebd05b1311933f3f066a642ab5b5f06c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/403a9818044974ce86415909caef836ff98338fa...44027418ebd05b1311933f3f066a642ab5b5f06c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 11:15:31 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 07:15:31 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] configure: Drop unused AC_PROG_CPP Message-ID: <645e1fd3d2418_26a806134e62002521dc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: 1aea4a06 by Rodrigo Mesquita at 2023-05-12T12:10:10+01:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -330,6 +330,18 @@ if test x"$TablesNextToCode" = xYES; then fi AC_SUBST(TablesNextToCode) +dnl ** Does target have runtime linker support? +dnl -------------------------------------------------------------- +case "$target" in + powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*) + TargetHasRTSLinker=NO + ;; + *) + TargetHasRTSLinker=YES + ;; +esac +AC_SUBST(TargetHasRTSLinker) + # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT @@ -465,9 +477,6 @@ MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0]) dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS -dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) -AC_PROG_CPP - # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1aea4a06554eb85db825ecaf51911a23695d6acc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1aea4a06554eb85db825ecaf51911a23695d6acc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 11:16:14 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 07:16:14 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] 209 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <645e1ffe42b4c_26a80613489384252372@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 741ad261 by Rodrigo Mesquita at 2023-05-12T12:15:43+01:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1aea4a06554eb85db825ecaf51911a23695d6acc...741ad261cd6b40232b665f168984b9f409538564 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1aea4a06554eb85db825ecaf51911a23695d6acc...741ad261cd6b40232b665f168984b9f409538564 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 11:39:15 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 12 May 2023 07:39:15 -0400 Subject: [Git][ghc/ghc][wip/T23083] 21 commits: Add fused multiply-add instructions Message-ID: <645e2563f3531_26a806132f9d842612eb@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - d5e5e835 by Sebastian Graf at 2023-05-12T13:37:28+02:00 Cleanup a TODO introduced in 1f94e0f7 The change must have slipped through review of !4412 - - - - - 39dfb943 by Sebastian Graf at 2023-05-12T13:37:28+02:00 More explicit strictness in GHC.Real - - - - - e6de6042 by Sebastian Graf at 2023-05-12T13:37:28+02:00 exprIsTrivial: Factor out shared implementation The duplication between `exprIsTrivial` and `getIdFromTrivialExpr_maybe` has been bugging me for a long time. This patch introduces an inlinable worker function `trivial_expr_fold` acting as the single, shared decision procedure of triviality. It "returns" a Church-encoded `Maybe (Maybe Id)`, so when it is inlined, it fuses to similar code as before. (Better code, even, in the case of `getIdFromTrivialExpr` which presently allocates a `Just` constructor that cancels away after this patch.) - - - - - d6ffcd8a by Sebastian Graf at 2023-05-12T13:37:28+02:00 Simplify: Simplification of arguments in a single function The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. - - - - - e5bb6b71 by Sebastian Graf at 2023-05-12T13:37:28+02:00 Core.Ppr: Omit case binder for empty case alternatives A minor improvement to pretty-printing - - - - - 043a90d4 by Sebastian Graf at 2023-05-12T13:37:28+02:00 Inlining literals into boring contexts is OK - - - - - 7fc7a2b2 by Sebastian Graf at 2023-05-12T13:37:28+02:00 Kill SetLevel.notWorthFloating.is_triv (#23270) We have had it since b84ba676034, when it operated on annotated expressions. Nowadays it operates on vanilla `CoreExpr` though, so we should just call `exprIsTrivial`; thus handling empty cases and string literals correctly. - - - - - 120f90a8 by Sebastian Graf at 2023-05-12T13:37:29+02:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Fixes #23270. - - - - - 8c7b3670 by Sebastian Graf at 2023-05-12T13:37:29+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - 90bbf404 by Sebastian Graf at 2023-05-12T13:37:29+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - 4fc83c91 by Sebastian Graf at 2023-05-12T13:39:02+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d9de75154147c86782f9b7192d4d2764c235021...4fc83c9106657a7927428689a3d0077077032f36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d9de75154147c86782f9b7192d4d2764c235021...4fc83c9106657a7927428689a3d0077077032f36 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 12:11:47 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Fri, 12 May 2023 08:11:47 -0400 Subject: [Git][ghc/ghc][wip/amg/tweak-co-opt] Address review feedback Message-ID: <645e2d031c4ff_26a8061309ae58270898@gitlab.mail> Adam Gundry pushed to branch wip/amg/tweak-co-opt at Glasgow Haskell Compiler / GHC Commits: 6846ec0e by Adam Gundry at 2023-05-09T09:05:33+01:00 Address review feedback - - - - - 1 changed file: - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -803,9 +803,11 @@ opt_trans_rule is co1 co2 -- Push transitivity inside axioms opt_trans_rule is co1 co2 - -- See Note [Push transitivity inside axioms] + -- See Note [Push transitivity inside axioms] and + -- Note [Push transitivity inside newtype axioms only] -- TrPushSymAxR | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos2 <- matchAxiom sym con ind co2 , let newAxInst = AxiomInstCo con ind (opt_transList is (map mkSymCo cos2) cos1) @@ -813,6 +815,7 @@ opt_trans_rule is co1 co2 -- TrPushAxR | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos2 <- matchAxiom sym con ind co2 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) @@ -820,6 +823,7 @@ opt_trans_rule is co1 co2 -- TrPushSymAxL | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 , let newAxInst = AxiomInstCo con ind (opt_transList is cos2 (map mkSymCo cos1)) @@ -827,6 +831,7 @@ opt_trans_rule is co1 co2 -- TrPushAxL | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) @@ -970,13 +975,13 @@ Not only are there no cancellation opportunities here, but calling matchAxiom repeatedly down the transitive chain is very expensive. Hence we do not attempt to push transitivity inside type family axioms. See #8095, !9210 and related tickets. -This is implemented by isAxiom_maybe checking that the axiom is for a newtype -constructor (i.e. not a type family). Adding this single guard substantially +This is implemented by opt_trans_rule checking that the axiom is for a newtype +constructor (i.e. not a type family). Adding these guards substantially improved performance (reduced bytes allocated by more than 10%) for the tests CoOpt_Singletons, LargeRecord, T12227, T12545, T13386, T15703, T5030, T8095. -A side benefit is that we do not encounter difficulties with confict checking -for branched axioms; see Note [Why call checkAxInstCo during optimisation]. +A side benefit is that we do not risk accidentally creating an ill-typed +coercion; see Note [Why call checkAxInstCo during optimisation]. There may exist programs that previously relied on pushing transitivity inside type family axioms to avoid creating huge coercions, which will regress in @@ -1107,7 +1112,6 @@ isAxiom_maybe (SymCo co) | Just (sym, con, ind, cos) <- isAxiom_maybe co = Just (not sym, con, ind, cos) isAxiom_maybe (AxiomInstCo con ind cos) - | isNewTyCon (coAxiomTyCon con) -- See Note [Push transitivity inside newtype axioms only] = Just (False, con, ind, cos) isAxiom_maybe _ = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6846ec0e2d21011e6119414a5002aab1395cca77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6846ec0e2d21011e6119414a5002aab1395cca77 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 12:15:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 08:15:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Don't panic in mkNewTyConRhs Message-ID: <645e2ddaae8cd_26a806132f9d842716bb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 1126ec62 by Simon Peyton Jones at 2023-05-12T08:15:08-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - d8340596 by Alexis King at 2023-05-12T08:15:18-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/967f1758b97889e6d30ca429b5f07b00ff6ec6e7...d834059621153f4fd56b6687058a2255cd38591d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/967f1758b97889e6d30ca429b5f07b00ff6ec6e7...d834059621153f4fd56b6687058a2255cd38591d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 12:48:14 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 08:48:14 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Handle passing CPP cmd and flags from configure to ghc-toolchain Message-ID: <645e358e38135_26a806124f0dc8285964@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: ef11d608 by Rodrigo Mesquita at 2023-05-12T13:48:08+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - 3 changed files: - configure.ac - − m4/fp_cpp_cmd_with_args.m4 - m4/ghc_toolchain.m4 Changes: ===================================== configure.ac ===================================== @@ -448,11 +448,37 @@ MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0]) dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS -dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) -AC_PROG_CPP - # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HaskellCPPCmd=$withval + fi +], +[ + # We can't use $CPP here, since HaskellCPPCmd is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HaskellCPPCmd=$CC +] +) +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HaskellCPPArgs=$withval + fi + ], +[ HaskellCPPArgs="" ] +) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) ===================================== m4/fp_cpp_cmd_with_args.m4 deleted ===================================== @@ -1,69 +0,0 @@ -# FP_CPP_CMD_WITH_ARGS() -# ---------------------- -# sets CPP command and its arguments -# -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], -[ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_CMD=$withval - fi -], -[ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - -] -) - -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], -[ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" - else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi - fi - ] -) - -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS - -]) - ===================================== m4/ghc_toolchain.m4 ===================================== @@ -20,11 +20,13 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--triple=$target" >> acargs echo "--cc=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - # TODO (previously we had in configure script use of --traditional??) - # First thing disable the comment: - # Also, differentiatiate between hscpp and cpp? - #echo "--cpp=$CPP" >> acargs + + # We can't use $CPP, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + echo "--cpp=$HaskellCPPCmd" >> acargs + # ROMES:TODO: CONF_CPP_OPTS_STAGE1 vs HaskellCPPArgs ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) + echo "--cc-link=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) echo "--cxx=$CXX" >> acargs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef11d6086beb968266186bf172f690d53e974860 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef11d6086beb968266186bf172f690d53e974860 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 12:58:06 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 12 May 2023 08:58:06 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Fixes Message-ID: <645e37deed458_26a8061309ae582886ae@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: e9d00762 by Simon Peyton Jones at 2023-05-12T13:59:53+01:00 Fixes - - - - - 7 changed files: - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -81,7 +81,7 @@ solveDict dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = tys }) ; tryFunDeps dict_ct ; tryLastResortProhibitedSuperClass dict_ct ; simpleStage (updInertDicts dict_ct) - ; Stage (stopWith (dictCtEvidence dict_ct) "Kept inert DictCt") } + ; stopWithStage (dictCtEvidence dict_ct) "Kept inert DictCt" } updInertDicts :: DictCt -> TcS () updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev }) ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -8,10 +8,10 @@ module GHC.Tc.Solver.Equality( import GHC.Prelude +import GHC.Tc.Solver.Irred( solveIrred ) +import GHC.Tc.Solver.Dict( matchLocalInst, chooseInstance ) import GHC.Tc.Solver.Rewrite import GHC.Tc.Solver.Monad -import GHC.Tc.Solver.Irred( tryInertIrreds ) -import GHC.Tc.Solver.Dict( matchLocalInst, chooseInstance ) import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Types( findFunEqsByTyCon ) import GHC.Tc.Types.Evidence @@ -122,14 +122,14 @@ solveEquality ev eq_rel ty1 ty2 Right eq_ct -> do { tryInertEqs eq_ct ; tryFunDeps eq_ct ; tryQCsEqCt eq_ct - ; simpleStage (updInertEqs eq_ct) } } } + ; simpleStage (updInertEqs eq_ct) + ; stopWithStage (eqCtEvidence eq_ct) "Kept inert EqCt" } } } updInertEqs :: EqCt -> TcS () -updInertEqs eq_ct@(EqCt { eq_lhs = lhs, eq_ev = ev, eq_eq_rel = eq_rel }) - = do { ics <- getInertCans - ; (_, ics') <- kickOutRewritable (ctEvFlavour ev, eq_rel) lhs ics - ; tclvl <- getTcLevel - ; updInertCans (updateGivenEqs tc_lvl (CEqCan eq_ct) . +updInertEqs eq_ct + = do { _n_kicked <- kickOutRewritable (eqCtFlavourRole eq_ct) (eqCtLHS eq_ct) + ; tc_lvl <- getTcLevel + ; updInertCans (updGivenEqs tc_lvl (CEqCan eq_ct) . addEqToCans eq_ct) } ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Tc.Solver.InertSet ( addInertItem, addInertDict, noMatchableGivenDicts, - noGivenNewtypeReprEqs, + noGivenNewtypeReprEqs, updGivenEqs, mightEqualLater, prohibitedSuperClassSolve, @@ -37,7 +37,7 @@ module GHC.Tc.Solver.InertSet ( -- * Inert Irreds InertIrreds, delIrred, addIrreds, addIrred, foldIrreds, - findMatchingIrreds, + findMatchingIrreds, updIrreds, -- * Kick-out kickOutRewritableLHS, @@ -591,7 +591,7 @@ InertCans tracks -- (see Note [Unification preconditions] in GHC.Tc.Utils.Unify). We update inert_given_eq_lvl whenever we add a Given to the -inert set, in updateGivenEqs. +inert set, in updGivenEqs. Then a unification variable alpha[n] is untouchable iff n < inert_given_eq_lvl @@ -617,7 +617,7 @@ should update inert_given_eq_lvl? same example again, but this time we have /not/ yet unified beta: forall[2] beta[1] => ...blah... - Because beta might turn into an equality, updateGivenEqs conservatively + Because beta might turn into an equality, updGivenEqs conservatively treats it as a potential equality, and updates inert_give_eq_lvl * What about something like forall[2] a b. a ~ F b => [W] alpha[1] ~ X y z? @@ -627,7 +627,7 @@ should update inert_given_eq_lvl? implication. Such equalities need not make alpha untouchable. (Test case typecheck/should_compile/LocalGivenEqs has a real-life motivating example, with some detailed commentary.) - Hence the 'mentionsOuterVar' test in updateGivenEqs. + Hence the 'mentionsOuterVar' test in updGivenEqs. However, solely to support better error messages (see Note [HasGivenEqs] in GHC.Tc.Types.Constraint) we also track @@ -1431,13 +1431,13 @@ addInertItem :: TcLevel -> InertCans -> Ct -> InertCans addInertItem tc_lvl ics@(IC { inert_funeqs = funeqs, inert_eqs = eqs }) item@(CEqCan eq_ct) - = updateGivenEqs tc_lvl item $ + = updGivenEqs tc_lvl item $ case eq_lhs eq_ct of TyFamLHS tc tys -> ics { inert_funeqs = addCanFunEq funeqs tc tys eq_ct } TyVarLHS tv -> ics { inert_eqs = addTyEq eqs tv eq_ct } addInertItem tc_lvl ics@(IC { inert_irreds = irreds }) ct@(CIrredCan irred) - = updateGivenEqs tc_lvl ct $ -- An Irred might turn out to be an + = updGivenEqs tc_lvl ct $ -- An Irred might turn out to be an -- equality, so we play safe ics { inert_irreds = irreds `snocBag` irred } @@ -1450,12 +1450,12 @@ addInertItem _ _ item addInertDict :: DictCt -> InertCans -> InertCans addInertDict dict ics = ics { inert_dicts = addDict dict (inert_dicts ics) } -updateGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans +updGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans -- Set the inert_given_eq_level to the current level (tclvl) -- if the constraint is a given equality that should prevent -- filling in an outer unification variable. -- See Note [Tracking Given equalities] -updateGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl }) +updGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl }) | not (isGivenCt ct) = inerts | not_equality ct = inerts -- See Note [Let-bound skolems] | otherwise = inerts { inert_given_eq_lvl = ge_lvl' ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -35,16 +35,14 @@ solveIrred :: IrredCt -> SolverStage () solveIrred irred = do { tryInertIrreds irred ; tryQCsIrredCt irred - ; simpleStage (updInertIrreds irred) } - + ; simpleStage (updInertIrreds irred) + ; stopWithStage (irredCtEvidence irred) "Kept inert IrredCt" } updInertIrreds :: IrredCt -> TcS () updInertIrreds irred = do { tc_lvl <- getTcLevel - ; updInertCans $ (updateGivenEqs tc_lvl (CIrredCan irred) . - updIrreds (addIrred irred)) - ; traceFireTcS (irredCtEvidence irred) - (text "Added Irred to inert set") } + ; updInertCans $ (updGivenEqs tc_lvl (CIrredCan irred) . + updIrreds (addIrred irred)) } {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -34,6 +34,7 @@ module GHC.Tc.Solver.Monad ( -- The pipeline StopOrContinue(..), continueWith, stopWith, startAgainWith, SolverStage(Stage, runSolverStage), simpleStage, + stopWithStage, -- Tracing etc panicTcS, traceTcS, @@ -71,12 +72,12 @@ module GHC.Tc.Solver.Monad ( getTcSInerts, setTcSInerts, getUnsolvedInerts, removeInertCts, getPendingGivenScs, - addInertCan, insertFunEq, addInertForAll, + insertFunEq, addInertForAll, emitWorkNC, emitWork, lookupInertDict, -- The Model - kickOutAfterUnification, + kickOutAfterUnification, kickOutRewritable, -- Inert Safe Haskell safe-overlap failures addInertSafehask, insertSafeOverlapFailureTcS, updInertSafehask, @@ -252,6 +253,9 @@ continueWith ct = return (ContinueWith ct) stopWith :: CtEvidence -> String -> TcS (StopOrContinue a) stopWith ev s = return (Stop ev (text s)) +stopWithStage :: CtEvidence -> String -> SolverStage a +stopWithStage ev s = Stage (stopWith ev s) + {- ********************************************************************* * * @@ -325,6 +329,7 @@ When adding an equality to the inerts: -} +{- addInertCan :: Ct -> TcS () -- Precondition: item /is/ canonical -- See Note [Adding an equality to the InertCans] @@ -349,16 +354,18 @@ maybeKickOut ics ct | otherwise = return ics +-} ----------------------------------------- kickOutRewritable :: CtFlavourRole -- Flavour/role of the equality that -- is being added to the inert set -> CanEqLHS -- The new equality is lhs ~ ty - -> InertCans - -> TcS (Int, InertCans) -kickOutRewritable new_fr new_lhs ics - = do { let (kicked_out, ics') = kickOutRewritableLHS new_fr new_lhs ics + -> TcS Int +kickOutRewritable new_fr new_lhs + = do { ics <- getInertCans + ; let (kicked_out, ics') = kickOutRewritableLHS new_fr new_lhs ics n_kicked = lengthBag kicked_out + ; setInertCans ics' ; unless (isEmptyBag kicked_out) $ do { emitWork kicked_out @@ -385,18 +392,13 @@ kickOutRewritable new_fr new_lhs ics , text "kicked_out =" <+> ppr kicked_out , text "Residual inerts =" <+> ppr ics' ]) } - ; return (n_kicked, ics') } + ; return n_kicked } kickOutAfterUnification :: TcTyVar -> TcS Int kickOutAfterUnification new_tv - = do { ics <- getInertCans - ; (n_kicked, ics2) <- kickOutRewritable (Given,NomEq) - (TyVarLHS new_tv) ics - -- Given because the tv := xi is given; NomEq because - -- only nominal equalities are solved by unification - - ; setInertCans ics2 - ; return n_kicked } + = kickOutRewritable (Given,NomEq) (TyVarLHS new_tv) + -- Given because the tv := xi is given; NomEq because + -- only nominal equalities are solved by unification -- See Wrinkle (W2a) in Note [Equalities with incompatible kinds] in GHC.Tc.Solver.Equality -- It's possible that this could just go ahead and unify, but could there be occurs-check ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -569,8 +569,8 @@ runTcPluginsGiven do { p <- runTcPluginSolvers solvers (givens,[]) ; let (solved_givens, _) = pluginSolvedCts p insols = map (ctIrredCt PluginReason) (pluginBadCts p) - ; updInertCans (removeInertCts solved_givens) - ; updInertIrreds (addIrreds insols) + ; updInertCans (removeInertCts solved_givens . + updIrreds (addIrreds insols) ) ; return (pluginNewCts p) } } } -- | Given a bag of (rewritten, zonked) wanteds, invoke the plugins on ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -6,11 +6,8 @@ -- | This module defines types and simple operations over constraints, as used -- in the type-checker and constraint solver. module GHC.Tc.Types.Constraint ( - -- QCInst - QCInst(..), pendingScInst_maybe, - - -- Canonical constraints - Xi, Ct(..), EqCt(..), Cts, + -- Constraints + Xi, Ct(..), Cts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, emptyCts, andCts, ctsPreds, isPendingScDictCt, isPendingScDict, pendingScDict_maybe, @@ -23,14 +20,16 @@ module GHC.Tc.Types.Constraint ( ctRewriters, ctEvId, wantedEvId_maybe, mkTcEqPredLikeEv, mkNonCanonical, mkGivens, - ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel, - ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId, - ctEvRewriters, tyCoVarsOfCt, tyCoVarsOfCts, tyCoVarsOfCtList, tyCoVarsOfCtsList, - DictCt(..), dictCtEvidence, - IrredCt(..), mkIrredCt, ctIrredCt, irredCtEvidence, irredCtPred, + -- Particular forms of constraint + EqCt(..), eqCtEvidence, eqCtLHS, + DictCt(..), dictCtEvidence, + IrredCt(..), irredCtEvidence, mkIrredCt, ctIrredCt, irredCtPred, + + -- QCInst + QCInst(..), pendingScInst_maybe, ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, assertFuelPrecondition, assertFuelPreconditionStrict, @@ -75,12 +74,15 @@ module GHC.Tc.Types.Constraint ( -- CtEvidence CtEvidence(..), TcEvDest(..), - mkKindEqLoc, toKindLoc, toInvisibleLoc, mkGivenLoc, isWanted, isGiven, + ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel, + ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId, + ctEvRewriters, ctEvUnique, tcEvDestUnique, + mkKindEqLoc, toKindLoc, toInvisibleLoc, mkGivenLoc, ctEvRole, setCtEvPredType, setCtEvLoc, arisesFromGivens, tyCoVarsOfCtEvList, tyCoVarsOfCtEv, tyCoVarsOfCtEvsList, - ctEvUnique, tcEvDestUnique, + -- RewriterSet RewriterSet(..), emptyRewriterSet, isEmptyRewriterSet, -- exported concretely only for anyUnfilledCoercionHoles addRewriter, unitRewriterSet, unionRewriterSet, rewriterSetFromCts, @@ -300,6 +302,12 @@ instance Outputable CanEqLHS where ppr (TyVarLHS tv) = ppr tv ppr (TyFamLHS fam_tc fam_args) = ppr (mkTyConApp fam_tc fam_args) +eqCtEvidence :: EqCt -> CtEvidence +eqCtEvidence = eq_ev + +eqCtLHS :: EqCt -> CanEqLHS +eqCtLHS = eq_lhs + --------------- IrredCt -------------- data IrredCt -- These stand for yet-unusable predicates View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9d00762824ef56c779625597acb7536f0425e89 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9d00762824ef56c779625597acb7536f0425e89 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 14:03:24 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 10:03:24 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 4 commits: ROMES WIP Message-ID: <645e472cc072b_26a80612d05784309087@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: c0994e19 by Rodrigo Mesquita at 2023-05-12T15:03:08+01:00 ROMES WIP - - - - - 5effd627 by Rodrigo Mesquita at 2023-05-12T15:03:13+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 10c05b78 by Rodrigo Mesquita at 2023-05-12T15:03:13+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - 96257cb0 by Rodrigo Mesquita at 2023-05-12T15:03:13+01:00 Rip more of configure that is no longer being used - - - - - 13 changed files: - compiler/GHC/Linker/Static.hs - configure.ac - hadrian/src/Builder.hs - hadrian/src/Rules/Libffi.hs - − m4/fp_cpp_cmd_with_args.m4 - m4/fptools_set_haskell_platform_vars.m4 - − m4/ghc_adjustors_method.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Prelude.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== compiler/GHC/Linker/Static.hs ===================================== @@ -69,6 +69,7 @@ linkBinary = linkBinary' False linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO () linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do + -- ROMES:TODO: A big part of this ought to be configured by ghc-toolchain let platform = ue_platform unit_env unit_state = ue_units unit_env toolSettings' = toolSettings dflags @@ -239,6 +240,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do then ["-Wl,-read_only_relocs,suppress"] else []) + -- We should rather be asking does it support --gc-sections? ++ (if toolSettings_ldIsGnuLd toolSettings' && not (gopt Opt_WholeArchiveHsLibs dflags) then ["-Wl,--gc-sections"] ===================================== configure.ac ===================================== @@ -448,11 +448,37 @@ MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0]) dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS -dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) -AC_PROG_CPP - # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HaskellCPPCmd=$withval + fi +], +[ + # We can't use $CPP here, since HaskellCPPCmd is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HaskellCPPCmd=$CC +] +) +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HaskellCPPArgs=$withval + fi + ], +[ HaskellCPPArgs="" ] +) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -979,14 +1005,14 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap], [Use mmap in the runtime linker]) -# TODO: Unregisterised, TablesNextToCode -TablesNextToCode=YES -AC_SUBST([TablesNextToCode]) -Unregisterised=YES -AC_SUBST([Unregisterised]) - +AC_ARG_ENABLE(libffi-adjustors, + [AS_HELP_STRING( + [--enable-libffi-adjustors], + [Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors.])], + UseLibffiForAdjustors=$enableval, + dnl do nothing +) -GHC_ADJUSTORS_METHOD([Target]) AC_SUBST([UseLibffiForAdjustors]) dnl ** Other RTS features ===================================== hadrian/src/Builder.hs ===================================== @@ -43,6 +43,10 @@ import qualified Data.ByteString as BS import qualified GHC.Foreign as GHC import GHC.ResponseFile +import GHC.Toolchain (Target(..)) +import qualified GHC.Toolchain as Toolchain +import GHC.Toolchain.Program + -- | C compiler can be used in two different modes: -- * Compile or preprocess a source file. -- * Extract source dependencies by passing @-MM@ command line argument. @@ -402,31 +406,35 @@ runHaddock haddockPath flagArgs fileInputs = withTempFile $ \tmp -> do -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform -- specific optional builders as soon as we can reliably test this feature. -- See https://github.com/snowleopard/hadrian/issues/211. -isOptional :: Builder -> Bool -isOptional = \case +isOptional :: Toolchain.Target -- ^ Some builders are optional depending on the target + -> Builder + -> Bool +isOptional target = \case Objdump -> True -- alex and happy are not required when building source distributions -- and ./configure will complain if they are not available when building in-tree Happy -> True Alex -> True + -- Most ar implemententions no longer need ranlib, but some still do + Ranlib -> not $ Toolchain.arNeedsRanlib (tgtAr target) _ -> False -- | Determine the location of a system 'Builder'. systemBuilderPath :: Builder -> Action FilePath systemBuilderPath builder = case builder of Alex -> fromKey "alex" - Ar _ (Stage0 {})-> fromKey "system-ar" - Ar _ _ -> fromKey "ar" + Ar _ (Stage0 {})-> fromHostTC "system-ar" (Toolchain.arMkArchive . tgtAr) + Ar _ _ -> fromTargetTC "ar" (Toolchain.arMkArchive . tgtAr) Autoreconf _ -> stripExe =<< fromKey "autoreconf" - Cc _ (Stage0 {}) -> fromKey "system-cc" - Cc _ _ -> fromKey "cc" + Cc _ (Stage0 {}) -> fromHostTC "system-cc" (Toolchain.ccProgram . tgtCCompiler) + Cc _ _ -> fromTargetTC "cc" (Toolchain.ccProgram . tgtCCompiler) -- We can't ask configure for the path to configure! Configure _ -> return "configure" Ghc _ (Stage0 {}) -> fromKey "system-ghc" GhcPkg _ (Stage0 {}) -> fromKey "system-ghc-pkg" Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" - Ld _ -> fromKey "ld" + Ld _ -> fromTargetTC "ld" (Toolchain.ccLinkProgram . tgtCCompilerLink) -- MergeObjects Stage0 is a special case in case of -- cross-compiling. We're building stage1, e.g. code which will be -- executed on the host and hence we need to use host's merge @@ -435,15 +443,15 @@ systemBuilderPath builder = case builder of -- parameters. E.g. building a cross-compiler on and for x86_64 -- which will target ppc64 means that MergeObjects Stage0 will use -- x86_64 linker and MergeObject _ will use ppc64 linker. - MergeObjects (Stage0 {}) -> fromKey "system-merge-objects" - MergeObjects _ -> fromKey "merge-objects" + MergeObjects (Stage0 {}) -> fromHostTC "system-merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs) + MergeObjects _ -> fromTargetTC "merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs) Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" - Nm -> fromKey "nm" + Nm -> fromTargetTC "nm" (Toolchain.nmProgram . tgtNm) Objdump -> fromKey "objdump" Patch -> fromKey "patch" Python -> fromKey "python" - Ranlib -> fromKey "ranlib" + Ranlib -> fromTargetTC "ranlib" (maybeProg Toolchain.ranlibProgram . tgtRanlib) Testsuite _ -> fromKey "python" Sphinx _ -> fromKey "sphinx-build" Tar _ -> fromKey "tar" @@ -459,10 +467,24 @@ systemBuilderPath builder = case builder of let unpack = fromMaybe . error $ "Cannot find path to builder " ++ quote key ++ inCfg ++ " Did you skip configure?" path <- unpack <$> lookupValue configFile key + validate key path + + -- Get program from the host's target configuration + fromHostTC keyname key = do + path <- queryHostTargetConfig (prgPath . key) + validate keyname path + + -- Get program from the target's target configuration + fromTargetTC keyname key = do + path <- queryTargetTargetConfig (prgPath . key) + validate keyname path + + validate keyname path = do + target <- getTargetTargetConfig if null path then do - unless (isOptional builder) . error $ "Non optional builder " - ++ quote key ++ " is not specified" ++ inCfg + unless (isOptional target builder) . error $ "Non optional builder " + ++ quote keyname ++ " is not specified" ++ inCfg return "" -- TODO: Use a safe interface. else do -- angerman: I find this lookupInPath rather questionable. @@ -488,6 +510,8 @@ systemBuilderPath builder = case builder of exists <- doesFileExist s if exists then return s else return sNoExt + maybeProg = maybe (Program "" []) + -- | Was the path to a given system 'Builder' specified in configuration files? isSpecified :: Builder -> Action Bool ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -135,7 +135,11 @@ configureEnvironment stage = do ldFlags <- interpretInContext context ldArgs sequence [ builderEnvironment "CC" $ Cc CompileC stage , builderEnvironment "CXX" $ Cc CompileC stage - , builderEnvironment "LD" (Ld stage) + -- , builderEnvironment "LD" (Ld stage) -- Libffi is a C library, + -- it will use c compiler to link, not LD + -- ROMES: Ben's money on this not being used + -- If configure or deps ask for LD ... + -- try to, at least. , builderEnvironment "AR" (Ar Unpack stage) , builderEnvironment "NM" Nm , builderEnvironment "RANLIB" Ranlib ===================================== m4/fp_cpp_cmd_with_args.m4 deleted ===================================== @@ -1,69 +0,0 @@ -# FP_CPP_CMD_WITH_ARGS() -# ---------------------- -# sets CPP command and its arguments -# -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], -[ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_CMD=$withval - fi -], -[ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - -] -) - -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], -[ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" - else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi - fi - ] -) - -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS - -]) - ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -1,133 +1,3 @@ -# FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS -# ---------------------------------- -# Drop in shell functions used by FPTOOLS_SET_HASKELL_PLATFORM_VARS -AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS], -[ - checkArch() { - case [$]1 in - i386) - test -z "[$]2" || eval "[$]2=ArchX86" - ;; - x86_64|amd64) - test -z "[$]2" || eval "[$]2=ArchX86_64" - ;; - powerpc) - test -z "[$]2" || eval "[$]2=ArchPPC" - ;; - powerpc64) - test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V1\"" - ;; - powerpc64le) - test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V2\"" - ;; - s390x) - test -z "[$]2" || eval "[$]2=ArchS390X" - ;; - arm) - GET_ARM_ISA() - test -z "[$]2" || eval "[$]2=\"ArchARM \$ARM_ISA \$ARM_ISA_EXT \$ARM_ABI\"" - ;; - aarch64) - test -z "[$]2" || eval "[$]2=ArchAArch64" - ;; - alpha) - test -z "[$]2" || eval "[$]2=ArchAlpha" - ;; - mips|mipseb) - test -z "[$]2" || eval "[$]2=ArchMipseb" - ;; - mipsel) - test -z "[$]2" || eval "[$]2=ArchMipsel" - ;; - riscv64) - test -z "[$]2" || eval "[$]2=ArchRISCV64" - ;; - wasm32) - test -z "[$]2" || eval "[$]2=ArchWasm32" - ;; - loongarch64) - test -z "[$]2" || eval "[$]2=ArchLoongArch64" - ;; - hppa|hppa1_1|ia64|m68k|nios2|riscv32|loongarch32|rs6000|s390|sh4|vax) - test -z "[$]2" || eval "[$]2=ArchUnknown" - ;; - javascript) - test -z "[$]2" || eval "[$]2=ArchJavaScript" - ;; - *) - echo "Unknown arch [$]1" - exit 1 - ;; - esac - } - - checkVendor() { - case [$]1 in - dec|none|unknown|hp|apple|next|sun|sgi|ibm|montavista|portbld|alpine) - ;; - *) - AC_MSG_WARN([Unknown vendor [$]1]) - ;; - esac - } - - checkOS() { - case [$]1 in - linux|linux-android) - test -z "[$]2" || eval "[$]2=OSLinux" - ;; - darwin|ios|watchos|tvos) - test -z "[$]2" || eval "[$]2=OSDarwin" - ;; - solaris2) - test -z "[$]2" || eval "[$]2=OSSolaris2" - ;; - mingw32|windows) - test -z "[$]2" || eval "[$]2=OSMinGW32" - ;; - freebsd) - test -z "[$]2" || eval "[$]2=OSFreeBSD" - ;; - dragonfly) - test -z "[$]2" || eval "[$]2=OSDragonFly" - ;; - kfreebsdgnu) - test -z "[$]2" || eval "[$]2=OSKFreeBSD" - ;; - openbsd) - test -z "[$]2" || eval "[$]2=OSOpenBSD" - ;; - netbsd) - test -z "[$]2" || eval "[$]2=OSNetBSD" - ;; - haiku) - test -z "[$]2" || eval "[$]2=OSHaiku" - ;; - nto-qnx) - test -z "[$]2" || eval "[$]2=OSQNXNTO" - ;; - wasi) - test -z "[$]2" || eval "[$]2=OSWasi" - ;; - dragonfly|hpux|linuxaout|freebsd2|nextstep2|nextstep3|sunos4|ultrix) - test -z "[$]2" || eval "[$]2=OSUnknown" - ;; - aix) - test -z "[$]2" || eval "[$]2=OSAIX" - ;; - gnu) - test -z "[$]2" || eval "[$]2=OSHurd" - ;; - ghcjs|js) - test -z "[$]2" || eval "[$]2=OSUnknown" - ;; - *) - echo "Unknown OS '[$]1'" - exit 1 - ;; - esac - } -]) # Note [autoconf assembler checks and -flto] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -223,13 +93,3 @@ AC_DEFUN([GHC_GNU_NONEXEC_STACK], CFLAGS="$CFLAGS2" ]) -# FPTOOLS_SET_HASKELL_PLATFORM_VARS -# ---------------------------------- -# Set the Haskell platform variables -AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS], -[ - AC_REQUIRE([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS]) - checkArch "[$]$1Arch" "Haskell$1Arch" - checkVendor "[$]$1Vendor" - checkOS "[$]$1OS" "Haskell$1Os" -]) ===================================== m4/ghc_adjustors_method.m4 deleted ===================================== @@ -1,49 +0,0 @@ -dnl GHC_ADJUSTORS_METHOD(Platform) -dnl -------------------------------------------------------------- -dnl Use libffi for adjustors? -AC_DEFUN([GHC_ADJUSTORS_METHOD], -[ - case [$]{$1[Arch]} in - i386|x86_64) - # We have native adjustor support on these platforms - HaveNativeAdjustor=yes - ;; - *) - HaveNativeAdjustor=no - ;; - esac - - AC_ARG_ENABLE(libffi-adjustors, - [AS_HELP_STRING( - [--enable-libffi-adjustors], - [Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors.])], - UseLibffiForAdjustors=$enableval, - dnl do nothing - ) - - AC_MSG_CHECKING([whether to use libffi for adjustors]) - if test "$UseLibffiForAdjustors" = "yes" ; then - # Use libffi is the user explicitly requested it - AdjustorType="libffi" - elif test "$HaveNativeAdjustor" = "yes"; then - # Otherwise if we have a native adjustor implementation use that - AdjustorType="native" - else - # If we don't have a native adjustor implementation then default to libffi - AdjustorType="libffi" - fi - - case "$AdjustorType" in - libffi) - UseLibffiForAdjustors=YES - AC_MSG_RESULT([yes]) - ;; - native) - UseLibffiForAdjustors=NO - AC_MSG_RESULT([no]) - ;; - *) - AC_MSG_ERROR([Internal error: Invalid AdjustorType]) - exit 1 - esac -]) ===================================== m4/ghc_toolchain.m4 ===================================== @@ -20,11 +20,13 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--triple=$target" >> acargs echo "--cc=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - # TODO (previously we had in configure script use of --traditional??) - # First thing disable the comment: - # Also, differentiatiate between hscpp and cpp? - #echo "--cpp=$CPP" >> acargs + + # We can't use $CPP, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + echo "--cpp=$HaskellCPPCmd" >> acargs + # ROMES:TODO: CONF_CPP_OPTS_STAGE1 vs HaskellCPPArgs ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) + echo "--cc-link=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) echo "--cxx=$CXX" >> acargs ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE LambdaCase #-} module Main where @@ -44,6 +45,7 @@ data Opts = Opts , optDllwrap :: ProgOpt , optUnregisterised :: Maybe Bool , optTablesNextToCode :: Maybe Bool + , optUseLibFFIForAdjustors :: Maybe Bool , optLdOverride :: Maybe Bool , optVerbosity :: Int , optKeepTemp :: Bool @@ -66,6 +68,7 @@ emptyOpts = Opts , optWindres = po0 , optUnregisterised = Nothing , optTablesNextToCode = Nothing + , optUseLibFFIForAdjustors = Nothing , optLdOverride = Nothing -- See comment in Link on 'enableOverride'. Shouldn't we set the default here? , optVerbosity = 0 , optKeepTemp = False @@ -100,6 +103,9 @@ _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) _optTablesNextToCode :: Lens Opts (Maybe Bool) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) +_optUseLibFFIForAdjustors :: Lens Opts (Maybe Bool) +_optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) + _optLdOvveride :: Lens Opts (Maybe Bool) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) @@ -119,6 +125,7 @@ options = concat [ enableDisable "unregisterised" "unregisterised backend" _optUnregisterised , enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode + , enableDisable "libffi-adjustors" "Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride ] ++ concat @@ -250,6 +257,26 @@ determineTablesNextToCode archOs unreg userReq = where tntcSupported = tablesNextToCodeSupported archOs +determineUseLibFFIForAdjustors :: ArchOS + -> Maybe Bool -- ^ Enable/disable option --libffi-adjustors + -> M Bool +determineUseLibFFIForAdjustors archOs mb = checking "whether to use libffi for adjustors" $ + case mb of + Just True -> + -- The user explicitly requested it + pure True + + _ -> + -- If don't have a native adjustor implementation we use libffi + pure (not . archHasNativeAdjustors $ archOS_arch archOs) -- If we + +archHasNativeAdjustors :: Arch -> Bool +archHasNativeAdjustors = \case + ArchX86 -> True + ArchX86_64 -> True + _ -> False + + mkTarget :: Opts -> M Target mkTarget opts = do cc0 <- findCc (optCc opts) @@ -290,6 +317,7 @@ mkTarget opts = do tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) tgtTablesNextToCode <- determineTablesNextToCode archOs tgtUnregisterised (optTablesNextToCode opts) + tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these let prog = "int main(int argc, char** argv) { return 0; }I" @@ -314,6 +342,7 @@ mkTarget opts = do , tgtEndianness , tgtUnregisterised , tgtTablesNextToCode + , tgtUseLibffiForAdjustors = tgtUseLibffi , tgtSymbolsHaveLeadingUnderscore , tgtSupportsSubsectionsViaSymbols , tgtSupportsIdentDirective ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -12,6 +12,7 @@ module GHC.Toolchain.Monad -- * File I/O , readFile , writeFile + , appendFile , createFile -- * Logging @@ -21,7 +22,7 @@ module GHC.Toolchain.Monad , withLogContext ) where -import Prelude hiding (readFile, writeFile) +import Prelude hiding (readFile, writeFile, appendFile) import qualified Prelude import Control.Applicative @@ -31,7 +32,9 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.Except as Except -import System.IO hiding (readFile, writeFile) +import System.IO hiding (readFile, writeFile, appendFile) +-- import qualified System.Directory + data Env = Env { verbosity :: Int , targetPrefix :: Maybe String @@ -98,6 +101,14 @@ readFile path = liftIO $ Prelude.readFile path writeFile :: FilePath -> String -> M () writeFile path s = liftIO $ Prelude.writeFile path s +appendFile :: FilePath -> String -> M () +appendFile path s = liftIO $ Prelude.appendFile path s + +-- copyFile :: FilePath -- ^ Source file +-- -> FilePath -- ^ Destination file +-- -> M () +-- copyFile src dst = liftIO $ System.Directory.copyFile src dst + -- | Create an empty file. createFile :: FilePath -> M () createFile path = writeFile path "" ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Prelude.hs ===================================== @@ -8,4 +8,4 @@ module GHC.Toolchain.Prelude import GHC.Toolchain.Monad import GHC.Toolchain.Lens import Control.Applicative -import Prelude hiding (writeFile, readFile) +import Prelude hiding (writeFile, readFile, appendFile) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -29,7 +29,7 @@ data Endianness = LittleEndian | BigEndian data Target = Target { -- Platform tgtArchOs :: ArchOS - -- , tgtCrossCompiling :: Bool -- TODO: Rename hostCanExecute? + -- , tgtCrossCompiling :: Bool -- TODO: Rename hostCanExecute? We probably don't need this. , tgtSupportsGnuNonexecStack :: Bool , tgtSupportsSubsectionsViaSymbols :: Bool , tgtSupportsIdentDirective :: Bool @@ -41,21 +41,19 @@ data Target = Target -- GHC capabilities , tgtUnregisterised :: Bool , tgtTablesNextToCode :: Bool - -- , tgtHasRtsLinker :: Bool -- Hmm? - -- , tgtHasThreadedRts :: Bool - -- , tgtUseLibffi :: Bool + -- , tgtHasRtsLinker :: Bool -- NO NEED! Rebase on MR removing it. + -- , tgtHasThreadedRts :: Bool -- Do we need this for each target? Or just when bootstrapping? + , tgtUseLibffiForAdjustors :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it -- C toolchain , tgtCCompiler :: Cc , tgtCxxCompiler :: Cxx - , tgtCPreprocessor :: Cpp + , tgtCPreprocessor :: Cpp -- if hadrian depends on Cpp (not HsCpp flags) then this isn't sufficient , tgtCCompilerLink :: CcLink - -- , tgtLd :: Program -- needed? - -- , tgtLdSupportsCompactUnwind :: Bool - -- , tgtLdSupportsFilelist :: Bool - -- , tgtLdIsGnuLd :: Bool -- needed? + -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler + -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed) , tgtAr :: Ar - , tgtRanlib :: Maybe Ranlib + , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it , tgtNm :: Nm , tgtMergeObjs :: Maybe MergeObjs ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -18,7 +18,9 @@ import GHC.Toolchain.Tools.Readelf -- | Configuration on how the C compiler can be used to link data CcLink = CcLink { ccLinkProgram :: Program - , ccLinkSupportsNoPie :: Bool + , ccLinkSupportsNoPie :: Bool -- Does have to be a separate settings. Sometimes we do want to use PIE + , ccLinkSupportsCompactUnwind :: Bool -- Argument to be made about this being part of the cclink flags + , ccLinkSupportsFilelist :: Bool -- This too } deriving (Show, Read, Eq, Ord) @@ -32,10 +34,12 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l -- If not then try to find a decent linker on our own rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc] findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink - ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram + ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram + ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram + ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram - return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie} + return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist} -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program @@ -77,8 +81,9 @@ doLinkerSearch = False #endif checkSupportsNoPie :: Program -> M Bool -checkSupportsNoPie ccLink = withTempDir $ \dir -> do - let test_c = dir "test.o" +checkSupportsNoPie ccLink = checking "whether CC supports -no-pie" $ + withTempDir $ \dir -> do + let test_c = dir "test.c" writeFile test_c "int main() { return 0; }" let test = dir "test" @@ -89,6 +94,41 @@ checkSupportsNoPie ccLink = withTempDir $ \dir -> do then return False else return True +checkSupportsCompactUnwind :: Cc -> Program -> M Bool +checkSupportsCompactUnwind cc ccLink = checking "whether ld understands -no_compact_unwind" $ + withTempDir $ \dir -> do + let test_c = dir "test.c" + test_o = dir "test.o" + test2_o = dir "test2.o" + writeFile test_c "int foo() { return 0; }" + callProgram (ccProgram cc) ["-c", test_c] + exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] + pure $ isSuccess exitCode + + +checkSupportsFilelist :: Cc -> Program -> M Bool +checkSupportsFilelist cc ccLink = checking "whether ld understands -filelist" $ + withTempDir $ \dir -> do + let test_o = dir "test.o" + test1_c = dir "test1.c" + test2_c = dir "test2.c" + test1_o = dir "test1.o" + test2_o = dir "test2.o" + test_ofiles = dir "test.o-files" + + writeFile test1_c "int foo() { return 0; }" + writeFile test2_c "int bar() { return 0; }" + + callProgram (ccProgram cc) ["-c", test1_c] + callProgram (ccProgram cc) ["-c", test2_c] + + writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file + appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + + exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] + + pure $ isSuccess exitCode + -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () checkLinkWorks cc ccLink = withTempDir $ \dir -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef11d6086beb968266186bf172f690d53e974860...96257cb0cc5d51fe31859d15d9318bac913a86bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef11d6086beb968266186bf172f690d53e974860...96257cb0cc5d51fe31859d15d9318bac913a86bd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 14:46:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 10:46:41 -0400 Subject: [Git][ghc/ghc][wip/romes/target-has-rts-linker] configure: Drop unused AC_PROG_CPP Message-ID: <645e5151dbae9_26a806ad15ee8314888@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/target-has-rts-linker at Glasgow Haskell Compiler / GHC Commits: 38bbeb7c by Rodrigo Mesquita at 2023-05-12T15:46:31+01:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -465,9 +465,6 @@ MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0]) dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS -dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) -AC_PROG_CPP - # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38bbeb7cbaad6980f377b58081d03e98e957bdf8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38bbeb7cbaad6980f377b58081d03e98e957bdf8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 15:12:12 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 12 May 2023 11:12:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/clean-refactor Message-ID: <645e574c52eef_26a80612d05784315222@gitlab.mail> Matthew Pickering pushed new branch wip/clean-refactor at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/clean-refactor You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 15:23:22 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 11:23:22 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: Remove configure checks of GNUnoexecStack and ident directive Message-ID: <645e59ea4c456_26a8061309eee03154a0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 35b2ead0 by Rodrigo Mesquita at 2023-05-12T15:22:50+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - 64d59e52 by Rodrigo Mesquita at 2023-05-12T15:44:50+01:00 Rip out more from hadrians system.config.in - - - - - e26b6d28 by Rodrigo Mesquita at 2023-05-12T16:23:15+01:00 Configure CLink supports response files - - - - - 8 changed files: - distrib/configure.ac.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_ld_supports_response_files.m4 - m4/fptools_set_haskell_platform_vars.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== distrib/configure.ac.in ===================================== @@ -181,23 +181,6 @@ dnl May need to use gcc to find platform details. dnl -------------------------------------------------------------- FPTOOLS_SET_HASKELL_PLATFORM_VARS([Build]) -FPTOOLS_SET_HASKELL_PLATFORM_VARS([Host]) -AC_SUBST(HaskellHostArch) -AC_SUBST(HaskellHostOs) - -FPTOOLS_SET_HASKELL_PLATFORM_VARS([Target]) -AC_SUBST(HaskellTargetArch) -AC_SUBST(HaskellTargetOs) - -GHC_SUBSECTIONS_VIA_SYMBOLS -AC_SUBST(TargetHasSubsectionsViaSymbols) - -GHC_IDENT_DIRECTIVE -AC_SUBST(TargetHasIdentDirective) - -GHC_GNU_NONEXEC_STACK -AC_SUBST(TargetHasGnuNonexecStack) - dnl ** See whether cc supports --target= and set dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -6,18 +6,13 @@ #=================== alex = @AlexCmd@ -ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ hs-cpp = @HaskellCPPCmd@ -ld = @LdCmd@ make = @MakeCmd@ -nm = @NmCmd@ -merge-objects = @MergeObjsCmd@ system-merge-objects = @LD_STAGE0@ objdump = @ObjdumpCmd@ -ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ @@ -39,9 +34,7 @@ python = @PythonCmd@ # Information about builders: #============================ -ar-supports-at-file = @ArSupportsAtFile@ system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@ -ar-supports-dash-l = @ArSupportsDashL@ system-ar-supports-dash-l = @ArSupportsDashL_STAGE0@ cc-llvm-backend = @CcLlvmBackend@ hs-cpp-args = @HaskellCPPArgs@ @@ -49,8 +42,6 @@ hs-cpp-args = @HaskellCPPArgs@ # Build options: #=============== -ghc-unregisterised = @Unregisterised@ -tables-next-to-code = @TablesNextToCode@ use-libffi-for-adjustors = @UseLibffiForAdjustors@ ghc-source-path = @hardtop@ leading-underscore = @LeadingUnderscore@ @@ -67,16 +58,12 @@ host-platform = @HostPlatform@ host-arch = @HostArch_CPP@ host-os = @HostOS_CPP@ host-vendor = @HostVendor_CPP@ -host-os-haskell = @HaskellHostOs@ -host-arch-haskell = @HaskellHostArch@ target-platform = @TargetPlatform@ target-platform-full = @TargetPlatformFull@ target-arch = @TargetArch_CPP@ target-os = @TargetOS_CPP@ target-vendor = @TargetVendor_CPP@ -target-os-haskell = @HaskellTargetOs@ -target-arch-haskell = @HaskellTargetArch@ llvm-target = @LLVMTarget_CPP@ cross-compiling = @CrossCompiling@ @@ -137,11 +124,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # See Note [tooldir: How GHC finds mingw on Windows] gcc-extra-via-c-opts = @GccExtraViaCOpts@ -ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ -ld-has-filelist = @LdHasFilelist@ -ld-supports-response-files = @LdSupportsResponseFiles@ ld-is-gnu-ld = @LdIsGNULd@ -ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ @@ -169,11 +152,7 @@ settings-use-distro-mingw = @SettingsUseDistroMINGW@ target-word-size = @TargetWordSize@ target-word-big-endian = @TargetWordBigEndian@ -target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@ -target-has-ident-directive = @TargetHasIdentDirective@ -target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@ target-has-libm = @TargetHasLibm@ -target-arm-version = @ARM_ISA@ # Include and library directories: #================================= ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -9,7 +9,7 @@ import qualified Data.Set as Set import Base import qualified Context import Expression -import Hadrian.Oracles.TextFile (lookupSystemConfig, queryHostTargetConfig) +import Hadrian.Oracles.TextFile (lookupSystemConfig, queryTargetTargetConfig) import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting @@ -425,14 +425,14 @@ generateSettings = do , ("Haskell CPP flags", expr $ settingsFileSetting ToolchainSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting ToolchainSetting_LdCommand) , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) - , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") - , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") + , ("ld supports compact unwind", expr $ queryTargetTargetConfig linkSupportsCompactUnwind) + , ("ld supports filelist", expr $ queryTargetTargetConfig ldSupportsFilelist) , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting ToolchainSetting_MergeObjectsCommand) , ("Merge objects flags", expr $ settingsFileSetting ToolchainSetting_MergeObjectsFlags) , ("ar command", expr $ settingsFileSetting ToolchainSetting_ArCommand) - , ("ar flags", expr $ queryHostTargetConfig (unwords . prgFlags . Toolchain.arMkArchive . Toolchain.tgtAr)) + , ("ar flags", expr $ queryTargetTargetConfig arFlags) , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ar supports -L", expr $ yesNo <$> flag ArSupportsDashL) , ("ranlib command", expr $ settingsFileSetting ToolchainSetting_RanlibCommand) @@ -474,6 +474,11 @@ generateSettings = do ("[" ++ showTuple s) : ((\s' -> "," ++ showTuple s') <$> ss) ++ ["]"] + where + ldSupportsFilelist = yesNo . Toolchain.ccLinkSupportsFilelist . Toolchain.tgtCCompilerLink + linkSupportsCompactUnwind = yesNo . Toolchain.ccLinkSupportsCompactUnwind . Toolchain.tgtCCompilerLink + arFlags = unwords . prgFlags . Toolchain.arMkArchive . Toolchain.tgtAr + -- | Generate @Config.hs@ files. ===================================== m4/fp_ld_supports_response_files.m4 deleted ===================================== @@ -1,19 +0,0 @@ -# FP_LD_SUPPORTS_RESPONSE_FILES -# -------------------- -# See if whether we are using a version of ld which supports response files. -AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ - AC_MSG_CHECKING([whether $LD supports response files]) - echo 'int main(void) {return 0;}' > conftest.c - "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf '%q\n' -o conftest conftest.o > args.txt - if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 - then - LdSupportsResponseFiles=YES - AC_MSG_RESULT([yes]) - else - LdSupportsResponseFiles=NO - AC_MSG_RESULT([no]) - fi - rm -f conftest.c conftest args.txt - AC_SUBST(LdSupportsResponseFiles) -]) ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -40,56 +40,4 @@ AC_DEFUN([GHC_SUBSECTIONS_VIA_SYMBOLS], AC_MSG_RESULT(no)]) ]) -# GHC_IDENT_DIRECTIVE -# ---------------------------------- -# check for .ident assembler directive -AC_DEFUN([GHC_IDENT_DIRECTIVE], -[ - AC_MSG_CHECKING(whether your assembler supports .ident directive) - dnl See Note [autoconf assembler checks and -flto] - AC_LINK_IFELSE( - [AC_LANG_PROGRAM([__asm__ (".ident \"GHC x.y.z\"");], [])], - [AC_MSG_RESULT(yes) - TargetHasIdentDirective=YES], - [AC_MSG_RESULT(no) - TargetHasIdentDirective=NO]) -]) - -# GHC_GNU_NONEXEC_STACK -# ---------------------------------- -# *** check for GNU non-executable stack note support (ELF only) -# (.section .note.GNU-stack,"", at progbits) -# -# This test doesn't work with "gcc -g" in gcc 4.4 (GHC trac #3889: -# Error: can't resolve `.note.GNU-stack' {.note.GNU-stack section} - `.Ltext0' {.text section} -# so we empty CFLAGS while running this test -AC_DEFUN([GHC_GNU_NONEXEC_STACK], -[ - CFLAGS2="$CFLAGS" - CFLAGS= - case $TargetArch in - arm) - dnl See #13937. - progbits="%progbits" - ;; - *) - progbits="@progbits" - ;; - esac - AC_MSG_CHECKING(for GNU non-executable stack support) - dnl See Note [autoconf assembler checks and -flto] - AC_LINK_IFELSE( - dnl the `main` function is placed after the .note.GNU-stack directive - dnl so we need to ensure that the active segment is correctly set, - dnl otherwise `main` will be placed in the wrong segment. - [AC_LANG_PROGRAM([ - __asm__ (".section .note.GNU-stack,\"\",$progbits"); - __asm__ (".section .text"); - ], [0])], - [AC_MSG_RESULT(yes) - TargetHasGnuNonexecStack=YES], - [AC_MSG_RESULT(no) - TargetHasGnuNonexecStack=NO]) - CFLAGS="$CFLAGS2" -]) - +# ROMES:TODO: We can't still remove this because of the DEFINE HAVE_SUBSECTIONS_VIA_SYMBOLS 1, which is used in the rts ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -265,7 +265,6 @@ determineUseLibFFIForAdjustors archOs mb = checking "whether to use libffi for a Just True -> -- The user explicitly requested it pure True - _ -> -- If don't have a native adjustor implementation we use libffi pure (not . archHasNativeAdjustors $ archOS_arch archOs) -- If we ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -124,7 +124,7 @@ checkGnuNonexecStack archOs = ArchARM{} -> "%progbits" -- See #13937 _ -> "@progbits" - prog = unlines [ asmStmt ".section .note.GNU-stack,\"\","++progbits + prog = unlines [ asmStmt (".section .note.GNU-stack,\"\","++progbits) , asmStmt ".section .text" ] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -21,6 +21,7 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsNoPie :: Bool -- Does have to be a separate settings. Sometimes we do want to use PIE , ccLinkSupportsCompactUnwind :: Bool -- Argument to be made about this being part of the cclink flags , ccLinkSupportsFilelist :: Bool -- This too + , ccLinkSupportsResponseFiles :: Bool } deriving (Show, Read, Eq, Ord) @@ -37,9 +38,10 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram + ccLinkSupportsResponseFiles <- checkSupportsResponseFiles cc ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram - return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist} + return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles} -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program @@ -81,7 +83,7 @@ doLinkerSearch = False #endif checkSupportsNoPie :: Program -> M Bool -checkSupportsNoPie ccLink = checking "whether CC supports -no-pie" $ +checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ withTempDir $ \dir -> do let test_c = dir "test.c" writeFile test_c "int main() { return 0; }" @@ -95,32 +97,26 @@ checkSupportsNoPie ccLink = checking "whether CC supports -no-pie" $ else return True checkSupportsCompactUnwind :: Cc -> Program -> M Bool -checkSupportsCompactUnwind cc ccLink = checking "whether ld understands -no_compact_unwind" $ +checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ withTempDir $ \dir -> do - let test_c = dir "test.c" - test_o = dir "test.o" + let test_o = dir "o" test2_o = dir "test2.o" - writeFile test_c "int foo() { return 0; }" - callProgram (ccProgram cc) ["-c", test_c] + + compileC cc test_o "int foo() { return 0; }" + exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] pure $ isSuccess exitCode - checkSupportsFilelist :: Cc -> Program -> M Bool -checkSupportsFilelist cc ccLink = checking "whether ld understands -filelist" $ +checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ withTempDir $ \dir -> do let test_o = dir "test.o" - test1_c = dir "test1.c" - test2_c = dir "test2.c" test1_o = dir "test1.o" test2_o = dir "test2.o" test_ofiles = dir "test.o-files" - writeFile test1_c "int foo() { return 0; }" - writeFile test2_c "int bar() { return 0; }" - - callProgram (ccProgram cc) ["-c", test1_c] - callProgram (ccProgram cc) ["-c", test2_c] + compileC cc test1_o "int foo() { return 0; }" + compileC cc test2_o "int bar() { return 0; }" writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file @@ -129,6 +125,21 @@ checkSupportsFilelist cc ccLink = checking "whether ld understands -filelist" $ pure $ isSuccess exitCode +checkSupportsResponseFiles :: Cc -> Program -> M Bool +checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ + withTempDir $ \dir -> do + let test_o = dir "test.o" + compileC cc test_o "int main(void) {return 0;}" + + let args_txt = dir "args.txt" + out = dir "test" + writeFile args_txt (unlines ["-o", out, test_o]) + + -- TODO: It'd be good to shortcircuit this logical `or` + exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] + exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] + pure (isSuccess exitCode1 || isSuccess exitCode2) + -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () checkLinkWorks cc ccLink = withTempDir $ \dir -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96257cb0cc5d51fe31859d15d9318bac913a86bd...e26b6d285f0709528519c952a668bb82d7c40aff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96257cb0cc5d51fe31859d15d9318bac913a86bd...e26b6d285f0709528519c952a668bb82d7c40aff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 15:25:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 11:25:17 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Configure CLink supports response files Message-ID: <645e5a5da37cc_26a80612d057843159d8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 5295cbf8 by Rodrigo Mesquita at 2023-05-12T16:25:09+01:00 Configure CLink supports response files - - - - - 3 changed files: - hadrian/src/Rules/Generate.hs - − m4/fp_ld_supports_response_files.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -427,7 +427,7 @@ generateSettings = do , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) , ("ld supports compact unwind", expr $ queryTargetTargetConfig linkSupportsCompactUnwind) , ("ld supports filelist", expr $ queryTargetTargetConfig ldSupportsFilelist) - , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") + , ("ld supports response files", expr $ queryTargetTargetConfig ldSupportsResponseFiles) , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting ToolchainSetting_MergeObjectsCommand) , ("Merge objects flags", expr $ settingsFileSetting ToolchainSetting_MergeObjectsFlags) @@ -475,6 +475,7 @@ generateSettings = do : ((\s' -> "," ++ showTuple s') <$> ss) ++ ["]"] where + ldSupportsResponseFiles = yesNo . Toolchain.ccLinkSupportsResponseFiles . Toolchain.tgtCCompilerLink ldSupportsFilelist = yesNo . Toolchain.ccLinkSupportsFilelist . Toolchain.tgtCCompilerLink linkSupportsCompactUnwind = yesNo . Toolchain.ccLinkSupportsCompactUnwind . Toolchain.tgtCCompilerLink arFlags = unwords . prgFlags . Toolchain.arMkArchive . Toolchain.tgtAr ===================================== m4/fp_ld_supports_response_files.m4 deleted ===================================== @@ -1,19 +0,0 @@ -# FP_LD_SUPPORTS_RESPONSE_FILES -# -------------------- -# See if whether we are using a version of ld which supports response files. -AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ - AC_MSG_CHECKING([whether $LD supports response files]) - echo 'int main(void) {return 0;}' > conftest.c - "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf '%q\n' -o conftest conftest.o > args.txt - if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 - then - LdSupportsResponseFiles=YES - AC_MSG_RESULT([yes]) - else - LdSupportsResponseFiles=NO - AC_MSG_RESULT([no]) - fi - rm -f conftest.c conftest args.txt - AC_SUBST(LdSupportsResponseFiles) -]) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -21,6 +21,7 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsNoPie :: Bool -- Does have to be a separate settings. Sometimes we do want to use PIE , ccLinkSupportsCompactUnwind :: Bool -- Argument to be made about this being part of the cclink flags , ccLinkSupportsFilelist :: Bool -- This too + , ccLinkSupportsResponseFiles :: Bool } deriving (Show, Read, Eq, Ord) @@ -37,9 +38,10 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram + ccLinkSupportsResponseFiles <- checkSupportsResponseFiles cc ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram - return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist} + return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles} -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program @@ -81,7 +83,7 @@ doLinkerSearch = False #endif checkSupportsNoPie :: Program -> M Bool -checkSupportsNoPie ccLink = checking "whether CC supports -no-pie" $ +checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ withTempDir $ \dir -> do let test_c = dir "test.c" writeFile test_c "int main() { return 0; }" @@ -95,32 +97,26 @@ checkSupportsNoPie ccLink = checking "whether CC supports -no-pie" $ else return True checkSupportsCompactUnwind :: Cc -> Program -> M Bool -checkSupportsCompactUnwind cc ccLink = checking "whether ld understands -no_compact_unwind" $ +checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ withTempDir $ \dir -> do - let test_c = dir "test.c" - test_o = dir "test.o" + let test_o = dir "o" test2_o = dir "test2.o" - writeFile test_c "int foo() { return 0; }" - callProgram (ccProgram cc) ["-c", test_c] + + compileC cc test_o "int foo() { return 0; }" + exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] pure $ isSuccess exitCode - checkSupportsFilelist :: Cc -> Program -> M Bool -checkSupportsFilelist cc ccLink = checking "whether ld understands -filelist" $ +checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ withTempDir $ \dir -> do let test_o = dir "test.o" - test1_c = dir "test1.c" - test2_c = dir "test2.c" test1_o = dir "test1.o" test2_o = dir "test2.o" test_ofiles = dir "test.o-files" - writeFile test1_c "int foo() { return 0; }" - writeFile test2_c "int bar() { return 0; }" - - callProgram (ccProgram cc) ["-c", test1_c] - callProgram (ccProgram cc) ["-c", test2_c] + compileC cc test1_o "int foo() { return 0; }" + compileC cc test2_o "int bar() { return 0; }" writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file @@ -129,6 +125,21 @@ checkSupportsFilelist cc ccLink = checking "whether ld understands -filelist" $ pure $ isSuccess exitCode +checkSupportsResponseFiles :: Cc -> Program -> M Bool +checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ + withTempDir $ \dir -> do + let test_o = dir "test.o" + compileC cc test_o "int main(void) {return 0;}" + + let args_txt = dir "args.txt" + out = dir "test" + writeFile args_txt (unlines ["-o", out, test_o]) + + -- TODO: It'd be good to shortcircuit this logical `or` + exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] + exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] + pure (isSuccess exitCode1 || isSuccess exitCode2) + -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () checkLinkWorks cc ccLink = withTempDir $ \dir -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5295cbf8b4188f7d8f3b66fecea8cb5394c675b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5295cbf8b4188f7d8f3b66fecea8cb5394c675b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 15:39:51 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 12 May 2023 11:39:51 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Read deleted keys from host and target's target Message-ID: <645e5dc738a33_26a80613489384323751@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 4c6d4b60 by Rodrigo Mesquita at 2023-05-12T16:39:45+01:00 Read deleted keys from host and target's target - - - - - 3 changed files: - hadrian/hadrian.cabal - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -167,6 +167,7 @@ executable hadrian , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 , ghc-toolchain + , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -25,6 +25,7 @@ import Base import GHC.Toolchain import GHC.Toolchain.Program +import GHC.Platform.ArchOS -- | Each 'Setting' comes from the file @hadrian/cfg/system.config@, generated -- by the @configure@ script from the input file @hadrian/cfg/system.config.in at . @@ -135,55 +136,62 @@ data ToolchainSetting -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the -- result. setting :: Setting -> Action String -setting key = lookupSystemConfig $ case key of - BuildArch -> "build-arch" - BuildOs -> "build-os" - BuildPlatform -> "build-platform" - BuildVendor -> "build-vendor" - CursesIncludeDir -> "curses-include-dir" - CursesLibDir -> "curses-lib-dir" - DynamicExtension -> "dynamic-extension" - FfiIncludeDir -> "ffi-include-dir" - FfiLibDir -> "ffi-lib-dir" - GhcMajorVersion -> "ghc-major-version" - GhcMinorVersion -> "ghc-minor-version" - GhcPatchLevel -> "ghc-patch-level" - GhcVersion -> "ghc-version" - GhcSourcePath -> "ghc-source-path" - GmpIncludeDir -> "gmp-include-dir" - GmpLibDir -> "gmp-lib-dir" - HostArch -> "host-arch" - HostOs -> "host-os" - HostPlatform -> "host-platform" - HostVendor -> "host-vendor" - HostArchHaskell -> "host-arch-haskell" - HostOsHaskell -> "host-os-haskell" - IconvIncludeDir -> "iconv-include-dir" - IconvLibDir -> "iconv-lib-dir" - LibdwIncludeDir -> "libdw-include-dir" - LibdwLibDir -> "libdw-lib-dir" - LibnumaIncludeDir -> "libnuma-include-dir" - LibnumaLibDir -> "libnuma-lib-dir" - LlvmTarget -> "llvm-target" - ProjectGitCommitId -> "project-git-commit-id" - ProjectName -> "project-name" - ProjectVersion -> "project-version" - ProjectVersionMunged -> "project-version-munged" - ProjectVersionInt -> "project-version-int" - ProjectPatchLevel -> "project-patch-level" - ProjectPatchLevel1 -> "project-patch-level1" - ProjectPatchLevel2 -> "project-patch-level2" - SystemGhc -> "system-ghc" - TargetArch -> "target-arch" - TargetArmVersion -> "target-arm-version" - TargetOs -> "target-os" - TargetPlatform -> "target-platform" - TargetPlatformFull -> "target-platform-full" - TargetVendor -> "target-vendor" - TargetArchHaskell -> "target-arch-haskell" - TargetOsHaskell -> "target-os-haskell" - TargetWordSize -> "target-word-size" - BourneShell -> "bourne-shell" +setting key = case key of + BuildArch -> systemConf "build-arch" + BuildOs -> systemConf "build-os" + BuildPlatform -> systemConf "build-platform" + BuildVendor -> systemConf "build-vendor" + CursesIncludeDir -> systemConf "curses-include-dir" + CursesLibDir -> systemConf "curses-lib-dir" + DynamicExtension -> systemConf "dynamic-extension" + FfiIncludeDir -> systemConf "ffi-include-dir" + FfiLibDir -> systemConf "ffi-lib-dir" + GhcMajorVersion -> systemConf "ghc-major-version" + GhcMinorVersion -> systemConf "ghc-minor-version" + GhcPatchLevel -> systemConf "ghc-patch-level" + GhcVersion -> systemConf "ghc-version" + GhcSourcePath -> systemConf "ghc-source-path" + GmpIncludeDir -> systemConf "gmp-include-dir" + GmpLibDir -> systemConf "gmp-lib-dir" + -- ROMES:TODO: What's the difference between hostArch and hostArchHaskell? + HostArch -> systemConf "host-arch" + HostOs -> systemConf "host-os" + HostPlatform -> systemConf "host-platform" + HostVendor -> systemConf "host-vendor" + HostArchHaskell -> hostConf archStr + HostOsHaskell -> hostConf osStr + IconvIncludeDir -> systemConf "iconv-include-dir" + IconvLibDir -> systemConf "iconv-lib-dir" + LibdwIncludeDir -> systemConf "libdw-include-dir" + LibdwLibDir -> systemConf "libdw-lib-dir" + LibnumaIncludeDir -> systemConf "libnuma-include-dir" + LibnumaLibDir -> systemConf "libnuma-lib-dir" + LlvmTarget -> systemConf "llvm-target" + ProjectGitCommitId -> systemConf "project-git-commit-id" + ProjectName -> systemConf "project-name" + ProjectVersion -> systemConf "project-version" + ProjectVersionMunged -> systemConf "project-version-munged" + ProjectVersionInt -> systemConf "project-version-int" + ProjectPatchLevel -> systemConf "project-patch-level" + ProjectPatchLevel1 -> systemConf "project-patch-level1" + ProjectPatchLevel2 -> systemConf "project-patch-level2" + SystemGhc -> systemConf "system-ghc" + TargetArch -> systemConf "target-arch" + TargetArmVersion -> systemConf "target-arm-version" + TargetOs -> systemConf "target-os" + TargetPlatform -> systemConf "target-platform" + TargetPlatformFull -> systemConf "target-platform-full" + TargetVendor -> systemConf "target-vendor" + TargetArchHaskell -> targetConf archStr + TargetOsHaskell -> targetConf osStr + TargetWordSize -> systemConf "target-word-size" -- targetConf tgtWordSize + BourneShell -> systemConf "bourne-shell" + where + systemConf = lookupSystemConfig + targetConf = queryTargetTargetConfig + hostConf = queryHostTargetConfig + archStr = stringEncodeArch . archOS_arch . tgtArchOs + osStr = stringEncodeOS . archOS_OS . tgtArchOs bootIsStage0 :: Stage -> Stage bootIsStage0 (Stage0 {}) = Stage0 InTreeLibs @@ -213,7 +221,7 @@ settingsFileSetting key = case key of ToolchainSetting_CxxCompilerFlags -> queryHostTargetConfig (flags . cxxProgram . tgtCxxCompiler) ToolchainSetting_CCompilerLinkFlags -> queryHostTargetConfig (flags . ccLinkProgram . tgtCCompilerLink) ToolchainSetting_CCompilerSupportsNoPie -> queryHostTargetConfig (yesNo . ccLinkSupportsNoPie . tgtCCompilerLink) - -- ROMES:TODO: What's the difference between the Ld and CCLink? + -- ROMES:TODO: Rename LdCommand to CCLink ToolchainSetting_LdCommand -> lookupSystemConfig "settings-ld-command" ToolchainSetting_LdFlags -> lookupSystemConfig "settings-ld-flags" ToolchainSetting_MergeObjectsCommand -> queryHostTargetConfig (maybe "" (cmd . mergeObjsProgram) . tgtMergeObjs) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -448,9 +448,9 @@ generateSettings = do , ("target arch", getSetting TargetArchHaskell) , ("target word size", expr $ lookupSystemConfig "target-word-size") , ("target word big endian", expr $ lookupSystemConfig "target-word-big-endian") - , ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack") - , ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive") - , ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols") + , ("target has GNU nonexec stack", expr $ queryTargetTargetConfig (yesNo . Toolchain.tgtSupportsGnuNonexecStack)) + , ("target has .ident directive", expr $ queryTargetTargetConfig (yesNo . Toolchain.tgtSupportsIdentDirective)) + , ("target has subsections via symbols", expr $ queryTargetTargetConfig (yesNo . Toolchain.tgtSupportsSubsectionsViaSymbols)) , ("target has libm", expr $ lookupSystemConfig "target-has-libm") , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised) , ("LLVM target", getSetting LlvmTarget) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c6d4b60af69d90f627c9525fd8a7a95ce5cbf0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c6d4b60af69d90f627c9525fd8a7a95ce5cbf0d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 16:01:51 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 12 May 2023 12:01:51 -0400 Subject: [Git][ghc/ghc][wip/T23070-unify] 11 commits: Add fused multiply-add instructions Message-ID: <645e62efa2da6_26a806134893843280c0@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-unify at Glasgow Haskell Compiler / GHC Commits: 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 3ae2fec5 by Simon Peyton Jones at 2023-05-12T17:03:50+01:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/JS/Transform.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1553a77aeec7c666797cb9659255016de38b26a6...3ae2fec52d0bb74fba4ed3800a4c0aed0514cb3d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1553a77aeec7c666797cb9659255016de38b26a6...3ae2fec52d0bb74fba4ed3800a4c0aed0514cb3d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 16:30:18 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 12 May 2023 12:30:18 -0400 Subject: [Git][ghc/ghc][wip/T23333] 18 commits: ghc-prim: Generalize keepAlive#/touch# in state token type Message-ID: <645e699ab63b7_26a8061309ae583304c6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23333 at Glasgow Haskell Compiler / GHC Commits: b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Platform.hs - compiler/GHC/StgToCmm/Config.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a532f1d91bddf5d068e125a7885b3eed7a5c0fee...eb60ec18eff7943fb9f22b2d2ad29709b56ce02d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a532f1d91bddf5d068e125a7885b3eed7a5c0fee...eb60ec18eff7943fb9f22b2d2ad29709b56ce02d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 16:31:46 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 12 May 2023 12:31:46 -0400 Subject: [Git][ghc/ghc][wip/T23307] 30 commits: rts: Fix data-race in hs_init_ghc Message-ID: <645e69f23e8d4_26a80612d0578433067@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23307 at Glasgow Haskell Compiler / GHC Commits: 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 87c38b0a by Simon Peyton Jones at 2023-05-12T17:33:45+01:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - + compiler/GHC/JS/Optimizer.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/00330bbc4058187033c1f0d989c09b2c807e84da...87c38b0a8c09c11b5f7391d9c5222e5966892e15 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/00330bbc4058187033c1f0d989c09b2c807e84da...87c38b0a8c09c11b5f7391d9c5222e5966892e15 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 16:43:49 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 12 May 2023 12:43:49 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] 69 commits: Add sized primitive literal syntax Message-ID: <645e6cc595335_26a80612d0578434021c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 3ae2fec5 by Simon Peyton Jones at 2023-05-12T17:03:50+01:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 236950d2 by Simon Peyton Jones at 2023-05-12T17:07:58+01:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of GHC.Tc.Solver.Equality. I also added the new type IrredCt (akin to EqCt). Still to come: DictCt. - - - - - 7c8e9a3a by Simon Peyton Jones at 2023-05-12T17:08:26+01:00 Further refactoring In particular make the Irred pipeline one-stage (Just the Dict pipeline is left) - - - - - 78d38fe2 by Simon Peyton Jones at 2023-05-12T17:08:26+01:00 Wibbles - - - - - ac159ddb by Simon Peyton Jones at 2023-05-12T17:08:26+01:00 Wibble2 - - - - - 80cd6792 by Simon Peyton Jones at 2023-05-12T17:09:10+01:00 Begin on the type-class pipeline - - - - - 07b1a4cb by Simon Peyton Jones at 2023-05-12T17:09:41+01:00 Progress - - - - - aa8c0b91 by Simon Peyton Jones at 2023-05-12T17:09:41+01:00 Wibbles - - - - - 682af80c by Simon Peyton Jones at 2023-05-12T17:09:41+01:00 Remove white space - - - - - 5d0ad28b by Simon Peyton Jones at 2023-05-12T17:13:56+01:00 More progress - - - - - 8be74672 by Simon Peyton Jones at 2023-05-12T17:14:55+01:00 More - - - - - a5c5e061 by Simon Peyton Jones at 2023-05-12T17:14:55+01:00 Add GHC.Tc.Solver.Solve - - - - - 33c5bbc8 by Simon Peyton Jones at 2023-05-12T17:20:20+01:00 Fixes - - - - - 95620ac6 by Simon Peyton Jones at 2023-05-12T17:24:03+01:00 Wibbles - - - - - 278d5c57 by Simon Peyton Jones at 2023-05-12T17:45:03+01:00 Fixes - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9d00762824ef56c779625597acb7536f0425e89...278d5c57490b23439e71917919800f4a0fac9725 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9d00762824ef56c779625597acb7536f0425e89...278d5c57490b23439e71917919800f4a0fac9725 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 18:01:07 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 May 2023 14:01:07 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <645e7ee3db928_171ad9bcebc968e9@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: d272ff9b by Ben Gamari at 2023-05-12T10:41:44-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,202 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType, tyConsOfTypes) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp, isDataConName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (showToHeader) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc ["-package=" ++ pkg_nm, "-dppr-cols=1000"] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + -- Javascript backend + , "GHC.JS.Prim" + , "GHC.JS.Foreign.Callback" + -- Event manager + , "GHC.Event.Manager" + , "GHC.Event.TimerManager" + , "GHC.Event.Internal.Types" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + -- These only exist on 32-bit platforms + map mkVarOcc + [ "int64ToInteger" + , "integerToInt64" + , "integerToWord64" + , "word64ToInteger" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | nameOccName nm `elem` ignoredOccNames + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing thing + -- Ignore the RHSs of Foreign.C.Types' data constructors as they are + -- platform dependent + | mod_nm == foreignCTypes + , isDataConName nm = True + | otherwise = False + where + nm = getName thing + mod_nm = moduleName $ nameModule nm + foreignCTypes = mkModuleName "Foreign.C.Types" + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing showToHeader thing + | Just thing <- things + , not $ ignoredTyThing thing + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +-- | This is a fairly ad-hoc ordering to mostly ensure determinism. +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + , compareListsWith stableNameCmp + (sorted_tycons tys1) + (sorted_tycons tys2) + ] + where + sorted_tycons = + sortBy stableNameCmp . map getName . nonDetEltsUniqSet . tyConsOfTypes + (_, cls1, tys1) = instanceHead inst1 + (_, cls2, tys2) = instanceHead inst2 + +compareListsWith :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering +compareListsWith cmp = go + where + go (x:xs) (y:ys) = cmp x y `mappend` go xs ys + go [] (_:_) = LT + go (_:_) [] = GT + go [] [] = EQ ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d272ff9b6e52c9e52925d298cfdcfb7f58276c13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d272ff9b6e52c9e52925d298cfdcfb7f58276c13 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 18:03:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 May 2023 14:03:22 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] hi Message-ID: <645e7f6a311d0_171ad9bce1c97533@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: db0bdb3d by GHC GitLab CI at 2023-05-12T14:02:43-04:00 hi - - - - - 1 changed file: - + testsuite/tests/interface-stability/base-exports.stdout-mingw32 Changes: ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== The diff for this file was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/db0bdb3d66b799a5547448e6d4eef5170ea2c06b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/db0bdb3d66b799a5547448e6d4eef5170ea2c06b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 19:03:12 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 12 May 2023 15:03:12 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 7 commits: JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <645e8d7065b00_171ad9bce6c101963@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - 80f05bcd by Ben Gamari at 2023-05-12T15:03:08-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 30 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Transform.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - docs/users_guide/debugging.rst - docs/users_guide/using-optimisation.rst - hadrian/bindist/Makefile - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - libraries/base/changelog.md - testsuite/driver/testlib.py - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/simplCore/should_compile/T23267.hs - + testsuite/tests/simplCore/should_compile/T23267.script The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db0bdb3d66b799a5547448e6d4eef5170ea2c06b...80f05bcd79afc7c926815c099e9b70ad65f04eab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db0bdb3d66b799a5547448e6d4eef5170ea2c06b...80f05bcd79afc7c926815c099e9b70ad65f04eab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 19:17:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 15:17:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: rts: Ensure non-moving gc is not running when pausing Message-ID: <645e90bf13ca6_171ad9bce30109135@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 52740d9b by Teo Camarasu at 2023-05-12T15:17:03-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - c9b5ac59 by Teo Camarasu at 2023-05-12T15:17:03-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - 81376b4e by Krzysztof Gogolewski at 2023-05-12T15:17:03-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - fea09651 by Alexis King at 2023-05-12T15:17:12-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 6 changed files: - compiler/GHC/Core/Coercion.hs - hadrian/src/Settings/Builders/SplitSections.hs - rts/RtsAPI.c - rts/sm/Storage.c - + testsuite/tests/simplCore/should_compile/T23362.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1355,7 +1355,7 @@ mkProofIrrelCo r kco g1 g2 = mkUnivCo (ProofIrrelProv kco) r -- | Converts a coercion to be nominal, if possible. -- See Note [Role twiddling functions] setNominalRole_maybe :: Role -- of input coercion - -> Coercion -> Maybe Coercion + -> Coercion -> Maybe CoercionN setNominalRole_maybe r co | r == Nominal = Just co | otherwise = setNominalRole_maybe_helper co @@ -1380,10 +1380,19 @@ setNominalRole_maybe r co = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2 setNominalRole_maybe_helper (ForAllCo tv kind_co co) = ForAllCo tv kind_co <$> setNominalRole_maybe_helper co - setNominalRole_maybe_helper (SelCo n co) + setNominalRole_maybe_helper (SelCo cs co) = -- NB, this case recurses via setNominalRole_maybe, not -- setNominalRole_maybe_helper! - = SelCo n <$> setNominalRole_maybe (coercionRole co) co + case cs of + SelTyCon n _r -> + -- Remember to update the role in SelTyCon to nominal; + -- not doing this caused #23362. + -- See the typing rule in Note [SelCo] in GHC.Core.TyCo.Rep. + SelCo (SelTyCon n Nominal) <$> setNominalRole_maybe (coercionRole co) co + SelFun fs -> + SelCo (SelFun fs) <$> setNominalRole_maybe (coercionRole co) co + SelForAll -> + pprPanic "setNominalRole_maybe: the coercion should already be nominal" (ppr co) setNominalRole_maybe_helper (InstCo co arg) = InstCo <$> setNominalRole_maybe_helper co <*> pure arg setNominalRole_maybe_helper (UnivCo prov _ co1 co2) ===================================== hadrian/src/Settings/Builders/SplitSections.hs ===================================== @@ -30,7 +30,7 @@ splitSectionsArgs = do ( mconcat [ builder (Ghc CompileHs) ? arg "-fsplit-sections" , builder MergeObjects ? ifM (expr isWinTarget) - (pure ["-t", "driver/utils/merge_sections_pe.ld"]) - (pure ["-t", "driver/utils/merge_sections.ld"]) + (pure ["-T", "driver/utils/merge_sections_pe.ld"]) + (pure ["-T", "driver/utils/merge_sections.ld"]) ] ) else mempty ===================================== rts/RtsAPI.c ===================================== @@ -19,6 +19,7 @@ #include "StablePtr.h" #include "Threads.h" #include "Weak.h" +#include "sm/NonMoving.h" /* ---------------------------------------------------------------------------- Building Haskell objects from C datatypes. @@ -709,6 +710,16 @@ Capability *pauseTokenCapability(PauseToken *pauseToken) { // See Note [Locking and Pausing the RTS] PauseToken *rts_pause (void) { + + // Wait for any nonmoving collection to finish before pausing the RTS. + // The nonmoving collector needs to synchronise with the mutator, + // so pausing the mutator while a collection is ongoing might lead to deadlock or + // capabilities being prematurely re-awoken. + if (RtsFlags.GcFlags.useNonmoving) { + ACQUIRE_LOCK(&nonmoving_collection_mutex); + } + + // It is an error if this thread already paused the RTS. If another // thread has paused the RTS, then rts_pause will block until rts_resume is // called (and compete with other threads calling rts_pause). The blocking @@ -771,6 +782,10 @@ void rts_resume (PauseToken *pauseToken) releaseAllCapabilities(getNumCapabilities(), NULL, task); exitMyTask(); stgFree(pauseToken); + + if (RtsFlags.GcFlags.useNonmoving) { + RELEASE_LOCK(&nonmoving_collection_mutex); + } } // See RtsAPI.h ===================================== rts/sm/Storage.c ===================================== @@ -42,7 +42,7 @@ #include "GC.h" #include "Evac.h" #include "NonMovingAllocate.h" -#include "sm/NonMovingMark.h" +#include "NonMovingMark.h" #if defined(ios_HOST_OS) || defined(darwin_HOST_OS) #include "Hash.h" #endif @@ -365,11 +365,20 @@ listGenBlocks (ListBlocksCb cb, void *user, generation* gen) cb(user, gen->compact_blocks_in_import); } +static void +listSegmentBlocks (ListBlocksCb cb, void *user, struct NonmovingSegment *seg) +{ + while (seg) { + cb(user, Bdescr((StgPtr) seg)); + seg = seg->link; + } +} + // Traverse all the different places that the rts stores blocks // and call a callback on each of them. void listAllBlocks (ListBlocksCb cb, void *user) { - uint32_t g, i; + uint32_t g, i, s; for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (i = 0; i < getNumCapabilities(); i++) { cb(user, getCapability(i)->mut_lists[g]); @@ -389,6 +398,24 @@ void listAllBlocks (ListBlocksCb cb, void *user) } cb(user, getCapability(i)->pinned_object_blocks); cb(user, getCapability(i)->pinned_object_empty); + + // list capabilities' current segments + if(RtsFlags.GcFlags.useNonmoving) { + for (s = 0; s < NONMOVING_ALLOCA_CNT; s++) { + listSegmentBlocks(cb, user, getCapability(i)->current_segments[s]); + } + } + } + + // list blocks on the nonmoving heap + if(RtsFlags.GcFlags.useNonmoving) { + for(s = 0; s < NONMOVING_ALLOCA_CNT; s++) { + listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].filled); + listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].saved_filled); + listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].active); + } + cb(user, nonmoving_large_objects); + cb(user, nonmoving_compact_objects); } } ===================================== testsuite/tests/simplCore/should_compile/T23362.hs ===================================== @@ -0,0 +1,21 @@ +module T23362 where + +import Unsafe.Coerce +import Data.Kind + +type Phantom :: Type -> Type +data Phantom a = MkPhantom + +newtype Id a = MkId a +newtype First a = MkFirst (Id a) +data Second a = MkSecond (First a) +data Third a = MkThird !(Second a) + +a :: Second (Phantom Int) +a = MkSecond (MkFirst (MkId MkPhantom)) + +uc :: Second (Phantom Int) -> Second (Phantom Bool) +uc = unsafeCoerce + +b :: Third (Phantom Bool) +b = MkThird (uc a) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -478,3 +478,4 @@ test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -d test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) +test('T23362', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d834059621153f4fd56b6687058a2255cd38591d...fea09651a87cb6048271f731b0aaf12ecde641a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d834059621153f4fd56b6687058a2255cd38591d...fea09651a87cb6048271f731b0aaf12ecde641a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 20:01:52 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Fri, 12 May 2023 16:01:52 -0400 Subject: [Git][ghc/ghc][wip/amg/tweak-co-opt] 2 commits: Less coercion optimization for non-newtype axioms Message-ID: <645e9b30abb1d_171ad9bce441289d8@gitlab.mail> Adam Gundry pushed to branch wip/amg/tweak-co-opt at Glasgow Haskell Compiler / GHC Commits: 05334a11 by Adam Gundry at 2023-05-12T20:59:33+01:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - 9bd6bf96 by Adam Gundry at 2023-05-12T21:00:04+01:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 2 changed files: - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -4,7 +4,6 @@ module GHC.Core.Coercion.Opt ( optCoercion - , checkAxInstCo , OptCoercionOpts (..) ) where @@ -804,37 +803,38 @@ opt_trans_rule is co1 co2 -- Push transitivity inside axioms opt_trans_rule is co1 co2 - -- See Note [Why call checkAxInstCo during optimisation] + -- See Note [Push transitivity inside axioms] and + -- Note [Push transitivity inside newtype axioms only] -- TrPushSymAxR | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos2 <- matchAxiom sym con ind co2 , let newAxInst = AxiomInstCo con ind (opt_transList is (map mkSymCo cos2) cos1) - , Nothing <- checkAxInstCo newAxInst = fireTransRule "TrPushSymAxR" co1 co2 $ SymCo newAxInst -- TrPushAxR | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos2 <- matchAxiom sym con ind co2 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) - , Nothing <- checkAxInstCo newAxInst = fireTransRule "TrPushAxR" co1 co2 newAxInst -- TrPushSymAxL | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 , let newAxInst = AxiomInstCo con ind (opt_transList is cos2 (map mkSymCo cos1)) - , Nothing <- checkAxInstCo newAxInst = fireTransRule "TrPushSymAxL" co1 co2 $ SymCo newAxInst -- TrPushAxL | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) - , Nothing <- checkAxInstCo newAxInst = fireTransRule "TrPushAxL" co1 co2 newAxInst -- TrPushAxSym/TrPushSymAx @@ -915,30 +915,87 @@ fireTransRule _rule _co1 _co2 res = Just res {- -Note [Conflict checking with AxiomInstCo] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the following type family and axiom: +Note [Push transitivity inside axioms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +opt_trans_rule tries to push transitivity inside axioms to deal with cases like +the following: + + newtype N a = MkN a + + axN :: N a ~R# a + + covar :: a ~R# b + co1 = axN :: N a ~R# a + co2 = axN :: N b ~R# b + + co :: a ~R# b + co = sym co1 ; N covar ; co2 + +When we are optimising co, we want to notice that the two axiom instantiations +cancel out. This is implemented by rules such as TrPushSymAxR, which transforms + sym (axN ) ; N covar +into + sym (axN covar) +so that TrPushSymAx can subsequently transform + sym (axN covar) ; axN +into + covar +which is much more compact. In some perf test cases this kind of pattern can be +generated repeatedly during simplification, so it is very important we squash it +to stop coercions growing exponentially. For more details see the paper: + + Evidence normalisation in System FC + Dimitrios Vytiniotis and Simon Peyton Jones + RTA'13, 2013 + https://www.microsoft.com/en-us/research/publication/evidence-normalization-system-fc-2/ + + +Note [Push transitivity inside newtype axioms only] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The optimization described in Note [Push transitivity inside axioms] is possible +for both newtype and type family axioms. However, for type family axioms it is +relatively common to have transitive sequences of axioms instantiations, for +example: + + data Nat = Zero | Suc Nat + + type family Index (n :: Nat) (xs :: [Type]) :: Type where + Index Zero (x : xs) = x + Index (Suc n) (x : xs) = Index n xs + + axIndex :: { forall x::Type. forall xs::[Type]. Index Zero (x : xs) ~ x + ; forall n::Nat. forall x::Type. forall xs::[Type]. Index (Suc n) (x : xs) ~ Index n xs } + + co :: Index (Suc (Suc Zero)) [a, b, c] ~ c + co = axIndex[1] <[b, c]> + ; axIndex[1] <[c]> + ; axIndex[0] <[]> + +Not only are there no cancellation opportunities here, but calling matchAxiom +repeatedly down the transitive chain is very expensive. Hence we do not attempt +to push transitivity inside type family axioms. See #8095, !9210 and related tickets. + +This is implemented by opt_trans_rule checking that the axiom is for a newtype +constructor (i.e. not a type family). Adding these guards substantially +improved performance (reduced bytes allocated by more than 10%) for the tests +CoOpt_Singletons, LargeRecord, T12227, T12545, T13386, T15703, T5030, T8095. + +A side benefit is that we do not risk accidentally creating an ill-typed +coercion; see Note [Why call checkAxInstCo during optimisation]. + +There may exist programs that previously relied on pushing transitivity inside +type family axioms to avoid creating huge coercions, which will regress in +compile time performance as a result of this change. We do not currently know +of any examples, but if any come to light we may need to reconsider this +behaviour. -type family Equal (a :: k) (b :: k) :: Bool -type instance where - Equal a a = True - Equal a b = False --- -Equal :: forall k::*. k -> k -> Bool -axEqual :: { forall k::*. forall a::k. Equal k a a ~ True - ; forall k::*. forall a::k. forall b::k. Equal k a b ~ False } - -We wish to disallow (axEqual[1] <*> ) :: (Equal * Int Int ~ -False) and that all is OK. But, all is not OK: we want to use the first branch -of the axiom in this case, not the second. The problem is that the parameters -of the first branch can unify with the supplied coercions, thus meaning that -the first branch should be taken. See also Note [Apartness] in -"GHC.Core.FamInstEnv". Note [Why call checkAxInstCo during optimisation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +NB: The following is no longer relevant, because we no longer push transitivity +into type family axioms (Note [Push transitivity inside newtype axioms only]). +It is retained for reference in case we change this behaviour in the future. + It is possible that otherwise-good-looking optimisations meet with disaster in the presence of axioms with multiple equations. Consider @@ -1029,39 +1086,6 @@ The problem described here was first found in dependent/should_compile/dynamic-p -} --- | Check to make sure that an AxInstCo is internally consistent. --- Returns the conflicting branch, if it exists --- See Note [Conflict checking with AxiomInstCo] -checkAxInstCo :: Coercion -> Maybe CoAxBranch --- defined here to avoid dependencies in GHC.Core.Coercion --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] in GHC.Core.Lint -checkAxInstCo (AxiomInstCo ax ind cos) - = let branch = coAxiomNthBranch ax ind - tvs = coAxBranchTyVars branch - cvs = coAxBranchCoVars branch - incomps = coAxBranchIncomps branch - (tys, cotys) = splitAtList tvs (map coercionLKind cos) - co_args = map stripCoercionTy cotys - subst = zipTvSubst tvs tys `composeTCvSubst` - zipCvSubst cvs co_args - target = Type.substTys subst (coAxBranchLHS branch) - in_scope = mkInScopeSet $ - unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps) - flattened_target = flattenTys in_scope target in - check_no_conflict flattened_target incomps - where - check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch - check_no_conflict _ [] = Nothing - check_no_conflict flat (b at CoAxBranch { cab_lhs = lhs_incomp } : rest) - -- See Note [Apartness] in GHC.Core.FamInstEnv - | SurelyApart <- tcUnifyTysFG alwaysBindFun flat lhs_incomp - = check_no_conflict flat rest - | otherwise - = Just b -checkAxInstCo _ = Nothing - - ----------- wrapSym :: SymFlag -> Coercion -> Coercion wrapSym sym co | sym = mkSymCo co ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -56,7 +56,6 @@ import GHC.Core.TyCon as TyCon import GHC.Core.Coercion.Axiom import GHC.Core.FamInstEnv( compatibleBranches ) import GHC.Core.Unify -import GHC.Core.Coercion.Opt ( checkAxInstCo ) import GHC.Core.Opt.Arity ( typeArity, exprIsDeadEnd ) import GHC.Core.Opt.Monad @@ -2531,6 +2530,70 @@ lintCoercion (HoleCo h) = do { addErrL $ text "Unfilled coercion hole:" <+> ppr h ; lintCoercion (CoVarCo (coHoleCoVar h)) } + +{- +Note [Conflict checking with AxiomInstCo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the following type family and axiom: + +type family Equal (a :: k) (b :: k) :: Bool +type instance where + Equal a a = True + Equal a b = False +-- +Equal :: forall k::*. k -> k -> Bool +axEqual :: { forall k::*. forall a::k. Equal k a a ~ True + ; forall k::*. forall a::k. forall b::k. Equal k a b ~ False } + +The coercion (axEqual[1] <*> ) :: (Equal * Int Int ~ False) + +and that all is OK. But, all is not OK: we want to use the first branch of the +axiom in this case, not the second. The problem is that the parameters of the +first branch can unify with the supplied coercions, thus meaning that the first +branch should be taken. See also Note [Apartness] in "GHC.Core.FamInstEnv". + +For more details, see the section "Branched axiom conflict checking" in +docs/core-spec, which defines the corresponding no_conflict function used by the +Co_AxiomInstCo rule in the section "Coercion typing". +-} + +-- | Check to make sure that an AxInstCo is internally consistent. +-- Returns the conflicting branch, if it exists +-- See Note [Conflict checking with AxiomInstCo] +checkAxInstCo :: Coercion -> Maybe CoAxBranch +-- defined here to avoid dependencies in GHC.Core.Coercion +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] in GHC.Core.Lint +checkAxInstCo (AxiomInstCo ax ind cos) + = let branch = coAxiomNthBranch ax ind + tvs = coAxBranchTyVars branch + cvs = coAxBranchCoVars branch + incomps = coAxBranchIncomps branch + (tys, cotys) = splitAtList tvs (map coercionLKind cos) + co_args = map stripCoercionTy cotys + subst = zipTvSubst tvs tys `composeTCvSubst` + zipCvSubst cvs co_args + target = Type.substTys subst (coAxBranchLHS branch) + in_scope = mkInScopeSet $ + unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps) + flattened_target = flattenTys in_scope target in + check_no_conflict flattened_target incomps + where + check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch + check_no_conflict _ [] = Nothing + check_no_conflict flat (b at CoAxBranch { cab_lhs = lhs_incomp } : rest) + -- See Note [Apartness] in GHC.Core.FamInstEnv + | SurelyApart <- tcUnifyTysFG alwaysBindFun flat lhs_incomp + = check_no_conflict flat rest + | otherwise + = Just b +checkAxInstCo _ = Nothing + + {- ************************************************************************ * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6846ec0e2d21011e6119414a5002aab1395cca77...9bd6bf961369aab708e73fe45007160a50137f51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6846ec0e2d21011e6119414a5002aab1395cca77...9bd6bf961369aab708e73fe45007160a50137f51 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 21:08:01 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Fri, 12 May 2023 17:08:01 -0400 Subject: [Git][ghc/ghc][wip/amg/dcoercion] 1047 commits: CoreToStg: purge `DynFlags`. Message-ID: <645eaab1b1968_171ad9bcebc137584@gitlab.mail> sheaf pushed to branch wip/amg/dcoercion at Glasgow Haskell Compiler / GHC Commits: ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - fb9781f7 by Adam Gundry at 2023-05-12T22:35:02+02:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - 2f15745a by Adam Gundry at 2023-05-12T22:35:05+02:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 7790100c by Adam Gundry at 2023-05-12T23:01:43+02:00 Directed coercions We introduce a slimmer version of coercions, directed coercions, which store fewer types within them. This more compact representation considerably speeds up programs which involve many type family reductions, as the coercion size no longer grows quadratically in the number of reduction steps. - - - - - 4e506ba0 by sheaf at 2023-05-12T23:01:43+02:00 WIP: remove LHS type in Reduction - - - - - 11 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea654ed05a6fbae52ca5acaa5bcd28ed937db57d...4e506ba01a57e060fcef42a598b7802ec94c9cb0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea654ed05a6fbae52ca5acaa5bcd28ed937db57d...4e506ba01a57e060fcef42a598b7802ec94c9cb0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 23:15:47 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Fri, 12 May 2023 19:15:47 -0400 Subject: [Git][ghc/ghc][wip/amg/dcoercion] WIP: remove LHS type in Reduction Message-ID: <645ec8a3ed64e_171ad9bce58160852@gitlab.mail> sheaf pushed to branch wip/amg/dcoercion at Glasgow Haskell Compiler / GHC Commits: 43c4c1e6 by sheaf at 2023-05-13T01:15:29+02:00 WIP: remove LHS type in Reduction - - - - - 20 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Id/Make.hs - testsuite/tests/dcoercion/DCo_Phantom.hs - testsuite/tests/dcoercion/DCo_Phantom.stderr - testsuite/tests/dcoercion/DCo_Specialise.hs - testsuite/tests/dcoercion/DCo_T15703_aux.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1011,6 +1011,8 @@ mkSubDCo l_ty dco r_ty = case dco of | Just (tc, arg_l_tys) <- splitTyConApp_maybe l_ty , Just (_ , arg_r_tys) <- splitTyConApp_maybe r_ty -> TyConAppDCo (applyRoles_dco tc arg_l_tys dcos arg_r_tys) + -- SLD TODO: we might need to get rid of this case, + -- to avoid calling applyRoles, which calls mkHydrateDCo. DehydrateCo co -> DehydrateCo (mkSubCo co) UnivDCo prov r @@ -1188,6 +1190,7 @@ See Note [The Reduction type] in GHC.Core.Reduction. mkHydrateDCo :: HasDebugCallStack => Role -> Type -> DCoercion -> Maybe Type -> Coercion mkHydrateDCo r l_ty dco mb_r_ty | debugIsOn + , isNothing mb_r_ty -- Check that 'followDCo' does not crash, -- i.e. that the Hydration invariant is satisfied. = check_hydration_invariant r l_ty dco $ @@ -1447,7 +1450,7 @@ expandOneStepDCo check_prop throw_err r l_ty -- LHS type is not a TyConApp. Nothing -> - throw_err (text"StepsDCo: LHS not a TyConApp" $$ debug_info) + throw_err (text "StepsDCo: LHS not a TyConApp" $$ debug_info) where debug_info = vcat [ text "r:" <+> ppr r , text "l_ty:" <+> ppr l_ty ] @@ -1774,9 +1777,8 @@ mkSelCo_maybe cs co -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2) -- then (nth SelForAll co :: (t1 ~ t2) ~N (t3 ~ t4)) - go SelForAll (HydrateDCo r _ (ForAllDCo tv kind_co _) _) - = assert (r == Nominal) $ - Just $ mkHydrateDCo Nominal (tyVarKind tv) kind_co Nothing + go SelForAll (HydrateDCo _ _ (ForAllDCo tv kind_co _) rhs) + = Just $ mkHydrateDCo Nominal (tyVarKind tv) kind_co (Just $ typeKind rhs) go (SelFun fs) (FunCo _ _ _ w arg res) = Just (getNthFun fs w arg res) @@ -1820,7 +1822,7 @@ mkSelCo_maybe cs co good_call SelForAll | Just (_tv1, _) <- splitForAllTyCoVar_maybe ty1 , Just (_tv2, _) <- splitForAllTyCoVar_maybe ty2 - = True + = True good_call (SelFun {}) = isFunTy ty1 && isFunTy ty2 @@ -2083,6 +2085,7 @@ setNominalRole_maybe_dco r ty (TransDCo dco1 dco2) = TransDCo <$> setNominalRole_maybe_dco r ty dco1 <*> setNominalRole_maybe_dco r mid_ty dco2 where mid_ty = followDCo r ty dco1 + -- OK to call followDCo here: this function is always called on fully zonked types. setNominalRole_maybe_dco _ _ (SubDCo dco) = Just dco setNominalRole_maybe_dco r _ (DehydrateCo co) = DehydrateCo <$> setNominalRole_maybe r co setNominalRole_maybe_dco _ _ (UnivDCo prov rhs) ===================================== compiler/GHC/Core/FamInstEnv.hs ===================================== @@ -1350,7 +1350,7 @@ topNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe Reduction -- original type, and the returned coercion is always homogeneous. topNormaliseType_maybe env ty = do { ((dco, mkind_co), nty) <- topNormaliseTypeX stepper combine ty - ; return $ homogeniseRedn (mkReduction ty dco nty) mkind_co } + ; return $ homogeniseRedn (mkReduction dco nty) mkind_co } where stepper = unwrapNewTypeStepper' `composeSteppers` tyFamStepper @@ -1365,7 +1365,7 @@ topNormaliseType_maybe env ty tyFamStepper :: NormaliseStepper (DCoercion, MCoercionN) tyFamStepper rec_nts tc tys -- Try to step a type/data family = case topReduceTyFamApp_maybe env tc tys of - Just (HetReduction (Reduction _ co rhs) res_co) + Just (HetReduction (Reduction co rhs) res_co) -> NS_Step rec_nts rhs (co, res_co) _ -> NS_Done @@ -1388,7 +1388,7 @@ topReduceTyFamApp_maybe envs fam_tc arg_tys = Nothing where role = Representational - ArgsReductions args_redns@(Reductions _ _ ntys) res_co + ArgsReductions args_redns@(Reductions _ ntys) res_co = initNormM envs role (tyCoVarsOfTypes arg_tys) $ normalise_tc_args fam_tc arg_tys @@ -1424,7 +1424,7 @@ normalise_tc_app tc tys = -- A type-family application do { env <- getEnv ; role <- getRole - ; ArgsReductions redns@(Reductions _ _ ntys) res_co <- normalise_tc_args tc tys + ; ArgsReductions redns@(Reductions _ ntys) res_co <- normalise_tc_args tc tys ; case reduceTyFamApp_maybe env role tc ntys of Just redn1 -> do { redn2 <- normalise_reduction redn1 @@ -1441,7 +1441,7 @@ normalise_tc_app tc tys do { ArgsReductions redns res_co <- normalise_tc_args tc tys ; role <- getRole ; return $ - homogeniseRedn (mkTyConAppRedn_MightBeSynonym role tc redns) res_co } + homogeniseRedn (mkTyConAppRedn_MightBeSynonym role tc tys redns) res_co } -- NB: we assume "tys" satisfy the hydration invariant from -- Note [The Hydration invariant] in GHC.Core.Coercion, -- because the "normalise" functions all only deal with fully zonked types. @@ -1501,7 +1501,7 @@ normalise_type ty -- cf. GHC.Tc.Solver.Rewrite.rewrite_app_ty_args go_app_tys (AppTy ty1 ty2) tys = go_app_tys ty1 (ty2 : tys) go_app_tys fun_ty arg_tys - = do { fun_redn@(Reduction _ _ nfun) <- go fun_ty + = do { fun_redn@(Reduction _ nfun) <- go fun_ty ; case tcSplitTyConApp_maybe nfun of Just (tc, xis) -> do { redn <- go (mkTyConApp tc (xis ++ arg_tys)) @@ -1532,7 +1532,7 @@ normalise_args :: Kind -- of the function -- cf. GHC.Tc.Solver.Rewrite.rewrite_args_slow normalise_args fun_ki roles args = do { normed_args <- zipWithM normalise1 (Inf.toList roles) args - ; return $ simplifyArgsWorker ki_binders inner_ki fvs roles normed_args } + ; return $ simplifyArgsWorker ki_binders inner_ki fvs roles args normed_args } where (ki_binders, inner_ki) = splitPiTys fun_ki fvs = tyCoVarsOfTypes args @@ -1550,7 +1550,7 @@ normalise_tyvar tv Nothing -> mkReflRedn (mkTyVarTy tv) } normalise_reduction :: Reduction -> NormM Reduction -normalise_reduction redn@(Reduction _ _ ty) +normalise_reduction redn@(Reduction _ ty) = do { redn' <- normalise_type ty ; return $ redn `mkTransRedn` redn' } @@ -1560,10 +1560,11 @@ normalise_var_bndr tcvar = do { lc1 <- getLC ; env <- getEnv ; let - do_normalise ki = do { redn <- normalise_type ki; return redn } - callback lc ki = runNormM (do_normalise ki) env lc Nominal - ; return $ liftCoSubstVarBndrUsing (mkHydrateReductionDCoercion Nominal) - callback lc1 tcvar } + mk_co (lhs, redn) = mkHydrateReductionDCoercion Nominal lhs redn + do_normalise ki = do { redn <- normalise_type ki; return (ki, redn) } + callback lc ki = runNormM (do_normalise ki) env lc Nominal + (lc, tcv, (_, redn)) = liftCoSubstVarBndrUsing mk_co callback lc1 tcvar + ; return (lc, tcv, redn) } -- | a monad for the normalisation functions, reading 'FamInstEnvs', -- a 'LiftingContext', and a 'Role'. ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3254,9 +3254,11 @@ improveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv -> SimplM (SimplEnv, OutExpr, OutId) -- Note [Improving seq] improveSeq fam_envs env scrut case_bndr case_bndr1 [Alt DEFAULT _ _] - | Just redn@(Reduction _ _ ty2) <- topNormaliseType_maybe fam_envs (idType case_bndr1) + | let ty1 = idType case_bndr1 + , Just redn@(Reduction _ ty2) <- topNormaliseType_maybe fam_envs ty1 = do { case_bndr2 <- newId (fsLit "nt") ManyTy ty2 - ; let co = mkHydrateReductionDCoercion Representational redn + ; let co = mkHydrateReductionDCoercion Representational ty1 redn + -- SLD TODO: OK because zonked. rhs = DoneEx (Var case_bndr2 `Cast` mkSymCo co) Nothing env2 = extendIdSubst env case_bndr rhs ; return (env2, scrut `Cast` co, case_bndr2) } ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1316,7 +1316,7 @@ findTypeShape fam_envs ty = TsUnk go_tc rec_tc tc tc_args - | Just (HetReduction (Reduction _ _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args + | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs | Just con <- tyConSingleAlgDataCon_maybe tc @@ -1411,7 +1411,7 @@ isRecDataCon fam_envs fuel orig_dc go_tc_app fuel visited_tcs tc tc_args = case tyConDataCons_maybe tc of --- | pprTrace "tc_app" (vcat [ppr tc, ppr tc_args]) False = undefined - _ | Just (HetReduction (Reduction _ _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args + _ | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args -- This is the only place where we look at tc_args, which might have -- See Note [Detecting recursive data constructors], point (C) and (5) -> go_arg_ty fuel visited_tcs rhs ===================================== compiler/GHC/Core/Reduction.hs ===================================== @@ -62,27 +62,23 @@ Note [The Reduction type] Many functions in the type-checker rewrite a type, using Given type equalities or type-family reductions, and return a Reduction: - data Reduction = Reduction Type Coercion !Type + data Reduction = Reduction Coercion !Type -When we rewrite ty at role r, producing Reduction ty' dco xi, we guarantee: +When we rewrite ty at role r, producing Reduction dco xi, we guarantee: - RW1: ty' is equal to ty (up to zonking) - RW2: followDCo r ty' dco is equal to xi (up to zonking) + RW2: followDCo r (zonk ty) dco is equal to xi, up to zonking -In particular, this means that `dco :: ty' ~r xi`. Note that we need to use ty', -and not ty, to satisfy RW2; see Note [The Hydration invariant] in GHC.Core.Coercion. -It could be the case that `followDCo r ty dco` crashes, e.g. if `ty` is a metavariable -and `dco = TyConAppDCo ..`. This is why we store the LHS type in the Reduction too. +In particular, this means that `dco :: ty ~r xi`. Note however that we might +need to zonk... SLD TODO explain. The order of the arguments to the constructor serves as a reminder -of what the Type is. In +of what the Type is. In - Reduction ty' dco xi + ty ~rewrites to~> Reduction dco xi -the original type ty appears to the left, and the result appears on the right, -reminding us that we must have: +the result appears on the right, reminding us that we must have: - dco :: ty' ~r xi + dco :: ty ~r xi Example functions that use this datatype: @@ -104,21 +100,16 @@ a tuple (with all fields lazy), gives several advantages (see #20161) -- | A 'Reduction' is the result of an operation that rewrites a type @ty_in at . -- The 'Reduction' includes: -- --- - an input type @ty_in'@, equal to @ty_in@ up to zonking, -- - a directed coercion @dco@, -- - the rewritten type @ty_out@ -- --- such that @dco :: ty_in' ~ ty_out@, where the role @r@ of the coercion is determined --- by the context. --- --- Invariant: it is always valid to call @followDCo r ty_in' dco@, as per --- Note [The Hydration invariant] in GHC.Core.Coercion. +-- such that @dco :: ty_in ~ ty_out@, where the role @r@ of the coercion +-- is determined by the context. -- -- See Note [The Reduction type]. data Reduction = Reduction - { reductionOriginalType :: Type - , reductionDCoercion :: DCoercion + { reductionDCoercion :: DCoercion , reductionReducedType :: !Type } -- N.B. the 'Coercion' field must be lazy: see for instance GHC.Tc.Solver.Rewrite.rewrite_tyvar2 @@ -134,12 +125,9 @@ type ReductionR = Reduction -- | Create a 'Reduction' from a pair of a 'Coercion' and a 'Type. -- --- Pre-condition: the RHS type of the coercion matches the provided type --- (perhaps up to zonking). --- -- Use 'coercionRedn' when you only have the coercion. -mkReduction :: Type -> DCoercion -> Type -> Reduction -mkReduction lty co rty = Reduction lty co rty +mkReduction :: DCoercion -> Type -> Reduction +mkReduction co rty = Reduction co rty {-# INLINE mkReduction #-} instance Outputable Reduction where @@ -149,18 +137,17 @@ instance Outputable Reduction where , text " reductionDCoercion:" <+> ppr (reductionDCoercion redn) ] --- | Turn a 'Coercion' into a 'Reduction' --- by inspecting the LHS and RHS types of the coercion, and dehydrating. +-- | Turn a 'Coercion' into a 'Reduction' by dehydrating. -- -- Prefer using 'mkReduction' wherever possible to avoid doing these indirections. mkDehydrateCoercionRedn :: Coercion -> Reduction mkDehydrateCoercionRedn co = - Reduction (coercionLKind co) (mkDehydrateCo co) (coercionRKind co) + Reduction (mkDehydrateCo co) (coercionRKind co) {-# INLINE mkDehydrateCoercionRedn #-} -- | Hydrate the 'DCoercion' stored inside a 'Reduction' into a full-fledged 'Coercion'. -mkHydrateReductionDCoercion :: HasDebugCallStack => Role -> Reduction -> Coercion -mkHydrateReductionDCoercion r (Reduction lty dco rty) = mkHydrateDCo r lty dco (Just rty) +mkHydrateReductionDCoercion :: HasDebugCallStack => Role -> Type -> Reduction -> Coercion +mkHydrateReductionDCoercion r lty (Reduction dco rty) = mkHydrateDCo r lty dco (Just rty) -- N.B.: we use the LHS type stored in the 'Reduction' to ensure -- we satisfy the Hydration invariant of Note [The Hydration invariant] -- in GHC.Core.Coercion. @@ -168,8 +155,8 @@ mkHydrateReductionDCoercion r (Reduction lty dco rty) = mkHydrateDCo r lty dco ( -- | Downgrade the role of the directed coercion stored in the 'Reduction', -- from 'Nominal' to 'Representational'. -mkSubRedn :: Reduction -> Reduction -mkSubRedn redn@(Reduction lhs dco rhs) +mkSubRedn :: HasDebugCallStack => Type -> Reduction -> Reduction +mkSubRedn lhs redn@(Reduction dco rhs) = redn { reductionDCoercion = mkSubDCo lhs dco rhs } {-# INLINE mkSubRedn #-} @@ -183,13 +170,13 @@ mkSubRedn redn@(Reduction lhs dco rhs) -- as required by Note [The Reduction type]. You must manually ensure this -- invariant. mkTransRedn :: Reduction -> Reduction -> Reduction -mkTransRedn (Reduction ty1 dco1 _) (Reduction _ dco2 ty2) - = Reduction ty1 (dco1 `mkTransDCo` dco2) ty2 +mkTransRedn (Reduction dco1 _) (Reduction dco2 ty2) + = Reduction (dco1 `mkTransDCo` dco2) ty2 {-# INLINE mkTransRedn #-} -- | The reflexive reduction. mkReflRedn :: Type -> Reduction -mkReflRedn ty = mkReduction ty mkReflDCo ty +mkReflRedn ty = mkReduction mkReflDCo ty {-# INLINE mkReflRedn #-} -- | Create a 'Reduction' from a kind cast, in which @@ -201,7 +188,6 @@ mkReflRedn ty = mkReduction ty mkReflDCo ty mkGReflRightRedn :: Type -> CoercionN -> Reduction mkGReflRightRedn ty co = mkReduction - ty (mkGReflRightDCo co) (mkCastTy ty co) {-# INLINE mkGReflRightRedn #-} @@ -217,7 +203,6 @@ mkGReflRightMRedn ty MRefl = mkReflRedn ty mkGReflRightMRedn ty (MCo kco) = mkReduction - ty (mkGReflRightDCo kco) (mkCastTy ty kco) {-# INLINE mkGReflRightMRedn #-} @@ -231,7 +216,6 @@ mkGReflRightMRedn ty (MCo kco) mkGReflLeftRedn :: Type -> CoercionN -> Reduction mkGReflLeftRedn ty co = mkReduction - (mkCastTy ty co) (mkGReflLeftDCo co) ty {-# INLINE mkGReflLeftRedn #-} @@ -247,7 +231,6 @@ mkGReflLeftMRedn ty MRefl = mkReflRedn ty mkGReflLeftMRedn ty (MCo kco) = mkReduction - (mkCastTy ty kco) (mkGReflLeftDCo kco) ty {-# INLINE mkGReflLeftMRedn #-} @@ -259,9 +242,8 @@ mkGReflLeftMRedn ty (MCo kco) -- of the given 'Role' (which must match the role of the coercion stored -- in the 'Reduction' argument). mkCoherenceRightRedn :: Reduction -> CoercionN -> Reduction -mkCoherenceRightRedn (Reduction ty1 co1 ty2) kco +mkCoherenceRightRedn (Reduction co1 ty2) kco = mkReduction - ty1 (mkCoherenceRightDCo kco co1) (mkCastTy ty2 kco) {-# INLINE mkCoherenceRightRedn #-} @@ -274,9 +256,8 @@ mkCoherenceRightRedn (Reduction ty1 co1 ty2) kco -- in the 'Reduction' argument). mkCoherenceRightMRedn :: Reduction -> MCoercionN -> Reduction mkCoherenceRightMRedn redn MRefl = redn -mkCoherenceRightMRedn (Reduction ty1 co1 ty2) (MCo kco) +mkCoherenceRightMRedn (Reduction co1 ty2) (MCo kco) = mkReduction - ty1 (mkCoherenceRightDCo kco co1) (mkCastTy ty2 kco) {-# INLINE mkCoherenceRightMRedn #-} @@ -293,11 +274,10 @@ mkCoherenceRightMRedn (Reduction ty1 co1 ty2) (MCo kco) mkCastRedn1 :: CoercionN -- ^ coercion to cast with -> Reduction -- ^ rewritten type, with rewriting coercion -> Reduction -mkCastRedn1 cast_co (Reduction ty dco xi) +mkCastRedn1 cast_co (Reduction dco xi) -- co :: ty ~r ty' -- return_co :: (ty |> cast_co) ~r (ty' |> cast_co) = mkReduction - (mkCastTy ty cast_co) (castDCoercionKind1 dco cast_co) (mkCastTy xi cast_co) {-# INLINE mkCastRedn1 #-} @@ -313,9 +293,8 @@ mkCastRedn2 :: CoercionN -- ^ coercion to cast with on the left -> Reduction -- ^ rewritten type, with rewriting coercion -> CoercionN -- ^ coercion to cast with on the right -> Reduction -mkCastRedn2 cast_co (Reduction ty nco nty) cast_co' +mkCastRedn2 cast_co (Reduction nco nty) cast_co' = mkReduction - (mkCastTy ty cast_co) (castDCoercionKind2 nco cast_co cast_co') (mkCastTy nty cast_co') {-# INLINE mkCastRedn2 #-} @@ -324,9 +303,8 @@ mkCastRedn2 cast_co (Reduction ty nco nty) cast_co' -- -- Combines 'mkAppCo' and 'mkAppTy`. mkAppRedn :: Reduction -> Reduction -> Reduction -mkAppRedn (Reduction lty1 co1 rty1) (Reduction lty2 co2 rty2) +mkAppRedn (Reduction co1 rty1) (Reduction co2 rty2) = mkReduction - (mkAppTy lty1 lty2) (mkAppDCo co1 co2) (mkAppTy rty1 rty2) {-# INLINE mkAppRedn #-} @@ -342,13 +320,12 @@ mkFunRedn :: FunTyFlag -> Reduction -- ^ result reduction -> Reduction mkFunRedn af - (Reduction w_lty w_co w_rty) + (Reduction w_co w_rty) arg_repco res_repco - (Reduction arg_lty arg_co arg_rty) - (Reduction res_lty res_co res_rty) + (Reduction arg_co arg_rty) + (Reduction res_co res_rty) = mkReduction - (mkFunTy af w_lty arg_lty res_lty) (mkFunDCo w_co arg_repco res_repco arg_co res_co) (mkFunTy af w_rty arg_rty res_rty) {-# INLINE mkFunRedn #-} @@ -362,9 +339,8 @@ mkForAllRedn :: ForAllTyFlag -> ReductionN -- ^ kind reduction -> Reduction -- ^ body reduction -> Reduction -mkForAllRedn vis tv1 (Reduction _ h rki) (Reduction lty co rty) +mkForAllRedn vis tv1 (Reduction h rki) (Reduction co rty) = mkReduction - (mkForAllTy (Bndr tv1 vis) lty) (mkForAllDCo tv1 h co) (mkForAllTy (Bndr tv2 vis) rty) where @@ -376,9 +352,8 @@ mkForAllRedn vis tv1 (Reduction _ h rki) (Reduction lty co rty) -- -- Combines 'mkHomoForAllCos' and 'mkForAllTys'. mkHomoForAllRedn :: [TyVarBinder] -> Reduction -> Reduction -mkHomoForAllRedn bndrs (Reduction ty1 co ty2) +mkHomoForAllRedn bndrs (Reduction co ty2) = mkReduction - (mkForAllTys bndrs ty1) (mkHomoForAllDCos (binderVars bndrs) co) (mkForAllTys bndrs ty2) {-# INLINE mkHomoForAllRedn #-} @@ -390,22 +365,18 @@ mkProofIrrelRedn :: Coercion -- ^ lhs_co -> DCoercionN -- ^ dco :: lhs_co ~ rhs_co -> Coercion -- ^ rhs_co -> Reduction -mkProofIrrelRedn g1 co g2 +mkProofIrrelRedn _g1 co g2 = mkReduction - lhs_co (mkProofIrrelDCo co rhs_co) rhs_co where - lhs_co = mkCoercionTy g1 rhs_co = mkCoercionTy g2 {-# INLINE mkProofIrrelRedn #-} -- | Create a reflexive 'Reduction' whose LHS and RHS is the given 'Coercion', -- with the specified 'Role'. mkReflCoRedn :: Coercion -> Reduction -mkReflCoRedn co = mkReduction co_ty mkReflDCo co_ty - where - co_ty = mkCoercionTy co +mkReflCoRedn co = mkReduction mkReflDCo (mkCoercionTy co) {-# INLINE mkReflCoRedn #-} -- | A collection of 'Reduction's where the coercions and the types are stored separately. @@ -417,22 +388,22 @@ mkReflCoRedn co = mkReduction co_ty mkReflDCo co_ty -- -- Invariant: given @Reductions lhs_tys dcos rhs_tys@, and an ambient role @r@, -- we can obtain the @rhs_tys@ by following the directed coercions starting from the repsective --- @lhs_tys at . Equivalent, @zipWith (followDCo r) lhs_tys dcos@ is equal (up to zonking) to @rhs_tys at . -data Reductions = Reductions [Type] [DCoercion] [Type] +-- @lhs_tys at . Equivalently, @zipWith (followDCo r) lhs_tys dcos@ is equal (up to zonking) to @rhs_tys at . +data Reductions = Reductions [DCoercion] [Type] instance Outputable Reductions where - ppr (Reductions ltys dcos rtys) = parens (text "Reductions" <+> ppr ltys <+> ppr dcos <+> ppr rtys) + ppr (Reductions dcos rtys) = parens (text "Reductions" <+> ppr dcos <+> ppr rtys) -- | Create 'Reductions' from individual lists of coercions and types. -- -- The lists should be of the same length, and the RHS type of each coercion -- should match the specified type in the other list. -mkReductions :: [Type] -> [DCoercion] -> [Type] -> Reductions -mkReductions tys1 cos tys2 = Reductions tys1 cos tys2 +mkReductions :: [DCoercion] -> [Type] -> Reductions +mkReductions cos tys2 = Reductions cos tys2 {-# INLINE mkReductions #-} mkReflRedns :: [Type] -> Reductions -mkReflRedns tys = mkReductions tys (mkReflDCos tys) tys +mkReflRedns tys = mkReductions (mkReflDCos tys) tys {-# INLINE mkReflRedns #-} mkReflDCos :: [Type] -> [DCoercion] @@ -441,8 +412,8 @@ mkReflDCos tys = replicate (length tys) mkReflDCo -- | Combines 'mkAppCos' and 'mkAppTys'. mkAppRedns :: Reduction -> Reductions -> Reduction -mkAppRedns (Reduction ty1 co ty2) (Reductions tys1 cos tys2) - = mkReduction (mkAppTys ty1 tys1) (mkAppDCos co cos) (mkAppTys ty2 tys2) +mkAppRedns (Reduction co ty2) (Reductions cos tys2) + = mkReduction (mkAppDCos co cos) (mkAppTys ty2 tys2) {-# INLINE mkAppRedns #-} -- | 'TyConAppCo' for 'Reduction's: combines 'mkTyConAppCo' and `mkTyConApp`. @@ -450,15 +421,15 @@ mkAppRedns (Reduction ty1 co ty2) (Reductions tys1 cos tys2) -- Use this when you know the 'TyCon' is not a type synonym. If it might be, -- use 'mkTyConAppRedn_MightBeSynonym'. mkTyConAppRedn :: TyCon -> Reductions -> Reduction -mkTyConAppRedn tc (Reductions tys1 cos tys2) - = mkReduction (mkTyConApp tc tys1) (mkTyConAppDCo cos) (mkTyConApp tc tys2) +mkTyConAppRedn tc (Reductions cos tys2) + = mkReduction (mkTyConAppDCo cos) (mkTyConApp tc tys2) {-# INLINE mkTyConAppRedn #-} -- | 'TyConAppCo' for 'Reduction's: combines 'mkTyConAppCo' and `mkTyConApp`. -- -- Use 'mkTyConAppRedn' if the 'TyCon' is definitely not a type synonym. -mkTyConAppRedn_MightBeSynonym :: Role -> TyCon -> Reductions -> Reduction -mkTyConAppRedn_MightBeSynonym role tc redns@(Reductions tys1 dcos tys2) +mkTyConAppRedn_MightBeSynonym :: Role -> TyCon -> [Type] -> Reductions -> Reduction +mkTyConAppRedn_MightBeSynonym role tc tys1 redns@(Reductions dcos tys2) -- 'mkTyConAppCo' handles synomyms by using substitution lifting. -- We don't have that for directed coercions, so we use hydrate/dehydrate -- so that we can call 'liftCoSubst'. @@ -466,8 +437,8 @@ mkTyConAppRedn_MightBeSynonym role tc redns@(Reductions tys1 dcos tys2) -- for directed coercions to avoid this (and a similar issue in simplifyArgsWorker). | ExpandsSyn tv_dco_prs rhs_ty leftover_dcos <- expandSynTyCon_maybe tc dcos , let tv_co_prs = zipWith4 hydrate (tyConRoleListX role tc) tys1 tv_dco_prs tys2 - = mkReduction - (mkTyConApp tc tys1) + = -- SLD TODO: assert this is a non-forgetful TySyn with no TyFams on the RHS + mkReduction (mkAppDCos (mkDehydrateCo $ liftCoSubst role (mkLiftingContext tv_co_prs) rhs_ty) leftover_dcos) (mkTyConApp tc tys2) | otherwise = mkTyConAppRedn tc redns @@ -477,25 +448,25 @@ mkTyConAppRedn_MightBeSynonym role tc redns@(Reductions tys1 dcos tys2) -- which are stored in 'Reductions'. -- This upholds the necessary hydration invariant from -- Note [The Hydration invariant] in GHC.Core.Coercion. + -- SLD TODO... {-# INLINE hydrate #-} {-# INLINE mkTyConAppRedn_MightBeSynonym #-} -- | Reduce the arguments of a 'Class' 'TyCon'. mkClassPredRedn :: Class -> Reductions -> Reduction -mkClassPredRedn cls (Reductions tys1 cos tys2) +mkClassPredRedn cls (Reductions cos tys2) = mkReduction - (mkClassPred cls tys1) (mkTyConAppDCo cos) (mkClassPred cls tys2) {-# INLINE mkClassPredRedn #-} -- | Obtain 'Reductions' from a list of 'Reduction's by unzipping. unzipRedns :: [Reduction] -> Reductions -unzipRedns = foldr accRedn (Reductions [] [] []) +unzipRedns = foldr accRedn (Reductions [] []) where accRedn :: Reduction -> Reductions -> Reductions - accRedn (Reduction ty co xi) (Reductions tys cos xis) - = Reductions (ty:tys) (co:cos) (xi:xis) + accRedn (Reduction co xi) (Reductions cos xis) + = Reductions (co:cos) (xi:xis) {-# INLINE unzipRedns #-} -- NB: this function is currently used in two locations: -- @@ -887,6 +858,7 @@ simplifyArgsWorker :: HasDebugCallStack -- list of binders can be shorter or longer than the list of args -> TyCoVarSet -- free vars of the args -> Infinite Role-- list of roles, r + -> [Type] -- original type arguments ty_i -> [Reduction] -- rewritten type arguments, arg_i -- each comes with the coercion used to rewrite it, -- arg_co_i :: ty_i ~ arg_i @@ -900,10 +872,10 @@ simplifyArgsWorker :: HasDebugCallStack -- function is all about. That is, (f xi_1 ... xi_n), where xi_i are the returned arguments, -- *is* well kinded. simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs - orig_roles redns + orig_roles tys redns = go orig_lc orig_ki_binders orig_inner_ki - orig_roles redns + orig_roles (zip tys redns) where orig_lc = emptyLiftingContext $ mkInScopeSet orig_fvs @@ -911,20 +883,20 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs -> [PiTyBinder] -- Unsubsted binders of function's kind -> Kind -- Unsubsted result kind of function (not a Pi-type) -> Infinite Role -- Roles at which to rewrite these ... - -> [Reduction] -- rewritten arguments, with their rewriting coercions + -> [(Type, Reduction)] -- rewritten arguments, with their rewriting coercions -> ArgsReductions go !lc binders inner_ki _ [] -- The !lc makes the function strict in the lifting context -- which means GHC can unbox that pair. A modest win. = ArgsReductions - (mkReductions [] [] []) + (mkReductions [] []) kind_co where final_kind = mkPiTys binders inner_ki kind_co | noFreeVarsOfType final_kind = MRefl | otherwise = MCo $ liftCoSubst Nominal lc final_kind - go lc (binder:binders) inner_ki (Inf role roles) (arg_redn:arg_redns) + go lc (binder:binders) inner_ki (Inf role roles) ((orig_ty,arg_redn):arg_redns) = -- We rewrite an argument ty with arg_redn = Reduction arg_co arg -- By Note [Rewriting] in GHC.Tc.Solver.Rewrite invariant (F2), -- typeKind(ty) = typeKind(arg). @@ -936,12 +908,13 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs -- The bangs here have been observed to improve performance -- significantly in optimized builds; see #18502 let !kind_co = liftCoSubst Nominal lc (piTyBinderType binder) - !(Reduction arg_ty casted_co casted_xi) + !(Reduction casted_co casted_xi) = mkCoherenceRightRedn arg_redn kind_co -- now, extend the lifting context with the new binding !new_lc | Just tv <- namedPiTyBinder_maybe binder = extendLiftingContextAndInScope lc tv - (mkHydrateDCo role arg_ty casted_co (Just casted_xi)) + (mkHydrateDCo role orig_ty casted_co (Just casted_xi)) + -- SLD TODO: reword the following. -- NB: this is the crucial place where we need the hydration invariant, -- which is satisfied here as we use the LHS type stored in a 'Reduction'. -- See Note [The Reduction type], as well as @@ -951,18 +924,19 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs -- we need this. | otherwise = lc - !(ArgsReductions (Reductions arg_tys cos xis) final_kind_co) + !(ArgsReductions (Reductions cos xis) final_kind_co) = go new_lc binders inner_ki roles arg_redns in ArgsReductions - (Reductions (arg_ty:arg_tys) (casted_co:cos) (casted_xi:xis)) + (Reductions (casted_co:cos) (casted_xi:xis)) final_kind_co -- See Note [Last case in simplifyArgsWorker] - go lc [] inner_ki roles arg_redns + go lc [] inner_ki roles arg_tys_and_redns = let co1 = liftCoSubst Nominal lc inner_ki + (orig_tys, arg_redns) = unzip arg_tys_and_redns co1_kind = coercionKind co1 - (arg_cos, res_co) = decomposePiCos co1 co1_kind (map reductionOriginalType arg_redns) - casted_args = assertPpr (equalLength arg_redns arg_cos) + (arg_cos, res_co) = decomposePiCos co1 co1_kind orig_tys + casted_redns = assertPpr (equalLength arg_redns arg_cos) (ppr arg_redns $$ ppr arg_cos) $ zipWith mkCoherenceRightRedn arg_redns arg_cos -- In general decomposePiCos can return fewer cos than tys, @@ -976,6 +950,6 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs (bndrs, new_inner) = splitPiTys rewritten_kind ArgsReductions redns_out res_co_out - = go zapped_lc bndrs new_inner roles casted_args + = go zapped_lc bndrs new_inner roles (zip orig_tys casted_redns) in ArgsReductions redns_out (res_co `mkTransMCoR` res_co_out) ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -68,9 +68,7 @@ import {-# SOURCE #-} GHC.Core.Coercion , mkAppDCo, mkForAllDCo, mkReflDCo, mkTransDCo , mkGReflRightDCo, mkGReflLeftDCo , mkHydrateDCo, mkDehydrateCo, mkUnivDCo - , followDCo , coercionKind, coercionLKind, coVarKindsTypesRole) -import GHC.Core.Coercion.Axiom (Role(..)) import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprTyVar ) import {-# SOURCE #-} GHC.Core.Ppr ( ) import {-# SOURCE #-} GHC.Core ( CoreExpr ) @@ -1034,8 +1032,8 @@ substForAllCoTyVarBndrUsing co_or_dco sym sty sco (Subst in_scope idenv tenv cen DCo -> noFreeVarsOfDCo old_kind_co mk_cast = case co_or_dco of Co -> CastTy - DCo -> \ ty dco -> CastTy ty (mkHydrateDCo Nominal new_ki1 dco Nothing) - -- SLD TODO: Hydration invariant? + DCo -> pprPanic "substForAllCoTyVarBndrUsing DCo Sym" + (vcat [ text "kind_co:" <+> ppr old_kind_co ]) no_change = no_kind_change && (new_var == old_var) @@ -1060,7 +1058,7 @@ substForAllCoCoVarBndrUsing :: CoOrDCo kco -> (Subst, CoVar, kco) substForAllCoCoVarBndrUsing co_or_dco sym sty sco (Subst in_scope idenv tenv cenv) old_var old_kind_co - = assert (isCoVar old_var ) + = assert (isCoVar old_var) ( Subst (in_scope `extendInScopeSet` new_var) idenv tenv new_cenv , new_var, new_kind_co ) where @@ -1079,8 +1077,8 @@ substForAllCoCoVarBndrUsing co_or_dco sym sty sco (Subst in_scope idenv tenv cen Co -> coercionKind new_kind_co DCo -> let l_ty = sty (varType old_var) - r_ty = followDCo Nominal l_ty new_kind_co - -- SLD TODO: Hydration invariant satisfied? + r_ty = pprPanic "substForAllCoCoVarBndrUsing DCo Sym" + (vcat [ text "kind_co:" <+> ppr old_kind_co]) in Pair l_ty r_ty new_var = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2384,10 +2384,10 @@ isEmptyTy ty -- coercions via 'topNormaliseType_maybe'. Hence the \"norm\" prefix. normSplitTyConApp_maybe :: FamInstEnvs -> Type -> Maybe (TyCon, [Type], Coercion) normSplitTyConApp_maybe fam_envs ty - | let Reduction ty' co ty1 = topNormaliseType_maybe fam_envs ty + | let Reduction co ty1 = topNormaliseType_maybe fam_envs ty `orElse` (mkReflRedn ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - = Just (tc, tc_args, mkHydrateDCo Representational ty' co (Just ty1)) + = Just (tc, tc_args, mkHydrateDCo Representational ty co (Just ty1)) -- N.B.: the hydration invariant is satisfied here, as we have already zonked -- everything by the time we call this function. -- See Note [The Hydration invariant] in GHC.Core.Coercion. ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -386,7 +386,7 @@ pmTopNormaliseType (TySt _ inert) typ = {-# SCC "pmTopNormaliseType" #-} do tyFamStepper :: FamInstEnvs -> NormaliseStepper ([Type] -> [Type], a -> a) tyFamStepper env rec_nts tc tys -- Try to step a type/data family = case topReduceTyFamApp_maybe env tc tys of - Just (HetReduction (Reduction _ _ rhs) _) + Just (HetReduction (Reduction _ rhs) _) -> NS_Step rec_nts rhs ((rhs:), id) _ -> NS_Done ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1494,6 +1494,8 @@ tcIfaceCo = go go (IfaceHydrateDCo r t1 dco)= do { t1 <- tcIfaceType t1 ; dco <- tcIfaceDCo dco ; return $ HydrateDCo r t1 dco (followDCo r t1 dco) } + -- SLD TODO: investigate perf impact here... + -- might be worth storing RHS in the interface file... go (IfaceUnivCo p r t1 t2) = UnivCo <$> tcIfaceUnivCoProv go p <*> pure r <*> tcIfaceType t1 <*> tcIfaceType t2 go (IfaceSymCo c) = SymCo <$> go c ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -171,8 +171,8 @@ normaliseFfiType' env ty0 = runWriterT $ go Representational initRecTc ty0 ; return $ mkDehydrateCoercionRedn nt_co `mkTransRedn` redn } } -- AMG TODO | isFamilyTyCon tc -- Expand open tycons - , redn0@(Reduction l_ty dco ty) <- normaliseTcApp env role tc tys - , not (isReflexiveDCo role l_ty dco ty) + , redn0@(Reduction dco ty) <- normaliseTcApp env role tc tys + , not (isReflexiveDCo role (mkTyConApp tc tys) dco ty) = do redn <- go role rec_nts ty return $ redn0 `mkTransRedn` redn @@ -252,7 +252,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty , fd_fi = imp_decl })) = setSrcSpanA dloc $ addErrCtxt (foreignDeclCtxt fo) $ do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty - ; (redn@(Reduction sig_ty _ norm_sig_ty), gres) <- normaliseFfiType sig_ty + ; (redn@(Reduction _ norm_sig_ty), gres) <- normaliseFfiType sig_ty ; let -- Drop the foralls before inspecting the -- structure of the foreign type. @@ -272,7 +272,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl -- Can't use sig_ty here because sig_ty :: Type and -- we need HsType Id hence the undefined - ; let co = mkSymCo $ mkHydrateReductionDCoercion Representational redn + ; let co = mkSymCo $ mkHydrateReductionDCoercion Representational sig_ty redn fi_decl = ForeignImport { fd_name = L nloc id , fd_sig_ty = undefined @@ -413,7 +413,7 @@ tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spe sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty rhs <- tcCheckPolyExpr (nlHsVar nm) sig_ty - (redn@(Reduction sig_ty _ norm_sig_ty), gres) <- normaliseFfiType sig_ty + (redn@(Reduction _ norm_sig_ty), gres) <- normaliseFfiType sig_ty spec' <- tcCheckFEType norm_sig_ty spec @@ -430,7 +430,7 @@ tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spe return ( mkVarBind id rhs , ForeignExport { fd_name = L loc id , fd_sig_ty = undefined - , fd_e_ext = mkHydrateReductionDCoercion Representational redn + , fd_e_ext = mkHydrateReductionDCoercion Representational sig_ty redn , fd_fe = spec' } , gres) tcFExport d = pprPanic "tcFExport" (ppr d) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -210,8 +210,8 @@ canClass :: CtEvidence canClass ev cls tys pend_sc = -- all classes do *nominal* matching assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ - do { (redns@(Reductions _ _ xis), rewriters) <- rewriteArgsNom ev cls_tc tys - ; let redn@(Reduction _ _ xi) = mkClassPredRedn cls redns + do { (redns@(Reductions _ xis), rewriters) <- rewriteArgsNom ev cls_tc tys + ; let redn@(Reduction _ xi) = mkClassPredRedn cls redns mk_ct new_ev = CDictCan { cc_ev = new_ev , cc_tyargs = xis , cc_class = cls @@ -1017,19 +1017,17 @@ the rewriter set. We check this with an assertion. -} -rewriteEvidence rewriters old_ev (Reduction _ dco new_pred) +rewriteEvidence rewriters old_ev (Reduction dco new_pred) | isReflDCo dco -- See Note [Rewriting with Refl] = assert (isEmptyRewriterSet rewriters) $ continueWith (setCtEvPredType old_ev new_pred) -rewriteEvidence rewriters ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) (Reduction old_pred dco new_pred) +rewriteEvidence rewriters ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) (Reduction dco new_pred) = assert (isEmptyRewriterSet rewriters) $ -- this is a Given, not a wanted do { let + old_pred = ctEvPred ev dco' = downgradeDCoToRepresentational (ctEvRole ev) old_pred dco new_pred co = mkHydrateDCo Representational old_pred dco' (Just new_pred) - -- NB: this call to mkHydrateDCo is OK, because of the invariant - -- on the LHS type stored in a Reduction. See Note [The Reduction type] - -- in GHC.Core.Reduction. -- mkEvCast optimises ReflCo new_tm = mkEvCast (evId old_evar) co @@ -1040,9 +1038,10 @@ rewriteEvidence new_rewriters ev@(CtWanted { ctev_dest = dest , ctev_loc = loc , ctev_rewriters = rewriters }) - (Reduction old_pred dco new_pred) + (Reduction dco new_pred) = do { mb_new_ev <- newWanted loc rewriters' new_pred ; let + old_pred = ctEvPred ev dco' = downgradeDCoToRepresentational (ctEvRole ev) old_pred dco new_pred co = mkHydrateDCo Representational old_pred dco' (Just new_pred) -- NB: this call to mkHydrateDCo is OK, because of the invariant ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -237,9 +237,10 @@ can_eq_nc' True _rdr_env _envs ev NomEq ty1 _ ty2 _ -- No similarity in type structure detected. Rewrite and try again. can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 = -- Rewrite the two types and try again - do { (redn1@(Reduction _ _ xi1), rewriters1) <- rewrite ev ps_ty1 - ; (redn2@(Reduction _ _ xi2), rewriters2) <- rewrite ev ps_ty2 - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1 + ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped + (ps_ty1,redn1) (ps_ty2,redn2) ; traceTcS "can_eq_nc: go round again" (ppr new_ev $$ ppr xi1 $$ ppr xi2) ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } @@ -631,12 +632,12 @@ can_eq_newtype_nc ev swapped ty1 ((gres, co1), ty1') ty2 ps_ty2 -- through newtypes is tantamount to using their constructors. ; recordUsedGREs gres - ; let redn1 = mkReduction ty1 (mkDehydrateCo co1) ty1' + ; let redn1 = mkReduction (mkDehydrateCo co1) ty1' -- TODO: eliminate dehydration ; new_ev <- rewriteEqEvidence emptyRewriterSet ev' swapped - redn1 (mkReflRedn ps_ty2) + (ty1, redn1) (ps_ty2,mkReflRedn ps_ty2) ; can_eq_nc False new_ev ReprEq ty1' ty1' ty2 ps_ty2 } @@ -707,8 +708,8 @@ canEqCast rewritten ev eq_rel swapped ty1 co1 ty2 ps_ty2 , ppr ty1 <+> text "|>" <+> ppr co1 , ppr ps_ty2 ]) ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkGReflLeftRedn ty1 co1) - (mkReflRedn ps_ty2) + (mkCastTy ty1 co1, mkGReflLeftRedn ty1 co1) + (ps_ty2, mkReflRedn ps_ty2) ; can_eq_nc rewritten new_ev eq_rel ty1 ty1 ty2 ps_ty2 } ------------------------ @@ -1270,7 +1271,8 @@ canEqFailure ev ReprEq ty1 ty2 -- new equalities become available ; traceTcS "canEqFailure with ReprEq" $ vcat [ ppr ev, ppr redn1, ppr redn2 ] - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped + (ty1,redn1) (ty2,redn2) ; continueWith (mkIrredCt ReprEqReason new_ev) } -- | Call when canonicalizing an equality fails with utterly no hope. @@ -1281,7 +1283,8 @@ canEqHardFailure ev ty1 ty2 = do { traceTcS "canEqHardFailure" (ppr ty1 $$ ppr ty2) ; (redn1, rewriters1) <- rewriteForErrors ev ty1 ; (redn2, rewriters2) <- rewriteForErrors ev ty2 - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped + (ty1,redn1) (ty2,redn2) ; continueWith (mkIrredCt ShapeMismatchReason new_ev) } {- @@ -1468,7 +1471,8 @@ canEqCanLHSHetero ev swapped lhs1 ki1 xi2 ki2 ; traceTcS "Hetero equality gives rise to kind equality" (ppr kind_co <+> dcolon <+> sep [ ppr ki1, text "~#", ppr ki2 ]) - ; type_ev <- rewriteEqEvidence rewriters ev swapped lhs_redn rhs_redn + ; type_ev <- rewriteEqEvidence rewriters ev swapped + (xi1,lhs_redn) (xi2,rhs_redn) ; emitWorkNC [type_ev] -- delay the type equality until after we've finished -- the kind equality, which may unlock things @@ -1627,7 +1631,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco finish_with_swapping = do { let lhs1_redn = mkGReflRightMRedn lhs1_ty sym_mco lhs2_redn = mkGReflLeftMRedn lhs2_ty mco - ; new_ev <-rewriteEqEvidence emptyRewriterSet ev swapped lhs1_redn lhs2_redn + ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped + (lhs1_ty, lhs1_redn) (mkCastTyMCo lhs2_ty mco, lhs2_redn) ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } put_tyvar_on_lhs = isWanted ev && eq_rel == NomEq @@ -1771,8 +1776,9 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- co' = new_ev <- if isReflDCo (reductionDCoercion rhs_redn) then return ev - else rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn (mkTyVarTy tv)) rhs_redn + else let lhs = mkTyVarTy tv + in rewriteEqEvidence emptyRewriterSet ev swapped + (lhs, mkReflRedn lhs) (rhs, rhs_redn) ; let tv_ty = mkTyVarTy tv final_rhs = reductionReducedType rhs_redn @@ -1848,8 +1854,8 @@ canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs PuOK rhs_redn _ -> do { new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn lhs_ty) - rhs_redn + (lhs_ty, mkReflRedn lhs_ty) + (rhs, rhs_redn) -- Important: even if the coercion is Refl, -- * new_ev has reductionReducedType on the RHS @@ -1867,9 +1873,10 @@ swapAndFinish :: CtEvidence -> EqRel -> SwapFlag -- mentions alpha, it would not be a canonical constraint as-is. -- We want to flip it to (F tys ~ a), whereupon it is canonical swapAndFinish ev eq_rel swapped lhs_ty can_rhs - = do { new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) - (mkReflRedn (canEqLHSType can_rhs)) - (mkReflRedn lhs_ty) + = do { let rhs = canEqLHSType can_rhs + ; new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) + (rhs, mkReflRedn rhs) + (lhs_ty, mkReflRedn lhs_ty) ; interactEq (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel , eq_lhs = can_rhs, eq_rhs = lhs_ty }) } @@ -1883,9 +1890,10 @@ tryIrredInstead :: CheckTyEqResult -> CtEvidence -> SwapFlag -- This is not very important, and only affects error reporting. tryIrredInstead reason ev swapped lhs rhs = do { traceTcS "cantMakeCanonical" (ppr reason $$ ppr lhs $$ ppr rhs) + ; let lhs_ty = canEqLHSType lhs ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn (canEqLHSType lhs)) - (mkReflRedn rhs) + (lhs_ty, mkReflRedn lhs_ty) + (rhs, mkReflRedn rhs) ; solveIrredEquality (NonCanonicalReason reason) new_ev } ----------------------- @@ -2361,8 +2369,8 @@ rewriteEqEvidence :: RewriterSet -- New rewriters -> CtEvidence -- Old evidence :: olhs ~ orhs (not swapped) -- or orhs ~ olhs (swapped) -> SwapFlag - -> Reduction -- lhs_co :: olhs ~ nlhs - -> Reduction -- rhs_co :: orhs ~ nrhs + -> (Type, Reduction) -- lhs_co :: olhs ~ nlhs + -> (Type, Reduction) -- rhs_co :: orhs ~ nrhs -> TcS CtEvidence -- Of type nlhs ~ nrhs -- With reductions (Reduction lhs_co nlhs) (Reduction rhs_co nrhs), -- rewriteEqEvidence yields, for a given equality (Given g olhs orhs): @@ -2379,7 +2387,8 @@ rewriteEqEvidence :: RewriterSet -- New rewriters -- w : orhs ~ olhs = rhs_co ; sym w1 ; sym lhs_co -- -- It's all a form of rewriteEvidence, specialised for equalities -rewriteEqEvidence new_rewriters old_ev swapped lhs_redn@(Reduction _ lhs_dco nlhs) rhs_redn@(Reduction _ rhs_dco nrhs) +rewriteEqEvidence new_rewriters old_ev swapped (olhs, lhs_redn@(Reduction lhs_dco nlhs)) + (orhs, rhs_redn@(Reduction rhs_dco nrhs)) | NotSwapped <- swapped , isReflDCo lhs_dco -- See Note [Rewriting with Refl] , isReflDCo rhs_dco @@ -2415,8 +2424,8 @@ rewriteEqEvidence new_rewriters old_ev swapped lhs_redn@(Reduction _ lhs_dco nlh where new_pred = mkTcEqPredLikeEv old_ev nlhs nrhs loc = ctEvLoc old_ev - lhs_co = mkHydrateReductionDCoercion (ctEvRole old_ev) lhs_redn - rhs_co = mkHydrateReductionDCoercion (ctEvRole old_ev) rhs_redn + lhs_co = mkHydrateReductionDCoercion (ctEvRole old_ev) olhs lhs_redn + rhs_co = mkHydrateReductionDCoercion (ctEvRole old_ev) orhs rhs_redn {- ********************************************************************** @@ -2675,7 +2684,7 @@ final_qci_check work_ct eq_rel lhs rhs ; case res of OneInst { cir_mk_ev = mk_ev } -> do { ev' <- rewriteEqEvidence emptyRewriterSet ev IsSwapped - (mkReflRedn rhs) (mkReflRedn lhs) + (rhs, mkReflRedn rhs) (lhs, mkReflRedn lhs) ; chooseInstance ev' (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) } _ -> do { traceTcS "final_qci_check:3" (ppr work_ct) ; continueWith work_ct }} ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -729,12 +729,11 @@ lookupFamAppInert rewrite_pred fam_tc tys = do { IS { inert_cans = IC { inert_funeqs = inert_funeqs } } <- getTcSInerts ; return (lookup_inerts inert_funeqs) } where - fam_app = mkTyConApp fam_tc tys lookup_inerts inert_funeqs | Just ecl <- findFunEq inert_funeqs fam_tc tys , Just (EqCt { eq_ev = ctev, eq_rhs = rhs }) <- find (rewrite_pred . eqCtFlavourRole) ecl - = Just (mkReduction fam_app (mkDehydrateCo (ctEvCoercion ctev)) rhs -- SLD TODO: avoid dehydrating? + = Just (mkReduction (mkDehydrateCo (ctEvCoercion ctev)) rhs -- SLD TODO: avoid dehydrating? ,ctEvFlavourRole ctev) | otherwise = Nothing @@ -785,7 +784,7 @@ lookupFamAppCache fam_tc tys Nothing -> return Nothing } extendFamAppCache :: TyCon -> [Type] -> Reduction -> TcS () -extendFamAppCache tc xi_args stuff@(Reduction _ _ ty) +extendFamAppCache tc xi_args stuff@(Reduction _ ty) = do { dflags <- getDynFlags ; when (gopt Opt_FamAppCache dflags) $ do { traceTcS "extendFamAppCache" (vcat [ ppr tc <+> ppr xi_args @@ -1877,7 +1876,7 @@ matchFamTcM tycon args ; return match_fam_result } where ppr_res Nothing = text "Match failed" - ppr_res (Just (Reduction _ co ty)) + ppr_res (Just (Reduction co ty)) = hang (text "Match succeeded:") 2 (vcat [ text "Rewrites to:" <+> ppr ty , text "Coercion:" <+> ppr co ]) ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -93,12 +93,10 @@ runRewriteCtEv ev runRewrite :: CtLoc -> CtFlavour -> EqRel -> RewriteM a -> TcS (a, RewriterSet) runRewrite loc flav eq_rel thing_inside = do { rewriters_ref <- newTcRef emptyRewriterSet - ; followed_ref <- newTcRef emptyVarSet ; let rmode = RE { re_loc = loc , re_flavour = flav , re_eq_rel = eq_rel - , re_rewriters = rewriters_ref - , re_followed = followed_ref } + , re_rewriters = rewriters_ref } ; res <- runRewriteM thing_inside rmode ; rewriters <- readTcRef rewriters_ref ; return (res, rewriters) } @@ -155,26 +153,6 @@ bumpDepth (RewriteM thing_inside) { let !env' = env { re_loc = bumpCtLocDepth (re_loc env) } ; thing_inside env' } --- | Register that we followed a metavariable. --- --- See Wrinkle 2 in Note [The Hydration invariant in the rewriter]. -registerFollowedTyVar :: TcTyVar -> RewriteM () -registerFollowedTyVar tv - = mkRewriteM $ \ (RE { re_followed = followed_ref }) -> - updTcRef followed_ref (`extendVarSet` tv) - --- | Run an inner computation, tracking which type variables it has followed. --- --- See Wrinkle 2 in Note [The Hydration invariant in the rewriter]. -trackFollowedTyVars :: RewriteM a -> RewriteM (a, TyVarSet) -trackFollowedTyVars thing_inside - = mkRewriteM $ \ re@(RE { re_followed = followed_ref }) -> - do { inner_ref <- newTcRef emptyVarSet - ; res <- runRewriteM thing_inside (re { re_followed = inner_ref }) - ; inner_followed <- readTcRef inner_ref - ; updTcRef followed_ref (unionVarSet inner_followed) - ; return (res, inner_followed ) } - -- See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint -- Precondition: the CtEvidence is a CtWanted of an equality recordRewriter :: CtEvidence -> RewriteM () @@ -246,7 +224,6 @@ rewrite ev ty ; result@(redn, _) <- runRewriteCtEv ev (rewrite_one ty) ; traceTcS "rewrite }" $ vcat [ text "ty:" <+> ppr ty - , text "ty':" <+> ppr (reductionOriginalType redn) , text "dco:" <+> ppr (reductionDCoercion redn) , text "xi:" <+> ppr (reductionReducedType redn) ] ; return result } @@ -265,7 +242,7 @@ rewriteForErrors ev ty ; traceTcS "rewriteForErrors }" (ppr $ reductionReducedType redn) ; return $ case ctEvEqRel ev of NomEq -> result - ReprEq -> (mkSubRedn redn, rewriters) } + ReprEq -> (mkSubRedn ty redn, rewriters) } -- See Note [Rewriting] rewriteArgsNom :: CtEvidence -> TyCon -> [TcType] @@ -282,7 +259,7 @@ rewriteArgsNom :: CtEvidence -> TyCon -> [TcType] -- See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint rewriteArgsNom ev tc tys = do { traceTcS "rewriteArgsNom {" (vcat (map ppr tys)) - ; (ArgsReductions redns@(Reductions _ _ tys') kind_dco, rewriters) + ; (ArgsReductions redns@(Reductions _ tys') kind_dco, rewriters) <- runRewriteCtEv ev (rewrite_args_tc tc Nothing tys) ; massert (isReflMCo kind_dco) ; traceTcS "rewriteArgsNom }" (vcat (map ppr tys')) @@ -595,10 +572,10 @@ rewrite_args_fast orig_tys iterate :: [Type] -> RewriteM Reductions iterate (ty : tys) = do - Reduction ty' co xi <- rewrite_one ty - Reductions tys' cos xis <- iterate tys - pure $ Reductions (ty' : tys') (co : cos) (xi : xis) - iterate [] = pure $ Reductions [] [] [] + Reduction co xi <- rewrite_one ty + Reductions cos xis <- iterate tys + pure $ Reductions (co : cos) (xi : xis) + iterate [] = pure $ Reductions [] [] {-# INLINE finish #-} finish :: Reductions -> ArgsReductions @@ -617,7 +594,7 @@ rewrite_args_slow binders inner_ki fvs roles tys -- See Note [The Reduction type] in GHC.Core.Reduction, -- and Note [The Hydration invariant] in GHC.Core.Coercion. -- Relevant test case: T13333. - ; return $ simplifyArgsWorker binders inner_ki fvs roles rewritten_args } + ; return $ simplifyArgsWorker binders inner_ki fvs roles tys rewritten_args } where {-# INLINE rw #-} rw :: Role -> Type -> RewriteM Reduction @@ -676,8 +653,8 @@ rewrite_one (FunTy { ft_af = vis, ft_mult = mult, ft_arg = ty1, ft_res = ty2 }) res_rep = getRuntimeRep (reductionReducedType res_redn) ; ( w_redn - , Reduction arg_rep arg_rep_dco arg_rep_xi - , Reduction res_rep res_rep_dco res_rep_xi + , Reduction arg_rep_dco arg_rep_xi + , Reduction res_rep_dco res_rep_xi ) <- setEqRel NomEq $ liftA3 (,,) (rewrite_one mult) (rewrite_one arg_rep) @@ -735,20 +712,10 @@ rewrite_co co = liftTcS $ zonkCo co -- | Rewrite a reduction, composing the resulting coercions. rewrite_reduction :: Reduction -> RewriteM Reduction -rewrite_reduction redn0@(Reduction _ _ xi) +rewrite_reduction redn0@(Reduction _ xi) = do { redn <- bumpDepth $ rewrite_one xi ; return $ redn0 `mkTransRedn` redn } --- | Zonk the LHS of a 'Reduction' to enforce the Hydration --- invariant of Note [The Hydration invariant] in GHC.Core.Coercion. --- --- See Wrinkle 2 of Note [The Hydration invariant in the rewriter] --- for why this is necessary. -zonk_redn_lhs :: Reduction -> RewriteM Reduction -zonk_redn_lhs (Reduction lhs dco rhs) - = do { lhs <- liftTcS $ zonkTcType lhs - ; return $ Reduction lhs dco rhs } - -- rewrite (nested) AppTys rewrite_app_tys :: Type -> [Type] -> RewriteM Reduction -- commoning up nested applications allows us to look up the function's kind @@ -769,12 +736,12 @@ rewrite_app_ty_args :: Reduction -> [Type] -> RewriteM Reduction rewrite_app_ty_args redn [] -- this will be a common case when called from rewrite_fam_app, so shortcut = return redn -rewrite_app_ty_args fun_redn@(Reduction fun_ty fun_co fun_xi) more_arg_tys +rewrite_app_ty_args fun_redn@(Reduction fun_co fun_xi) more_arg_tys = case tcSplitTyConApp_maybe fun_xi of Just (tc, xis) -> do { let tc_roles = tyConRolesRepresentational tc arg_roles = Inf.dropList xis tc_roles - ; ArgsReductions (Reductions more_arg_tys arg_cos arg_xis) kind_co + ; ArgsReductions (Reductions arg_cos arg_xis) kind_co <- rewrite_vector (typeKind fun_xi) arg_roles more_arg_tys -- We start with a reduction of the form @@ -789,15 +756,14 @@ rewrite_app_ty_args fun_redn@(Reduction fun_ty fun_co fun_xi) more_arg_tys -- fun_co ... ;; T .. arg_co_1 ... arg_co_m ; eq_rel <- getEqRel - ; let app_ty = mkAppTys fun_ty more_arg_tys - app_xi = mkTyConApp tc (xis ++ arg_xis) + ; let app_xi = mkTyConApp tc (xis ++ arg_xis) app_co = case eq_rel of NomEq -> mkAppDCos fun_co arg_cos ReprEq -> mkAppDCos fun_co (mkReflDCos more_arg_tys) `mkTransDCo` mkTyConAppDCo (mkReflDCos xis ++ arg_cos) - ; return $ homogeniseRedn (mkReduction app_ty app_co app_xi) kind_co } + ; return $ homogeniseRedn (mkReduction app_co app_xi) kind_co } Nothing -> do { ArgsReductions redns kind_co <- rewrite_vector (typeKind fun_xi) (Inf.repeat Nominal) more_arg_tys @@ -810,7 +776,7 @@ rewrite_ty_con_app tc tys | otherwise = Just $ tyConRolesX role tc ; ArgsReductions redns kind_co <- rewrite_args_tc tc m_roles tys ; return $ homogeniseRedn - (mkTyConAppRedn_MightBeSynonym role tc redns) + (mkTyConAppRedn_MightBeSynonym role tc tys redns) kind_co } {-# INLINE rewrite_ty_con_app #-} @@ -973,13 +939,12 @@ rewrite_exact_fam_app tc tys ; case result1 of -- Don't use the cache; -- See Note [rewrite_exact_fam_app performance] - { Just redn -> finish (Don'tAddToCache { followed_arg_tvs = emptyVarSet }) redn + { Just redn -> finish Don'tAddToCache redn ; Nothing -> -- That didn't work. So reduce the arguments, in STEP 2. - do { ( ArgsReductions redns@(Reductions tys' _ xis) kind_co - , followed_args) <- - trackFollowedTyVars $ setEqRel NomEq $ rewrite_args_tc tc Nothing tys + do { (ArgsReductions redns@(Reductions _ xis) kind_co) <- + setEqRel NomEq $ rewrite_args_tc tc Nothing tys -- If we manage to rewrite the type family application after -- rewriting the arguments, we will need to compose these @@ -1002,14 +967,6 @@ rewrite_exact_fam_app tc tys (args_redn `mkTransRedn` redn) kind_co - add_to_cache, don't_add_to_cache :: AddToCache - add_to_cache = - RewroteArgsAddToCache - { finish_arg_tys = tys' - , followed_arg_tvs = followed_args } - don't_add_to_cache = - Don'tAddToCache - { followed_arg_tvs = followed_args } give_up :: Reduction give_up = homogenise $ mkReflRedn reduced where reduced = mkTyConApp tc xis @@ -1026,16 +983,16 @@ rewrite_exact_fam_app tc tys -- Don't add something to the cache if the reduction -- contains a coercion hole. | inert_flavour == Given - = add_to_cache + = RewroteArgsAddToCache | otherwise - = don't_add_to_cache + = Don'tAddToCache ; finish use_cache (homogenise downgraded_redn) } where inert_role = eqRelRole inert_eq_rel role = eqRelRole eq_rel !downgraded_redn | inert_role == Nominal && role == Representational - = mkSubRedn redn + = mkSubRedn (mkTyConApp tc xis) redn | otherwise = redn @@ -1044,7 +1001,7 @@ rewrite_exact_fam_app tc tys -- inerts didn't work. Try to reduce again, in STEP 4. do { result3 <- try_to_reduce tc xis tc_rewriters ; case result3 of - Just redn -> finish add_to_cache (homogenise redn) + Just redn -> finish RewroteArgsAddToCache (homogenise redn) -- we have made no progress at all: STEP 5 (GIVEUP). _ -> return give_up }}}}} where @@ -1056,25 +1013,18 @@ rewrite_exact_fam_app tc tys -> RewriteM Reduction finish use_cache redn = do { -- rewrite the result: FINISH 1 - (rewritten_redn, followed_tvs) <- trackFollowedTyVars $ rewrite_reduction redn - ; final_redn <- - if isEmptyVarSet followed_tvs && isEmptyVarSet (followed_arg_tvs use_cache) - then return rewritten_redn - else zonk_redn_lhs rewritten_redn -- See Wrinkle 2 in Note [The Hydration invariant in the rewriter] + final_redn <- rewrite_reduction redn ; case use_cache of { Don'tAddToCache {} -> return final_redn - ; RewroteArgsAddToCache { finish_arg_tys = arg_tys } -> + ; RewroteArgsAddToCache -> -- extend the cache: FINISH 2 do { eq_rel <- getEqRel ; when (eq_rel == NomEq) $ -- the cache only wants Nominal eqs - liftTcS $ extendFamAppCache tc arg_tys final_redn + liftTcS $ extendFamAppCache tc tys final_redn -- This will sometimes duplicate an inert in the cache, -- but avoiding doing so had no impact on performance, and -- it seems easier not to weed out that special case. - -- - -- NB: it's important to use 'arg_tys' and not just 'tys' here. - -- See Wrinkle 3 in Note [The Hydration invariant in the rewriter]. ; return final_redn } } } {-# INLINE finish #-} @@ -1085,15 +1035,9 @@ data AddToCache -- -- See Note [rewrite_exact_fam_app performance]. = Don'tAddToCache - { followed_arg_tvs :: TyVarSet } -- | We rewrote the arguments. We add the type family application, -- with rewritten arguments, to the cache. - -- - -- It's important to use the rewritten arguments when adding to the - -- cache. See Wrinkle 3 in Note [The Hydration invariant in the rewriter]. | RewroteArgsAddToCache - { finish_arg_tys :: [Xi] - , followed_arg_tvs :: TyVarSet } -- Returned coercion is input ~r output, where r is the role in the RewriteM monad -- See Note [How to normalise a family application] @@ -1122,7 +1066,7 @@ try_to_reduce tc tys tc_rewriters -- common NomEq case ; case eq_rel of NomEq -> return redn - ReprEq -> return $ mkSubRedn redn } + ReprEq -> return $ mkSubRedn (mkTyConApp tc tys) redn } -- Retrieve all type-checking plugins that can rewrite a (saturated) type-family application -- headed by the given 'TyCon`. @@ -1217,10 +1161,6 @@ rewrite_tyvar1 tv ; case mb_ty of Just ty -> do { traceRewriteM "Following filled tyvar" (ppr tv <+> equals <+> ppr ty) - ; registerFollowedTyVar tv - -- Register that we followed a metavariable. - -- - -- See Wrinkle 2 in Note [The Hydration invariant in the rewriter]. ; return $ RTRFollowedMeta ty } Nothing -> do { traceRewriteM "Unfilled tyvar" (pprTyVar tv) ; fr <- getFlavourRole @@ -1255,7 +1195,7 @@ rewrite_tyvar2 tv fr@(_, eq_rel) (NomEq, NomEq) -> rewriting_dco1 (NomEq, ReprEq) -> mkSubDCo lhs_ty rewriting_dco1 rhs_ty - ; return $ RTRFollowedInert $ mkReduction lhs_ty rewriting_dco rhs_ty } + ; return $ RTRFollowedInert $ mkReduction rewriting_dco rhs_ty } _other -> return RTRNotFollowed } where ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -295,11 +295,6 @@ data RewriteEnv -- See Note [Rewriter EqRels] in GHC.Tc.Solver.Rewrite , re_rewriters :: !(TcRef RewriterSet) -- ^ See Note [Wanteds rewrite Wanteds] - - , re_followed :: !(TcRef TyVarSet) - -- ^ Used to keep track of which metavariables we have followed. - -- - -- See Note [The Hydration invariant in the rewriter] in GHC.Tc.Solver.Rewrite. } -- RewriteEnv is mostly used in @GHC.Tc.Solver.Rewrite@, but it is defined -- here so that it can also be passed to rewriting plugins. ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -1061,7 +1061,7 @@ dataConSrcToImplBang bang_opts fam_envs arg_ty else case mb_redn of Nothing -> HsUnpack Nothing Just redn -> HsUnpack $ Just $ - mkHydrateReductionDCoercion Representational redn + mkHydrateReductionDCoercion Representational (scaledThing arg_ty) redn | otherwise -- Record the strict-but-no-unpack decision = HsStrict False ===================================== testsuite/tests/dcoercion/DCo_Phantom.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, TypeOperators, TypeFamilies, +{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies, UndecidableInstances, ConstraintKinds #-} module DCo_Phantom where ===================================== testsuite/tests/dcoercion/DCo_Phantom.stderr ===================================== @@ -1,5 +1,5 @@ -DCo_Phantom.hs:35:11: warning: [-Wtyped-holes (in -Wdefault)] +DCo_Phantom.hs:35:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: _a :: [Integer] -> Sorted (O ('NLogN 2 0)) (O N) 'True Integer Or perhaps ‘_a’ is mis-spelled, or not in scope ===================================== testsuite/tests/dcoercion/DCo_Specialise.hs ===================================== @@ -4,6 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module DCo_Specialise ( rnStmts1 ) where ===================================== testsuite/tests/dcoercion/DCo_T15703_aux.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -8,7 +9,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43c4c1e6607ec098b8b7806e9e62ed3c4251e1e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43c4c1e6607ec098b8b7806e9e62ed3c4251e1e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 23:18:08 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Fri, 12 May 2023 19:18:08 -0400 Subject: [Git][ghc/ghc][wip/amg/dcoercion] WIP: remove LHS type in Reduction Message-ID: <645ec930965ce_171ad9bce1c162321@gitlab.mail> sheaf pushed to branch wip/amg/dcoercion at Glasgow Haskell Compiler / GHC Commits: 5e07c825 by sheaf at 2023-05-13T01:17:50+02:00 WIP: remove LHS type in Reduction - - - - - 20 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Id/Make.hs - testsuite/tests/dcoercion/DCo_Phantom.hs - testsuite/tests/dcoercion/DCo_Phantom.stderr - testsuite/tests/dcoercion/DCo_Specialise.hs - testsuite/tests/dcoercion/DCo_T15703_aux.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1011,6 +1011,8 @@ mkSubDCo l_ty dco r_ty = case dco of | Just (tc, arg_l_tys) <- splitTyConApp_maybe l_ty , Just (_ , arg_r_tys) <- splitTyConApp_maybe r_ty -> TyConAppDCo (applyRoles_dco tc arg_l_tys dcos arg_r_tys) + -- SLD TODO: we might need to get rid of this case, + -- to avoid calling applyRoles, which calls mkHydrateDCo. DehydrateCo co -> DehydrateCo (mkSubCo co) UnivDCo prov r @@ -1188,6 +1190,7 @@ See Note [The Reduction type] in GHC.Core.Reduction. mkHydrateDCo :: HasDebugCallStack => Role -> Type -> DCoercion -> Maybe Type -> Coercion mkHydrateDCo r l_ty dco mb_r_ty | debugIsOn + , isNothing mb_r_ty -- Check that 'followDCo' does not crash, -- i.e. that the Hydration invariant is satisfied. = check_hydration_invariant r l_ty dco $ @@ -1447,7 +1450,7 @@ expandOneStepDCo check_prop throw_err r l_ty -- LHS type is not a TyConApp. Nothing -> - throw_err (text"StepsDCo: LHS not a TyConApp" $$ debug_info) + throw_err (text "StepsDCo: LHS not a TyConApp" $$ debug_info) where debug_info = vcat [ text "r:" <+> ppr r , text "l_ty:" <+> ppr l_ty ] @@ -1774,9 +1777,11 @@ mkSelCo_maybe cs co -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2) -- then (nth SelForAll co :: (t1 ~ t2) ~N (t3 ~ t4)) - go SelForAll (HydrateDCo r _ (ForAllDCo tv kind_co _) _) - = assert (r == Nominal) $ - Just $ mkHydrateDCo Nominal (tyVarKind tv) kind_co Nothing + go SelForAll dco@(HydrateDCo _ _ (ForAllDCo tv kind_co _) rhs) + = case splitForAllTyCoVar_maybe rhs of + Just (tv', _) -> Just $ + mkHydrateDCo Nominal (tyVarKind tv) kind_co (Just $ tyVarKind tv') + _ -> pprPanic "mkSelCo_maybe" (ppr dco $$ ppr rhs) go (SelFun fs) (FunCo _ _ _ w arg res) = Just (getNthFun fs w arg res) @@ -1820,7 +1825,7 @@ mkSelCo_maybe cs co good_call SelForAll | Just (_tv1, _) <- splitForAllTyCoVar_maybe ty1 , Just (_tv2, _) <- splitForAllTyCoVar_maybe ty2 - = True + = True good_call (SelFun {}) = isFunTy ty1 && isFunTy ty2 @@ -2083,6 +2088,7 @@ setNominalRole_maybe_dco r ty (TransDCo dco1 dco2) = TransDCo <$> setNominalRole_maybe_dco r ty dco1 <*> setNominalRole_maybe_dco r mid_ty dco2 where mid_ty = followDCo r ty dco1 + -- OK to call followDCo here: this function is always called on fully zonked types. setNominalRole_maybe_dco _ _ (SubDCo dco) = Just dco setNominalRole_maybe_dco r _ (DehydrateCo co) = DehydrateCo <$> setNominalRole_maybe r co setNominalRole_maybe_dco _ _ (UnivDCo prov rhs) ===================================== compiler/GHC/Core/FamInstEnv.hs ===================================== @@ -1350,7 +1350,7 @@ topNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe Reduction -- original type, and the returned coercion is always homogeneous. topNormaliseType_maybe env ty = do { ((dco, mkind_co), nty) <- topNormaliseTypeX stepper combine ty - ; return $ homogeniseRedn (mkReduction ty dco nty) mkind_co } + ; return $ homogeniseRedn (mkReduction dco nty) mkind_co } where stepper = unwrapNewTypeStepper' `composeSteppers` tyFamStepper @@ -1365,7 +1365,7 @@ topNormaliseType_maybe env ty tyFamStepper :: NormaliseStepper (DCoercion, MCoercionN) tyFamStepper rec_nts tc tys -- Try to step a type/data family = case topReduceTyFamApp_maybe env tc tys of - Just (HetReduction (Reduction _ co rhs) res_co) + Just (HetReduction (Reduction co rhs) res_co) -> NS_Step rec_nts rhs (co, res_co) _ -> NS_Done @@ -1388,7 +1388,7 @@ topReduceTyFamApp_maybe envs fam_tc arg_tys = Nothing where role = Representational - ArgsReductions args_redns@(Reductions _ _ ntys) res_co + ArgsReductions args_redns@(Reductions _ ntys) res_co = initNormM envs role (tyCoVarsOfTypes arg_tys) $ normalise_tc_args fam_tc arg_tys @@ -1424,7 +1424,7 @@ normalise_tc_app tc tys = -- A type-family application do { env <- getEnv ; role <- getRole - ; ArgsReductions redns@(Reductions _ _ ntys) res_co <- normalise_tc_args tc tys + ; ArgsReductions redns@(Reductions _ ntys) res_co <- normalise_tc_args tc tys ; case reduceTyFamApp_maybe env role tc ntys of Just redn1 -> do { redn2 <- normalise_reduction redn1 @@ -1441,7 +1441,7 @@ normalise_tc_app tc tys do { ArgsReductions redns res_co <- normalise_tc_args tc tys ; role <- getRole ; return $ - homogeniseRedn (mkTyConAppRedn_MightBeSynonym role tc redns) res_co } + homogeniseRedn (mkTyConAppRedn_MightBeSynonym role tc tys redns) res_co } -- NB: we assume "tys" satisfy the hydration invariant from -- Note [The Hydration invariant] in GHC.Core.Coercion, -- because the "normalise" functions all only deal with fully zonked types. @@ -1501,7 +1501,7 @@ normalise_type ty -- cf. GHC.Tc.Solver.Rewrite.rewrite_app_ty_args go_app_tys (AppTy ty1 ty2) tys = go_app_tys ty1 (ty2 : tys) go_app_tys fun_ty arg_tys - = do { fun_redn@(Reduction _ _ nfun) <- go fun_ty + = do { fun_redn@(Reduction _ nfun) <- go fun_ty ; case tcSplitTyConApp_maybe nfun of Just (tc, xis) -> do { redn <- go (mkTyConApp tc (xis ++ arg_tys)) @@ -1532,7 +1532,7 @@ normalise_args :: Kind -- of the function -- cf. GHC.Tc.Solver.Rewrite.rewrite_args_slow normalise_args fun_ki roles args = do { normed_args <- zipWithM normalise1 (Inf.toList roles) args - ; return $ simplifyArgsWorker ki_binders inner_ki fvs roles normed_args } + ; return $ simplifyArgsWorker ki_binders inner_ki fvs roles args normed_args } where (ki_binders, inner_ki) = splitPiTys fun_ki fvs = tyCoVarsOfTypes args @@ -1550,7 +1550,7 @@ normalise_tyvar tv Nothing -> mkReflRedn (mkTyVarTy tv) } normalise_reduction :: Reduction -> NormM Reduction -normalise_reduction redn@(Reduction _ _ ty) +normalise_reduction redn@(Reduction _ ty) = do { redn' <- normalise_type ty ; return $ redn `mkTransRedn` redn' } @@ -1560,10 +1560,11 @@ normalise_var_bndr tcvar = do { lc1 <- getLC ; env <- getEnv ; let - do_normalise ki = do { redn <- normalise_type ki; return redn } - callback lc ki = runNormM (do_normalise ki) env lc Nominal - ; return $ liftCoSubstVarBndrUsing (mkHydrateReductionDCoercion Nominal) - callback lc1 tcvar } + mk_co (lhs, redn) = mkHydrateReductionDCoercion Nominal lhs redn + do_normalise ki = do { redn <- normalise_type ki; return (ki, redn) } + callback lc ki = runNormM (do_normalise ki) env lc Nominal + (lc, tcv, (_, redn)) = liftCoSubstVarBndrUsing mk_co callback lc1 tcvar + ; return (lc, tcv, redn) } -- | a monad for the normalisation functions, reading 'FamInstEnvs', -- a 'LiftingContext', and a 'Role'. ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3254,9 +3254,11 @@ improveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv -> SimplM (SimplEnv, OutExpr, OutId) -- Note [Improving seq] improveSeq fam_envs env scrut case_bndr case_bndr1 [Alt DEFAULT _ _] - | Just redn@(Reduction _ _ ty2) <- topNormaliseType_maybe fam_envs (idType case_bndr1) + | let ty1 = idType case_bndr1 + , Just redn@(Reduction _ ty2) <- topNormaliseType_maybe fam_envs ty1 = do { case_bndr2 <- newId (fsLit "nt") ManyTy ty2 - ; let co = mkHydrateReductionDCoercion Representational redn + ; let co = mkHydrateReductionDCoercion Representational ty1 redn + -- SLD TODO: OK because zonked. rhs = DoneEx (Var case_bndr2 `Cast` mkSymCo co) Nothing env2 = extendIdSubst env case_bndr rhs ; return (env2, scrut `Cast` co, case_bndr2) } ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -1316,7 +1316,7 @@ findTypeShape fam_envs ty = TsUnk go_tc rec_tc tc tc_args - | Just (HetReduction (Reduction _ _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args + | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs | Just con <- tyConSingleAlgDataCon_maybe tc @@ -1411,7 +1411,7 @@ isRecDataCon fam_envs fuel orig_dc go_tc_app fuel visited_tcs tc tc_args = case tyConDataCons_maybe tc of --- | pprTrace "tc_app" (vcat [ppr tc, ppr tc_args]) False = undefined - _ | Just (HetReduction (Reduction _ _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args + _ | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args -- This is the only place where we look at tc_args, which might have -- See Note [Detecting recursive data constructors], point (C) and (5) -> go_arg_ty fuel visited_tcs rhs ===================================== compiler/GHC/Core/Reduction.hs ===================================== @@ -62,27 +62,23 @@ Note [The Reduction type] Many functions in the type-checker rewrite a type, using Given type equalities or type-family reductions, and return a Reduction: - data Reduction = Reduction Type Coercion !Type + data Reduction = Reduction Coercion !Type -When we rewrite ty at role r, producing Reduction ty' dco xi, we guarantee: +When we rewrite ty at role r, producing Reduction dco xi, we guarantee: - RW1: ty' is equal to ty (up to zonking) - RW2: followDCo r ty' dco is equal to xi (up to zonking) + RW2: followDCo r (zonk ty) dco is equal to xi, up to zonking -In particular, this means that `dco :: ty' ~r xi`. Note that we need to use ty', -and not ty, to satisfy RW2; see Note [The Hydration invariant] in GHC.Core.Coercion. -It could be the case that `followDCo r ty dco` crashes, e.g. if `ty` is a metavariable -and `dco = TyConAppDCo ..`. This is why we store the LHS type in the Reduction too. +In particular, this means that `dco :: ty ~r xi`. Note however that we might +need to zonk... SLD TODO explain. The order of the arguments to the constructor serves as a reminder -of what the Type is. In +of what the Type is. In - Reduction ty' dco xi + ty ~rewrites to~> Reduction dco xi -the original type ty appears to the left, and the result appears on the right, -reminding us that we must have: +the result appears on the right, reminding us that we must have: - dco :: ty' ~r xi + dco :: ty ~r xi Example functions that use this datatype: @@ -104,21 +100,16 @@ a tuple (with all fields lazy), gives several advantages (see #20161) -- | A 'Reduction' is the result of an operation that rewrites a type @ty_in at . -- The 'Reduction' includes: -- --- - an input type @ty_in'@, equal to @ty_in@ up to zonking, -- - a directed coercion @dco@, -- - the rewritten type @ty_out@ -- --- such that @dco :: ty_in' ~ ty_out@, where the role @r@ of the coercion is determined --- by the context. --- --- Invariant: it is always valid to call @followDCo r ty_in' dco@, as per --- Note [The Hydration invariant] in GHC.Core.Coercion. +-- such that @dco :: ty_in ~ ty_out@, where the role @r@ of the coercion +-- is determined by the context. -- -- See Note [The Reduction type]. data Reduction = Reduction - { reductionOriginalType :: Type - , reductionDCoercion :: DCoercion + { reductionDCoercion :: DCoercion , reductionReducedType :: !Type } -- N.B. the 'Coercion' field must be lazy: see for instance GHC.Tc.Solver.Rewrite.rewrite_tyvar2 @@ -134,12 +125,9 @@ type ReductionR = Reduction -- | Create a 'Reduction' from a pair of a 'Coercion' and a 'Type. -- --- Pre-condition: the RHS type of the coercion matches the provided type --- (perhaps up to zonking). --- -- Use 'coercionRedn' when you only have the coercion. -mkReduction :: Type -> DCoercion -> Type -> Reduction -mkReduction lty co rty = Reduction lty co rty +mkReduction :: DCoercion -> Type -> Reduction +mkReduction co rty = Reduction co rty {-# INLINE mkReduction #-} instance Outputable Reduction where @@ -149,18 +137,17 @@ instance Outputable Reduction where , text " reductionDCoercion:" <+> ppr (reductionDCoercion redn) ] --- | Turn a 'Coercion' into a 'Reduction' --- by inspecting the LHS and RHS types of the coercion, and dehydrating. +-- | Turn a 'Coercion' into a 'Reduction' by dehydrating. -- -- Prefer using 'mkReduction' wherever possible to avoid doing these indirections. mkDehydrateCoercionRedn :: Coercion -> Reduction mkDehydrateCoercionRedn co = - Reduction (coercionLKind co) (mkDehydrateCo co) (coercionRKind co) + Reduction (mkDehydrateCo co) (coercionRKind co) {-# INLINE mkDehydrateCoercionRedn #-} -- | Hydrate the 'DCoercion' stored inside a 'Reduction' into a full-fledged 'Coercion'. -mkHydrateReductionDCoercion :: HasDebugCallStack => Role -> Reduction -> Coercion -mkHydrateReductionDCoercion r (Reduction lty dco rty) = mkHydrateDCo r lty dco (Just rty) +mkHydrateReductionDCoercion :: HasDebugCallStack => Role -> Type -> Reduction -> Coercion +mkHydrateReductionDCoercion r lty (Reduction dco rty) = mkHydrateDCo r lty dco (Just rty) -- N.B.: we use the LHS type stored in the 'Reduction' to ensure -- we satisfy the Hydration invariant of Note [The Hydration invariant] -- in GHC.Core.Coercion. @@ -168,8 +155,8 @@ mkHydrateReductionDCoercion r (Reduction lty dco rty) = mkHydrateDCo r lty dco ( -- | Downgrade the role of the directed coercion stored in the 'Reduction', -- from 'Nominal' to 'Representational'. -mkSubRedn :: Reduction -> Reduction -mkSubRedn redn@(Reduction lhs dco rhs) +mkSubRedn :: HasDebugCallStack => Type -> Reduction -> Reduction +mkSubRedn lhs redn@(Reduction dco rhs) = redn { reductionDCoercion = mkSubDCo lhs dco rhs } {-# INLINE mkSubRedn #-} @@ -183,13 +170,13 @@ mkSubRedn redn@(Reduction lhs dco rhs) -- as required by Note [The Reduction type]. You must manually ensure this -- invariant. mkTransRedn :: Reduction -> Reduction -> Reduction -mkTransRedn (Reduction ty1 dco1 _) (Reduction _ dco2 ty2) - = Reduction ty1 (dco1 `mkTransDCo` dco2) ty2 +mkTransRedn (Reduction dco1 _) (Reduction dco2 ty2) + = Reduction (dco1 `mkTransDCo` dco2) ty2 {-# INLINE mkTransRedn #-} -- | The reflexive reduction. mkReflRedn :: Type -> Reduction -mkReflRedn ty = mkReduction ty mkReflDCo ty +mkReflRedn ty = mkReduction mkReflDCo ty {-# INLINE mkReflRedn #-} -- | Create a 'Reduction' from a kind cast, in which @@ -201,7 +188,6 @@ mkReflRedn ty = mkReduction ty mkReflDCo ty mkGReflRightRedn :: Type -> CoercionN -> Reduction mkGReflRightRedn ty co = mkReduction - ty (mkGReflRightDCo co) (mkCastTy ty co) {-# INLINE mkGReflRightRedn #-} @@ -217,7 +203,6 @@ mkGReflRightMRedn ty MRefl = mkReflRedn ty mkGReflRightMRedn ty (MCo kco) = mkReduction - ty (mkGReflRightDCo kco) (mkCastTy ty kco) {-# INLINE mkGReflRightMRedn #-} @@ -231,7 +216,6 @@ mkGReflRightMRedn ty (MCo kco) mkGReflLeftRedn :: Type -> CoercionN -> Reduction mkGReflLeftRedn ty co = mkReduction - (mkCastTy ty co) (mkGReflLeftDCo co) ty {-# INLINE mkGReflLeftRedn #-} @@ -247,7 +231,6 @@ mkGReflLeftMRedn ty MRefl = mkReflRedn ty mkGReflLeftMRedn ty (MCo kco) = mkReduction - (mkCastTy ty kco) (mkGReflLeftDCo kco) ty {-# INLINE mkGReflLeftMRedn #-} @@ -259,9 +242,8 @@ mkGReflLeftMRedn ty (MCo kco) -- of the given 'Role' (which must match the role of the coercion stored -- in the 'Reduction' argument). mkCoherenceRightRedn :: Reduction -> CoercionN -> Reduction -mkCoherenceRightRedn (Reduction ty1 co1 ty2) kco +mkCoherenceRightRedn (Reduction co1 ty2) kco = mkReduction - ty1 (mkCoherenceRightDCo kco co1) (mkCastTy ty2 kco) {-# INLINE mkCoherenceRightRedn #-} @@ -274,9 +256,8 @@ mkCoherenceRightRedn (Reduction ty1 co1 ty2) kco -- in the 'Reduction' argument). mkCoherenceRightMRedn :: Reduction -> MCoercionN -> Reduction mkCoherenceRightMRedn redn MRefl = redn -mkCoherenceRightMRedn (Reduction ty1 co1 ty2) (MCo kco) +mkCoherenceRightMRedn (Reduction co1 ty2) (MCo kco) = mkReduction - ty1 (mkCoherenceRightDCo kco co1) (mkCastTy ty2 kco) {-# INLINE mkCoherenceRightMRedn #-} @@ -293,11 +274,10 @@ mkCoherenceRightMRedn (Reduction ty1 co1 ty2) (MCo kco) mkCastRedn1 :: CoercionN -- ^ coercion to cast with -> Reduction -- ^ rewritten type, with rewriting coercion -> Reduction -mkCastRedn1 cast_co (Reduction ty dco xi) +mkCastRedn1 cast_co (Reduction dco xi) -- co :: ty ~r ty' -- return_co :: (ty |> cast_co) ~r (ty' |> cast_co) = mkReduction - (mkCastTy ty cast_co) (castDCoercionKind1 dco cast_co) (mkCastTy xi cast_co) {-# INLINE mkCastRedn1 #-} @@ -313,9 +293,8 @@ mkCastRedn2 :: CoercionN -- ^ coercion to cast with on the left -> Reduction -- ^ rewritten type, with rewriting coercion -> CoercionN -- ^ coercion to cast with on the right -> Reduction -mkCastRedn2 cast_co (Reduction ty nco nty) cast_co' +mkCastRedn2 cast_co (Reduction nco nty) cast_co' = mkReduction - (mkCastTy ty cast_co) (castDCoercionKind2 nco cast_co cast_co') (mkCastTy nty cast_co') {-# INLINE mkCastRedn2 #-} @@ -324,9 +303,8 @@ mkCastRedn2 cast_co (Reduction ty nco nty) cast_co' -- -- Combines 'mkAppCo' and 'mkAppTy`. mkAppRedn :: Reduction -> Reduction -> Reduction -mkAppRedn (Reduction lty1 co1 rty1) (Reduction lty2 co2 rty2) +mkAppRedn (Reduction co1 rty1) (Reduction co2 rty2) = mkReduction - (mkAppTy lty1 lty2) (mkAppDCo co1 co2) (mkAppTy rty1 rty2) {-# INLINE mkAppRedn #-} @@ -342,13 +320,12 @@ mkFunRedn :: FunTyFlag -> Reduction -- ^ result reduction -> Reduction mkFunRedn af - (Reduction w_lty w_co w_rty) + (Reduction w_co w_rty) arg_repco res_repco - (Reduction arg_lty arg_co arg_rty) - (Reduction res_lty res_co res_rty) + (Reduction arg_co arg_rty) + (Reduction res_co res_rty) = mkReduction - (mkFunTy af w_lty arg_lty res_lty) (mkFunDCo w_co arg_repco res_repco arg_co res_co) (mkFunTy af w_rty arg_rty res_rty) {-# INLINE mkFunRedn #-} @@ -362,9 +339,8 @@ mkForAllRedn :: ForAllTyFlag -> ReductionN -- ^ kind reduction -> Reduction -- ^ body reduction -> Reduction -mkForAllRedn vis tv1 (Reduction _ h rki) (Reduction lty co rty) +mkForAllRedn vis tv1 (Reduction h rki) (Reduction co rty) = mkReduction - (mkForAllTy (Bndr tv1 vis) lty) (mkForAllDCo tv1 h co) (mkForAllTy (Bndr tv2 vis) rty) where @@ -376,9 +352,8 @@ mkForAllRedn vis tv1 (Reduction _ h rki) (Reduction lty co rty) -- -- Combines 'mkHomoForAllCos' and 'mkForAllTys'. mkHomoForAllRedn :: [TyVarBinder] -> Reduction -> Reduction -mkHomoForAllRedn bndrs (Reduction ty1 co ty2) +mkHomoForAllRedn bndrs (Reduction co ty2) = mkReduction - (mkForAllTys bndrs ty1) (mkHomoForAllDCos (binderVars bndrs) co) (mkForAllTys bndrs ty2) {-# INLINE mkHomoForAllRedn #-} @@ -390,22 +365,18 @@ mkProofIrrelRedn :: Coercion -- ^ lhs_co -> DCoercionN -- ^ dco :: lhs_co ~ rhs_co -> Coercion -- ^ rhs_co -> Reduction -mkProofIrrelRedn g1 co g2 +mkProofIrrelRedn _g1 co g2 = mkReduction - lhs_co (mkProofIrrelDCo co rhs_co) rhs_co where - lhs_co = mkCoercionTy g1 rhs_co = mkCoercionTy g2 {-# INLINE mkProofIrrelRedn #-} -- | Create a reflexive 'Reduction' whose LHS and RHS is the given 'Coercion', -- with the specified 'Role'. mkReflCoRedn :: Coercion -> Reduction -mkReflCoRedn co = mkReduction co_ty mkReflDCo co_ty - where - co_ty = mkCoercionTy co +mkReflCoRedn co = mkReduction mkReflDCo (mkCoercionTy co) {-# INLINE mkReflCoRedn #-} -- | A collection of 'Reduction's where the coercions and the types are stored separately. @@ -417,22 +388,22 @@ mkReflCoRedn co = mkReduction co_ty mkReflDCo co_ty -- -- Invariant: given @Reductions lhs_tys dcos rhs_tys@, and an ambient role @r@, -- we can obtain the @rhs_tys@ by following the directed coercions starting from the repsective --- @lhs_tys at . Equivalent, @zipWith (followDCo r) lhs_tys dcos@ is equal (up to zonking) to @rhs_tys at . -data Reductions = Reductions [Type] [DCoercion] [Type] +-- @lhs_tys at . Equivalently, @zipWith (followDCo r) lhs_tys dcos@ is equal (up to zonking) to @rhs_tys at . +data Reductions = Reductions [DCoercion] [Type] instance Outputable Reductions where - ppr (Reductions ltys dcos rtys) = parens (text "Reductions" <+> ppr ltys <+> ppr dcos <+> ppr rtys) + ppr (Reductions dcos rtys) = parens (text "Reductions" <+> ppr dcos <+> ppr rtys) -- | Create 'Reductions' from individual lists of coercions and types. -- -- The lists should be of the same length, and the RHS type of each coercion -- should match the specified type in the other list. -mkReductions :: [Type] -> [DCoercion] -> [Type] -> Reductions -mkReductions tys1 cos tys2 = Reductions tys1 cos tys2 +mkReductions :: [DCoercion] -> [Type] -> Reductions +mkReductions cos tys2 = Reductions cos tys2 {-# INLINE mkReductions #-} mkReflRedns :: [Type] -> Reductions -mkReflRedns tys = mkReductions tys (mkReflDCos tys) tys +mkReflRedns tys = mkReductions (mkReflDCos tys) tys {-# INLINE mkReflRedns #-} mkReflDCos :: [Type] -> [DCoercion] @@ -441,8 +412,8 @@ mkReflDCos tys = replicate (length tys) mkReflDCo -- | Combines 'mkAppCos' and 'mkAppTys'. mkAppRedns :: Reduction -> Reductions -> Reduction -mkAppRedns (Reduction ty1 co ty2) (Reductions tys1 cos tys2) - = mkReduction (mkAppTys ty1 tys1) (mkAppDCos co cos) (mkAppTys ty2 tys2) +mkAppRedns (Reduction co ty2) (Reductions cos tys2) + = mkReduction (mkAppDCos co cos) (mkAppTys ty2 tys2) {-# INLINE mkAppRedns #-} -- | 'TyConAppCo' for 'Reduction's: combines 'mkTyConAppCo' and `mkTyConApp`. @@ -450,15 +421,15 @@ mkAppRedns (Reduction ty1 co ty2) (Reductions tys1 cos tys2) -- Use this when you know the 'TyCon' is not a type synonym. If it might be, -- use 'mkTyConAppRedn_MightBeSynonym'. mkTyConAppRedn :: TyCon -> Reductions -> Reduction -mkTyConAppRedn tc (Reductions tys1 cos tys2) - = mkReduction (mkTyConApp tc tys1) (mkTyConAppDCo cos) (mkTyConApp tc tys2) +mkTyConAppRedn tc (Reductions cos tys2) + = mkReduction (mkTyConAppDCo cos) (mkTyConApp tc tys2) {-# INLINE mkTyConAppRedn #-} -- | 'TyConAppCo' for 'Reduction's: combines 'mkTyConAppCo' and `mkTyConApp`. -- -- Use 'mkTyConAppRedn' if the 'TyCon' is definitely not a type synonym. -mkTyConAppRedn_MightBeSynonym :: Role -> TyCon -> Reductions -> Reduction -mkTyConAppRedn_MightBeSynonym role tc redns@(Reductions tys1 dcos tys2) +mkTyConAppRedn_MightBeSynonym :: Role -> TyCon -> [Type] -> Reductions -> Reduction +mkTyConAppRedn_MightBeSynonym role tc tys1 redns@(Reductions dcos tys2) -- 'mkTyConAppCo' handles synomyms by using substitution lifting. -- We don't have that for directed coercions, so we use hydrate/dehydrate -- so that we can call 'liftCoSubst'. @@ -466,8 +437,8 @@ mkTyConAppRedn_MightBeSynonym role tc redns@(Reductions tys1 dcos tys2) -- for directed coercions to avoid this (and a similar issue in simplifyArgsWorker). | ExpandsSyn tv_dco_prs rhs_ty leftover_dcos <- expandSynTyCon_maybe tc dcos , let tv_co_prs = zipWith4 hydrate (tyConRoleListX role tc) tys1 tv_dco_prs tys2 - = mkReduction - (mkTyConApp tc tys1) + = -- SLD TODO: assert this is a non-forgetful TySyn with no TyFams on the RHS + mkReduction (mkAppDCos (mkDehydrateCo $ liftCoSubst role (mkLiftingContext tv_co_prs) rhs_ty) leftover_dcos) (mkTyConApp tc tys2) | otherwise = mkTyConAppRedn tc redns @@ -477,25 +448,25 @@ mkTyConAppRedn_MightBeSynonym role tc redns@(Reductions tys1 dcos tys2) -- which are stored in 'Reductions'. -- This upholds the necessary hydration invariant from -- Note [The Hydration invariant] in GHC.Core.Coercion. + -- SLD TODO... {-# INLINE hydrate #-} {-# INLINE mkTyConAppRedn_MightBeSynonym #-} -- | Reduce the arguments of a 'Class' 'TyCon'. mkClassPredRedn :: Class -> Reductions -> Reduction -mkClassPredRedn cls (Reductions tys1 cos tys2) +mkClassPredRedn cls (Reductions cos tys2) = mkReduction - (mkClassPred cls tys1) (mkTyConAppDCo cos) (mkClassPred cls tys2) {-# INLINE mkClassPredRedn #-} -- | Obtain 'Reductions' from a list of 'Reduction's by unzipping. unzipRedns :: [Reduction] -> Reductions -unzipRedns = foldr accRedn (Reductions [] [] []) +unzipRedns = foldr accRedn (Reductions [] []) where accRedn :: Reduction -> Reductions -> Reductions - accRedn (Reduction ty co xi) (Reductions tys cos xis) - = Reductions (ty:tys) (co:cos) (xi:xis) + accRedn (Reduction co xi) (Reductions cos xis) + = Reductions (co:cos) (xi:xis) {-# INLINE unzipRedns #-} -- NB: this function is currently used in two locations: -- @@ -887,6 +858,7 @@ simplifyArgsWorker :: HasDebugCallStack -- list of binders can be shorter or longer than the list of args -> TyCoVarSet -- free vars of the args -> Infinite Role-- list of roles, r + -> [Type] -- original type arguments ty_i -> [Reduction] -- rewritten type arguments, arg_i -- each comes with the coercion used to rewrite it, -- arg_co_i :: ty_i ~ arg_i @@ -900,10 +872,10 @@ simplifyArgsWorker :: HasDebugCallStack -- function is all about. That is, (f xi_1 ... xi_n), where xi_i are the returned arguments, -- *is* well kinded. simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs - orig_roles redns + orig_roles tys redns = go orig_lc orig_ki_binders orig_inner_ki - orig_roles redns + orig_roles (zip tys redns) where orig_lc = emptyLiftingContext $ mkInScopeSet orig_fvs @@ -911,20 +883,20 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs -> [PiTyBinder] -- Unsubsted binders of function's kind -> Kind -- Unsubsted result kind of function (not a Pi-type) -> Infinite Role -- Roles at which to rewrite these ... - -> [Reduction] -- rewritten arguments, with their rewriting coercions + -> [(Type, Reduction)] -- rewritten arguments, with their rewriting coercions -> ArgsReductions go !lc binders inner_ki _ [] -- The !lc makes the function strict in the lifting context -- which means GHC can unbox that pair. A modest win. = ArgsReductions - (mkReductions [] [] []) + (mkReductions [] []) kind_co where final_kind = mkPiTys binders inner_ki kind_co | noFreeVarsOfType final_kind = MRefl | otherwise = MCo $ liftCoSubst Nominal lc final_kind - go lc (binder:binders) inner_ki (Inf role roles) (arg_redn:arg_redns) + go lc (binder:binders) inner_ki (Inf role roles) ((orig_ty,arg_redn):arg_redns) = -- We rewrite an argument ty with arg_redn = Reduction arg_co arg -- By Note [Rewriting] in GHC.Tc.Solver.Rewrite invariant (F2), -- typeKind(ty) = typeKind(arg). @@ -936,12 +908,13 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs -- The bangs here have been observed to improve performance -- significantly in optimized builds; see #18502 let !kind_co = liftCoSubst Nominal lc (piTyBinderType binder) - !(Reduction arg_ty casted_co casted_xi) + !(Reduction casted_co casted_xi) = mkCoherenceRightRedn arg_redn kind_co -- now, extend the lifting context with the new binding !new_lc | Just tv <- namedPiTyBinder_maybe binder = extendLiftingContextAndInScope lc tv - (mkHydrateDCo role arg_ty casted_co (Just casted_xi)) + (mkHydrateDCo role orig_ty casted_co (Just casted_xi)) + -- SLD TODO: reword the following. -- NB: this is the crucial place where we need the hydration invariant, -- which is satisfied here as we use the LHS type stored in a 'Reduction'. -- See Note [The Reduction type], as well as @@ -951,18 +924,19 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs -- we need this. | otherwise = lc - !(ArgsReductions (Reductions arg_tys cos xis) final_kind_co) + !(ArgsReductions (Reductions cos xis) final_kind_co) = go new_lc binders inner_ki roles arg_redns in ArgsReductions - (Reductions (arg_ty:arg_tys) (casted_co:cos) (casted_xi:xis)) + (Reductions (casted_co:cos) (casted_xi:xis)) final_kind_co -- See Note [Last case in simplifyArgsWorker] - go lc [] inner_ki roles arg_redns + go lc [] inner_ki roles arg_tys_and_redns = let co1 = liftCoSubst Nominal lc inner_ki + (orig_tys, arg_redns) = unzip arg_tys_and_redns co1_kind = coercionKind co1 - (arg_cos, res_co) = decomposePiCos co1 co1_kind (map reductionOriginalType arg_redns) - casted_args = assertPpr (equalLength arg_redns arg_cos) + (arg_cos, res_co) = decomposePiCos co1 co1_kind orig_tys + casted_redns = assertPpr (equalLength arg_redns arg_cos) (ppr arg_redns $$ ppr arg_cos) $ zipWith mkCoherenceRightRedn arg_redns arg_cos -- In general decomposePiCos can return fewer cos than tys, @@ -976,6 +950,6 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs (bndrs, new_inner) = splitPiTys rewritten_kind ArgsReductions redns_out res_co_out - = go zapped_lc bndrs new_inner roles casted_args + = go zapped_lc bndrs new_inner roles (zip orig_tys casted_redns) in ArgsReductions redns_out (res_co `mkTransMCoR` res_co_out) ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -68,9 +68,7 @@ import {-# SOURCE #-} GHC.Core.Coercion , mkAppDCo, mkForAllDCo, mkReflDCo, mkTransDCo , mkGReflRightDCo, mkGReflLeftDCo , mkHydrateDCo, mkDehydrateCo, mkUnivDCo - , followDCo , coercionKind, coercionLKind, coVarKindsTypesRole) -import GHC.Core.Coercion.Axiom (Role(..)) import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprTyVar ) import {-# SOURCE #-} GHC.Core.Ppr ( ) import {-# SOURCE #-} GHC.Core ( CoreExpr ) @@ -1034,8 +1032,8 @@ substForAllCoTyVarBndrUsing co_or_dco sym sty sco (Subst in_scope idenv tenv cen DCo -> noFreeVarsOfDCo old_kind_co mk_cast = case co_or_dco of Co -> CastTy - DCo -> \ ty dco -> CastTy ty (mkHydrateDCo Nominal new_ki1 dco Nothing) - -- SLD TODO: Hydration invariant? + DCo -> pprPanic "substForAllCoTyVarBndrUsing DCo Sym" + (vcat [ text "kind_co:" <+> ppr old_kind_co ]) no_change = no_kind_change && (new_var == old_var) @@ -1060,7 +1058,7 @@ substForAllCoCoVarBndrUsing :: CoOrDCo kco -> (Subst, CoVar, kco) substForAllCoCoVarBndrUsing co_or_dco sym sty sco (Subst in_scope idenv tenv cenv) old_var old_kind_co - = assert (isCoVar old_var ) + = assert (isCoVar old_var) ( Subst (in_scope `extendInScopeSet` new_var) idenv tenv new_cenv , new_var, new_kind_co ) where @@ -1079,8 +1077,8 @@ substForAllCoCoVarBndrUsing co_or_dco sym sty sco (Subst in_scope idenv tenv cen Co -> coercionKind new_kind_co DCo -> let l_ty = sty (varType old_var) - r_ty = followDCo Nominal l_ty new_kind_co - -- SLD TODO: Hydration invariant satisfied? + r_ty = pprPanic "substForAllCoCoVarBndrUsing DCo Sym" + (vcat [ text "kind_co:" <+> ppr old_kind_co]) in Pair l_ty r_ty new_var = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2384,10 +2384,10 @@ isEmptyTy ty -- coercions via 'topNormaliseType_maybe'. Hence the \"norm\" prefix. normSplitTyConApp_maybe :: FamInstEnvs -> Type -> Maybe (TyCon, [Type], Coercion) normSplitTyConApp_maybe fam_envs ty - | let Reduction ty' co ty1 = topNormaliseType_maybe fam_envs ty + | let Reduction co ty1 = topNormaliseType_maybe fam_envs ty `orElse` (mkReflRedn ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 - = Just (tc, tc_args, mkHydrateDCo Representational ty' co (Just ty1)) + = Just (tc, tc_args, mkHydrateDCo Representational ty co (Just ty1)) -- N.B.: the hydration invariant is satisfied here, as we have already zonked -- everything by the time we call this function. -- See Note [The Hydration invariant] in GHC.Core.Coercion. ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -386,7 +386,7 @@ pmTopNormaliseType (TySt _ inert) typ = {-# SCC "pmTopNormaliseType" #-} do tyFamStepper :: FamInstEnvs -> NormaliseStepper ([Type] -> [Type], a -> a) tyFamStepper env rec_nts tc tys -- Try to step a type/data family = case topReduceTyFamApp_maybe env tc tys of - Just (HetReduction (Reduction _ _ rhs) _) + Just (HetReduction (Reduction _ rhs) _) -> NS_Step rec_nts rhs ((rhs:), id) _ -> NS_Done ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1494,6 +1494,8 @@ tcIfaceCo = go go (IfaceHydrateDCo r t1 dco)= do { t1 <- tcIfaceType t1 ; dco <- tcIfaceDCo dco ; return $ HydrateDCo r t1 dco (followDCo r t1 dco) } + -- SLD TODO: investigate perf impact here... + -- might be worth storing RHS in the interface file... go (IfaceUnivCo p r t1 t2) = UnivCo <$> tcIfaceUnivCoProv go p <*> pure r <*> tcIfaceType t1 <*> tcIfaceType t2 go (IfaceSymCo c) = SymCo <$> go c ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -171,8 +171,8 @@ normaliseFfiType' env ty0 = runWriterT $ go Representational initRecTc ty0 ; return $ mkDehydrateCoercionRedn nt_co `mkTransRedn` redn } } -- AMG TODO | isFamilyTyCon tc -- Expand open tycons - , redn0@(Reduction l_ty dco ty) <- normaliseTcApp env role tc tys - , not (isReflexiveDCo role l_ty dco ty) + , redn0@(Reduction dco ty) <- normaliseTcApp env role tc tys + , not (isReflexiveDCo role (mkTyConApp tc tys) dco ty) = do redn <- go role rec_nts ty return $ redn0 `mkTransRedn` redn @@ -252,7 +252,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty , fd_fi = imp_decl })) = setSrcSpanA dloc $ addErrCtxt (foreignDeclCtxt fo) $ do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty - ; (redn@(Reduction sig_ty _ norm_sig_ty), gres) <- normaliseFfiType sig_ty + ; (redn@(Reduction _ norm_sig_ty), gres) <- normaliseFfiType sig_ty ; let -- Drop the foralls before inspecting the -- structure of the foreign type. @@ -272,7 +272,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl -- Can't use sig_ty here because sig_ty :: Type and -- we need HsType Id hence the undefined - ; let co = mkSymCo $ mkHydrateReductionDCoercion Representational redn + ; let co = mkSymCo $ mkHydrateReductionDCoercion Representational sig_ty redn fi_decl = ForeignImport { fd_name = L nloc id , fd_sig_ty = undefined @@ -413,7 +413,7 @@ tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spe sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty rhs <- tcCheckPolyExpr (nlHsVar nm) sig_ty - (redn@(Reduction sig_ty _ norm_sig_ty), gres) <- normaliseFfiType sig_ty + (redn@(Reduction _ norm_sig_ty), gres) <- normaliseFfiType sig_ty spec' <- tcCheckFEType norm_sig_ty spec @@ -430,7 +430,7 @@ tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spe return ( mkVarBind id rhs , ForeignExport { fd_name = L loc id , fd_sig_ty = undefined - , fd_e_ext = mkHydrateReductionDCoercion Representational redn + , fd_e_ext = mkHydrateReductionDCoercion Representational sig_ty redn , fd_fe = spec' } , gres) tcFExport d = pprPanic "tcFExport" (ppr d) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -210,8 +210,8 @@ canClass :: CtEvidence canClass ev cls tys pend_sc = -- all classes do *nominal* matching assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ - do { (redns@(Reductions _ _ xis), rewriters) <- rewriteArgsNom ev cls_tc tys - ; let redn@(Reduction _ _ xi) = mkClassPredRedn cls redns + do { (redns@(Reductions _ xis), rewriters) <- rewriteArgsNom ev cls_tc tys + ; let redn@(Reduction _ xi) = mkClassPredRedn cls redns mk_ct new_ev = CDictCan { cc_ev = new_ev , cc_tyargs = xis , cc_class = cls @@ -1017,19 +1017,17 @@ the rewriter set. We check this with an assertion. -} -rewriteEvidence rewriters old_ev (Reduction _ dco new_pred) +rewriteEvidence rewriters old_ev (Reduction dco new_pred) | isReflDCo dco -- See Note [Rewriting with Refl] = assert (isEmptyRewriterSet rewriters) $ continueWith (setCtEvPredType old_ev new_pred) -rewriteEvidence rewriters ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) (Reduction old_pred dco new_pred) +rewriteEvidence rewriters ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) (Reduction dco new_pred) = assert (isEmptyRewriterSet rewriters) $ -- this is a Given, not a wanted do { let + old_pred = ctEvPred ev dco' = downgradeDCoToRepresentational (ctEvRole ev) old_pred dco new_pred co = mkHydrateDCo Representational old_pred dco' (Just new_pred) - -- NB: this call to mkHydrateDCo is OK, because of the invariant - -- on the LHS type stored in a Reduction. See Note [The Reduction type] - -- in GHC.Core.Reduction. -- mkEvCast optimises ReflCo new_tm = mkEvCast (evId old_evar) co @@ -1040,9 +1038,10 @@ rewriteEvidence new_rewriters ev@(CtWanted { ctev_dest = dest , ctev_loc = loc , ctev_rewriters = rewriters }) - (Reduction old_pred dco new_pred) + (Reduction dco new_pred) = do { mb_new_ev <- newWanted loc rewriters' new_pred ; let + old_pred = ctEvPred ev dco' = downgradeDCoToRepresentational (ctEvRole ev) old_pred dco new_pred co = mkHydrateDCo Representational old_pred dco' (Just new_pred) -- NB: this call to mkHydrateDCo is OK, because of the invariant ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -237,9 +237,10 @@ can_eq_nc' True _rdr_env _envs ev NomEq ty1 _ ty2 _ -- No similarity in type structure detected. Rewrite and try again. can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 = -- Rewrite the two types and try again - do { (redn1@(Reduction _ _ xi1), rewriters1) <- rewrite ev ps_ty1 - ; (redn2@(Reduction _ _ xi2), rewriters2) <- rewrite ev ps_ty2 - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1 + ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped + (ps_ty1,redn1) (ps_ty2,redn2) ; traceTcS "can_eq_nc: go round again" (ppr new_ev $$ ppr xi1 $$ ppr xi2) ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } @@ -631,12 +632,12 @@ can_eq_newtype_nc ev swapped ty1 ((gres, co1), ty1') ty2 ps_ty2 -- through newtypes is tantamount to using their constructors. ; recordUsedGREs gres - ; let redn1 = mkReduction ty1 (mkDehydrateCo co1) ty1' + ; let redn1 = mkReduction (mkDehydrateCo co1) ty1' -- TODO: eliminate dehydration ; new_ev <- rewriteEqEvidence emptyRewriterSet ev' swapped - redn1 (mkReflRedn ps_ty2) + (ty1, redn1) (ps_ty2,mkReflRedn ps_ty2) ; can_eq_nc False new_ev ReprEq ty1' ty1' ty2 ps_ty2 } @@ -707,8 +708,8 @@ canEqCast rewritten ev eq_rel swapped ty1 co1 ty2 ps_ty2 , ppr ty1 <+> text "|>" <+> ppr co1 , ppr ps_ty2 ]) ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkGReflLeftRedn ty1 co1) - (mkReflRedn ps_ty2) + (mkCastTy ty1 co1, mkGReflLeftRedn ty1 co1) + (ps_ty2, mkReflRedn ps_ty2) ; can_eq_nc rewritten new_ev eq_rel ty1 ty1 ty2 ps_ty2 } ------------------------ @@ -1270,7 +1271,8 @@ canEqFailure ev ReprEq ty1 ty2 -- new equalities become available ; traceTcS "canEqFailure with ReprEq" $ vcat [ ppr ev, ppr redn1, ppr redn2 ] - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped + (ty1,redn1) (ty2,redn2) ; continueWith (mkIrredCt ReprEqReason new_ev) } -- | Call when canonicalizing an equality fails with utterly no hope. @@ -1281,7 +1283,8 @@ canEqHardFailure ev ty1 ty2 = do { traceTcS "canEqHardFailure" (ppr ty1 $$ ppr ty2) ; (redn1, rewriters1) <- rewriteForErrors ev ty1 ; (redn2, rewriters2) <- rewriteForErrors ev ty2 - ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped + (ty1,redn1) (ty2,redn2) ; continueWith (mkIrredCt ShapeMismatchReason new_ev) } {- @@ -1468,7 +1471,8 @@ canEqCanLHSHetero ev swapped lhs1 ki1 xi2 ki2 ; traceTcS "Hetero equality gives rise to kind equality" (ppr kind_co <+> dcolon <+> sep [ ppr ki1, text "~#", ppr ki2 ]) - ; type_ev <- rewriteEqEvidence rewriters ev swapped lhs_redn rhs_redn + ; type_ev <- rewriteEqEvidence rewriters ev swapped + (xi1,lhs_redn) (xi2,rhs_redn) ; emitWorkNC [type_ev] -- delay the type equality until after we've finished -- the kind equality, which may unlock things @@ -1627,7 +1631,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco finish_with_swapping = do { let lhs1_redn = mkGReflRightMRedn lhs1_ty sym_mco lhs2_redn = mkGReflLeftMRedn lhs2_ty mco - ; new_ev <-rewriteEqEvidence emptyRewriterSet ev swapped lhs1_redn lhs2_redn + ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped + (lhs1_ty, lhs1_redn) (mkCastTyMCo lhs2_ty mco, lhs2_redn) ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } put_tyvar_on_lhs = isWanted ev && eq_rel == NomEq @@ -1771,8 +1776,9 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- co' = new_ev <- if isReflDCo (reductionDCoercion rhs_redn) then return ev - else rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn (mkTyVarTy tv)) rhs_redn + else let lhs = mkTyVarTy tv + in rewriteEqEvidence emptyRewriterSet ev swapped + (lhs, mkReflRedn lhs) (rhs, rhs_redn) ; let tv_ty = mkTyVarTy tv final_rhs = reductionReducedType rhs_redn @@ -1848,8 +1854,8 @@ canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs PuOK rhs_redn _ -> do { new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn lhs_ty) - rhs_redn + (lhs_ty, mkReflRedn lhs_ty) + (rhs, rhs_redn) -- Important: even if the coercion is Refl, -- * new_ev has reductionReducedType on the RHS @@ -1867,9 +1873,10 @@ swapAndFinish :: CtEvidence -> EqRel -> SwapFlag -- mentions alpha, it would not be a canonical constraint as-is. -- We want to flip it to (F tys ~ a), whereupon it is canonical swapAndFinish ev eq_rel swapped lhs_ty can_rhs - = do { new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) - (mkReflRedn (canEqLHSType can_rhs)) - (mkReflRedn lhs_ty) + = do { let rhs = canEqLHSType can_rhs + ; new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) + (rhs, mkReflRedn rhs) + (lhs_ty, mkReflRedn lhs_ty) ; interactEq (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel , eq_lhs = can_rhs, eq_rhs = lhs_ty }) } @@ -1883,9 +1890,10 @@ tryIrredInstead :: CheckTyEqResult -> CtEvidence -> SwapFlag -- This is not very important, and only affects error reporting. tryIrredInstead reason ev swapped lhs rhs = do { traceTcS "cantMakeCanonical" (ppr reason $$ ppr lhs $$ ppr rhs) + ; let lhs_ty = canEqLHSType lhs ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn (canEqLHSType lhs)) - (mkReflRedn rhs) + (lhs_ty, mkReflRedn lhs_ty) + (rhs, mkReflRedn rhs) ; solveIrredEquality (NonCanonicalReason reason) new_ev } ----------------------- @@ -2361,8 +2369,8 @@ rewriteEqEvidence :: RewriterSet -- New rewriters -> CtEvidence -- Old evidence :: olhs ~ orhs (not swapped) -- or orhs ~ olhs (swapped) -> SwapFlag - -> Reduction -- lhs_co :: olhs ~ nlhs - -> Reduction -- rhs_co :: orhs ~ nrhs + -> (Type, Reduction) -- lhs_co :: olhs ~ nlhs + -> (Type, Reduction) -- rhs_co :: orhs ~ nrhs -> TcS CtEvidence -- Of type nlhs ~ nrhs -- With reductions (Reduction lhs_co nlhs) (Reduction rhs_co nrhs), -- rewriteEqEvidence yields, for a given equality (Given g olhs orhs): @@ -2379,7 +2387,8 @@ rewriteEqEvidence :: RewriterSet -- New rewriters -- w : orhs ~ olhs = rhs_co ; sym w1 ; sym lhs_co -- -- It's all a form of rewriteEvidence, specialised for equalities -rewriteEqEvidence new_rewriters old_ev swapped lhs_redn@(Reduction _ lhs_dco nlhs) rhs_redn@(Reduction _ rhs_dco nrhs) +rewriteEqEvidence new_rewriters old_ev swapped (olhs, lhs_redn@(Reduction lhs_dco nlhs)) + (orhs, rhs_redn@(Reduction rhs_dco nrhs)) | NotSwapped <- swapped , isReflDCo lhs_dco -- See Note [Rewriting with Refl] , isReflDCo rhs_dco @@ -2415,8 +2424,8 @@ rewriteEqEvidence new_rewriters old_ev swapped lhs_redn@(Reduction _ lhs_dco nlh where new_pred = mkTcEqPredLikeEv old_ev nlhs nrhs loc = ctEvLoc old_ev - lhs_co = mkHydrateReductionDCoercion (ctEvRole old_ev) lhs_redn - rhs_co = mkHydrateReductionDCoercion (ctEvRole old_ev) rhs_redn + lhs_co = mkHydrateReductionDCoercion (ctEvRole old_ev) olhs lhs_redn + rhs_co = mkHydrateReductionDCoercion (ctEvRole old_ev) orhs rhs_redn {- ********************************************************************** @@ -2675,7 +2684,7 @@ final_qci_check work_ct eq_rel lhs rhs ; case res of OneInst { cir_mk_ev = mk_ev } -> do { ev' <- rewriteEqEvidence emptyRewriterSet ev IsSwapped - (mkReflRedn rhs) (mkReflRedn lhs) + (rhs, mkReflRedn rhs) (lhs, mkReflRedn lhs) ; chooseInstance ev' (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) } _ -> do { traceTcS "final_qci_check:3" (ppr work_ct) ; continueWith work_ct }} ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -729,12 +729,11 @@ lookupFamAppInert rewrite_pred fam_tc tys = do { IS { inert_cans = IC { inert_funeqs = inert_funeqs } } <- getTcSInerts ; return (lookup_inerts inert_funeqs) } where - fam_app = mkTyConApp fam_tc tys lookup_inerts inert_funeqs | Just ecl <- findFunEq inert_funeqs fam_tc tys , Just (EqCt { eq_ev = ctev, eq_rhs = rhs }) <- find (rewrite_pred . eqCtFlavourRole) ecl - = Just (mkReduction fam_app (mkDehydrateCo (ctEvCoercion ctev)) rhs -- SLD TODO: avoid dehydrating? + = Just (mkReduction (mkDehydrateCo (ctEvCoercion ctev)) rhs -- SLD TODO: avoid dehydrating? ,ctEvFlavourRole ctev) | otherwise = Nothing @@ -785,7 +784,7 @@ lookupFamAppCache fam_tc tys Nothing -> return Nothing } extendFamAppCache :: TyCon -> [Type] -> Reduction -> TcS () -extendFamAppCache tc xi_args stuff@(Reduction _ _ ty) +extendFamAppCache tc xi_args stuff@(Reduction _ ty) = do { dflags <- getDynFlags ; when (gopt Opt_FamAppCache dflags) $ do { traceTcS "extendFamAppCache" (vcat [ ppr tc <+> ppr xi_args @@ -1877,7 +1876,7 @@ matchFamTcM tycon args ; return match_fam_result } where ppr_res Nothing = text "Match failed" - ppr_res (Just (Reduction _ co ty)) + ppr_res (Just (Reduction co ty)) = hang (text "Match succeeded:") 2 (vcat [ text "Rewrites to:" <+> ppr ty , text "Coercion:" <+> ppr co ]) ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -93,12 +93,10 @@ runRewriteCtEv ev runRewrite :: CtLoc -> CtFlavour -> EqRel -> RewriteM a -> TcS (a, RewriterSet) runRewrite loc flav eq_rel thing_inside = do { rewriters_ref <- newTcRef emptyRewriterSet - ; followed_ref <- newTcRef emptyVarSet ; let rmode = RE { re_loc = loc , re_flavour = flav , re_eq_rel = eq_rel - , re_rewriters = rewriters_ref - , re_followed = followed_ref } + , re_rewriters = rewriters_ref } ; res <- runRewriteM thing_inside rmode ; rewriters <- readTcRef rewriters_ref ; return (res, rewriters) } @@ -155,26 +153,6 @@ bumpDepth (RewriteM thing_inside) { let !env' = env { re_loc = bumpCtLocDepth (re_loc env) } ; thing_inside env' } --- | Register that we followed a metavariable. --- --- See Wrinkle 2 in Note [The Hydration invariant in the rewriter]. -registerFollowedTyVar :: TcTyVar -> RewriteM () -registerFollowedTyVar tv - = mkRewriteM $ \ (RE { re_followed = followed_ref }) -> - updTcRef followed_ref (`extendVarSet` tv) - --- | Run an inner computation, tracking which type variables it has followed. --- --- See Wrinkle 2 in Note [The Hydration invariant in the rewriter]. -trackFollowedTyVars :: RewriteM a -> RewriteM (a, TyVarSet) -trackFollowedTyVars thing_inside - = mkRewriteM $ \ re@(RE { re_followed = followed_ref }) -> - do { inner_ref <- newTcRef emptyVarSet - ; res <- runRewriteM thing_inside (re { re_followed = inner_ref }) - ; inner_followed <- readTcRef inner_ref - ; updTcRef followed_ref (unionVarSet inner_followed) - ; return (res, inner_followed ) } - -- See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint -- Precondition: the CtEvidence is a CtWanted of an equality recordRewriter :: CtEvidence -> RewriteM () @@ -246,7 +224,6 @@ rewrite ev ty ; result@(redn, _) <- runRewriteCtEv ev (rewrite_one ty) ; traceTcS "rewrite }" $ vcat [ text "ty:" <+> ppr ty - , text "ty':" <+> ppr (reductionOriginalType redn) , text "dco:" <+> ppr (reductionDCoercion redn) , text "xi:" <+> ppr (reductionReducedType redn) ] ; return result } @@ -265,7 +242,7 @@ rewriteForErrors ev ty ; traceTcS "rewriteForErrors }" (ppr $ reductionReducedType redn) ; return $ case ctEvEqRel ev of NomEq -> result - ReprEq -> (mkSubRedn redn, rewriters) } + ReprEq -> (mkSubRedn ty redn, rewriters) } -- See Note [Rewriting] rewriteArgsNom :: CtEvidence -> TyCon -> [TcType] @@ -282,7 +259,7 @@ rewriteArgsNom :: CtEvidence -> TyCon -> [TcType] -- See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint rewriteArgsNom ev tc tys = do { traceTcS "rewriteArgsNom {" (vcat (map ppr tys)) - ; (ArgsReductions redns@(Reductions _ _ tys') kind_dco, rewriters) + ; (ArgsReductions redns@(Reductions _ tys') kind_dco, rewriters) <- runRewriteCtEv ev (rewrite_args_tc tc Nothing tys) ; massert (isReflMCo kind_dco) ; traceTcS "rewriteArgsNom }" (vcat (map ppr tys')) @@ -595,10 +572,10 @@ rewrite_args_fast orig_tys iterate :: [Type] -> RewriteM Reductions iterate (ty : tys) = do - Reduction ty' co xi <- rewrite_one ty - Reductions tys' cos xis <- iterate tys - pure $ Reductions (ty' : tys') (co : cos) (xi : xis) - iterate [] = pure $ Reductions [] [] [] + Reduction co xi <- rewrite_one ty + Reductions cos xis <- iterate tys + pure $ Reductions (co : cos) (xi : xis) + iterate [] = pure $ Reductions [] [] {-# INLINE finish #-} finish :: Reductions -> ArgsReductions @@ -617,7 +594,7 @@ rewrite_args_slow binders inner_ki fvs roles tys -- See Note [The Reduction type] in GHC.Core.Reduction, -- and Note [The Hydration invariant] in GHC.Core.Coercion. -- Relevant test case: T13333. - ; return $ simplifyArgsWorker binders inner_ki fvs roles rewritten_args } + ; return $ simplifyArgsWorker binders inner_ki fvs roles tys rewritten_args } where {-# INLINE rw #-} rw :: Role -> Type -> RewriteM Reduction @@ -676,8 +653,8 @@ rewrite_one (FunTy { ft_af = vis, ft_mult = mult, ft_arg = ty1, ft_res = ty2 }) res_rep = getRuntimeRep (reductionReducedType res_redn) ; ( w_redn - , Reduction arg_rep arg_rep_dco arg_rep_xi - , Reduction res_rep res_rep_dco res_rep_xi + , Reduction arg_rep_dco arg_rep_xi + , Reduction res_rep_dco res_rep_xi ) <- setEqRel NomEq $ liftA3 (,,) (rewrite_one mult) (rewrite_one arg_rep) @@ -735,20 +712,10 @@ rewrite_co co = liftTcS $ zonkCo co -- | Rewrite a reduction, composing the resulting coercions. rewrite_reduction :: Reduction -> RewriteM Reduction -rewrite_reduction redn0@(Reduction _ _ xi) +rewrite_reduction redn0@(Reduction _ xi) = do { redn <- bumpDepth $ rewrite_one xi ; return $ redn0 `mkTransRedn` redn } --- | Zonk the LHS of a 'Reduction' to enforce the Hydration --- invariant of Note [The Hydration invariant] in GHC.Core.Coercion. --- --- See Wrinkle 2 of Note [The Hydration invariant in the rewriter] --- for why this is necessary. -zonk_redn_lhs :: Reduction -> RewriteM Reduction -zonk_redn_lhs (Reduction lhs dco rhs) - = do { lhs <- liftTcS $ zonkTcType lhs - ; return $ Reduction lhs dco rhs } - -- rewrite (nested) AppTys rewrite_app_tys :: Type -> [Type] -> RewriteM Reduction -- commoning up nested applications allows us to look up the function's kind @@ -769,12 +736,12 @@ rewrite_app_ty_args :: Reduction -> [Type] -> RewriteM Reduction rewrite_app_ty_args redn [] -- this will be a common case when called from rewrite_fam_app, so shortcut = return redn -rewrite_app_ty_args fun_redn@(Reduction fun_ty fun_co fun_xi) more_arg_tys +rewrite_app_ty_args fun_redn@(Reduction fun_co fun_xi) more_arg_tys = case tcSplitTyConApp_maybe fun_xi of Just (tc, xis) -> do { let tc_roles = tyConRolesRepresentational tc arg_roles = Inf.dropList xis tc_roles - ; ArgsReductions (Reductions more_arg_tys arg_cos arg_xis) kind_co + ; ArgsReductions (Reductions arg_cos arg_xis) kind_co <- rewrite_vector (typeKind fun_xi) arg_roles more_arg_tys -- We start with a reduction of the form @@ -789,15 +756,14 @@ rewrite_app_ty_args fun_redn@(Reduction fun_ty fun_co fun_xi) more_arg_tys -- fun_co ... ;; T .. arg_co_1 ... arg_co_m ; eq_rel <- getEqRel - ; let app_ty = mkAppTys fun_ty more_arg_tys - app_xi = mkTyConApp tc (xis ++ arg_xis) + ; let app_xi = mkTyConApp tc (xis ++ arg_xis) app_co = case eq_rel of NomEq -> mkAppDCos fun_co arg_cos ReprEq -> mkAppDCos fun_co (mkReflDCos more_arg_tys) `mkTransDCo` mkTyConAppDCo (mkReflDCos xis ++ arg_cos) - ; return $ homogeniseRedn (mkReduction app_ty app_co app_xi) kind_co } + ; return $ homogeniseRedn (mkReduction app_co app_xi) kind_co } Nothing -> do { ArgsReductions redns kind_co <- rewrite_vector (typeKind fun_xi) (Inf.repeat Nominal) more_arg_tys @@ -810,7 +776,7 @@ rewrite_ty_con_app tc tys | otherwise = Just $ tyConRolesX role tc ; ArgsReductions redns kind_co <- rewrite_args_tc tc m_roles tys ; return $ homogeniseRedn - (mkTyConAppRedn_MightBeSynonym role tc redns) + (mkTyConAppRedn_MightBeSynonym role tc tys redns) kind_co } {-# INLINE rewrite_ty_con_app #-} @@ -973,13 +939,12 @@ rewrite_exact_fam_app tc tys ; case result1 of -- Don't use the cache; -- See Note [rewrite_exact_fam_app performance] - { Just redn -> finish (Don'tAddToCache { followed_arg_tvs = emptyVarSet }) redn + { Just redn -> finish Don'tAddToCache redn ; Nothing -> -- That didn't work. So reduce the arguments, in STEP 2. - do { ( ArgsReductions redns@(Reductions tys' _ xis) kind_co - , followed_args) <- - trackFollowedTyVars $ setEqRel NomEq $ rewrite_args_tc tc Nothing tys + do { (ArgsReductions redns@(Reductions _ xis) kind_co) <- + setEqRel NomEq $ rewrite_args_tc tc Nothing tys -- If we manage to rewrite the type family application after -- rewriting the arguments, we will need to compose these @@ -1002,14 +967,6 @@ rewrite_exact_fam_app tc tys (args_redn `mkTransRedn` redn) kind_co - add_to_cache, don't_add_to_cache :: AddToCache - add_to_cache = - RewroteArgsAddToCache - { finish_arg_tys = tys' - , followed_arg_tvs = followed_args } - don't_add_to_cache = - Don'tAddToCache - { followed_arg_tvs = followed_args } give_up :: Reduction give_up = homogenise $ mkReflRedn reduced where reduced = mkTyConApp tc xis @@ -1026,16 +983,16 @@ rewrite_exact_fam_app tc tys -- Don't add something to the cache if the reduction -- contains a coercion hole. | inert_flavour == Given - = add_to_cache + = RewroteArgsAddToCache | otherwise - = don't_add_to_cache + = Don'tAddToCache ; finish use_cache (homogenise downgraded_redn) } where inert_role = eqRelRole inert_eq_rel role = eqRelRole eq_rel !downgraded_redn | inert_role == Nominal && role == Representational - = mkSubRedn redn + = mkSubRedn (mkTyConApp tc xis) redn | otherwise = redn @@ -1044,7 +1001,7 @@ rewrite_exact_fam_app tc tys -- inerts didn't work. Try to reduce again, in STEP 4. do { result3 <- try_to_reduce tc xis tc_rewriters ; case result3 of - Just redn -> finish add_to_cache (homogenise redn) + Just redn -> finish RewroteArgsAddToCache (homogenise redn) -- we have made no progress at all: STEP 5 (GIVEUP). _ -> return give_up }}}}} where @@ -1056,25 +1013,18 @@ rewrite_exact_fam_app tc tys -> RewriteM Reduction finish use_cache redn = do { -- rewrite the result: FINISH 1 - (rewritten_redn, followed_tvs) <- trackFollowedTyVars $ rewrite_reduction redn - ; final_redn <- - if isEmptyVarSet followed_tvs && isEmptyVarSet (followed_arg_tvs use_cache) - then return rewritten_redn - else zonk_redn_lhs rewritten_redn -- See Wrinkle 2 in Note [The Hydration invariant in the rewriter] + final_redn <- rewrite_reduction redn ; case use_cache of { Don'tAddToCache {} -> return final_redn - ; RewroteArgsAddToCache { finish_arg_tys = arg_tys } -> + ; RewroteArgsAddToCache -> -- extend the cache: FINISH 2 do { eq_rel <- getEqRel ; when (eq_rel == NomEq) $ -- the cache only wants Nominal eqs - liftTcS $ extendFamAppCache tc arg_tys final_redn + liftTcS $ extendFamAppCache tc tys final_redn -- This will sometimes duplicate an inert in the cache, -- but avoiding doing so had no impact on performance, and -- it seems easier not to weed out that special case. - -- - -- NB: it's important to use 'arg_tys' and not just 'tys' here. - -- See Wrinkle 3 in Note [The Hydration invariant in the rewriter]. ; return final_redn } } } {-# INLINE finish #-} @@ -1085,15 +1035,9 @@ data AddToCache -- -- See Note [rewrite_exact_fam_app performance]. = Don'tAddToCache - { followed_arg_tvs :: TyVarSet } -- | We rewrote the arguments. We add the type family application, -- with rewritten arguments, to the cache. - -- - -- It's important to use the rewritten arguments when adding to the - -- cache. See Wrinkle 3 in Note [The Hydration invariant in the rewriter]. | RewroteArgsAddToCache - { finish_arg_tys :: [Xi] - , followed_arg_tvs :: TyVarSet } -- Returned coercion is input ~r output, where r is the role in the RewriteM monad -- See Note [How to normalise a family application] @@ -1122,7 +1066,7 @@ try_to_reduce tc tys tc_rewriters -- common NomEq case ; case eq_rel of NomEq -> return redn - ReprEq -> return $ mkSubRedn redn } + ReprEq -> return $ mkSubRedn (mkTyConApp tc tys) redn } -- Retrieve all type-checking plugins that can rewrite a (saturated) type-family application -- headed by the given 'TyCon`. @@ -1217,10 +1161,6 @@ rewrite_tyvar1 tv ; case mb_ty of Just ty -> do { traceRewriteM "Following filled tyvar" (ppr tv <+> equals <+> ppr ty) - ; registerFollowedTyVar tv - -- Register that we followed a metavariable. - -- - -- See Wrinkle 2 in Note [The Hydration invariant in the rewriter]. ; return $ RTRFollowedMeta ty } Nothing -> do { traceRewriteM "Unfilled tyvar" (pprTyVar tv) ; fr <- getFlavourRole @@ -1255,7 +1195,7 @@ rewrite_tyvar2 tv fr@(_, eq_rel) (NomEq, NomEq) -> rewriting_dco1 (NomEq, ReprEq) -> mkSubDCo lhs_ty rewriting_dco1 rhs_ty - ; return $ RTRFollowedInert $ mkReduction lhs_ty rewriting_dco rhs_ty } + ; return $ RTRFollowedInert $ mkReduction rewriting_dco rhs_ty } _other -> return RTRNotFollowed } where ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -295,11 +295,6 @@ data RewriteEnv -- See Note [Rewriter EqRels] in GHC.Tc.Solver.Rewrite , re_rewriters :: !(TcRef RewriterSet) -- ^ See Note [Wanteds rewrite Wanteds] - - , re_followed :: !(TcRef TyVarSet) - -- ^ Used to keep track of which metavariables we have followed. - -- - -- See Note [The Hydration invariant in the rewriter] in GHC.Tc.Solver.Rewrite. } -- RewriteEnv is mostly used in @GHC.Tc.Solver.Rewrite@, but it is defined -- here so that it can also be passed to rewriting plugins. ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -1061,7 +1061,7 @@ dataConSrcToImplBang bang_opts fam_envs arg_ty else case mb_redn of Nothing -> HsUnpack Nothing Just redn -> HsUnpack $ Just $ - mkHydrateReductionDCoercion Representational redn + mkHydrateReductionDCoercion Representational (scaledThing arg_ty) redn | otherwise -- Record the strict-but-no-unpack decision = HsStrict False ===================================== testsuite/tests/dcoercion/DCo_Phantom.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, TypeOperators, TypeFamilies, +{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies, UndecidableInstances, ConstraintKinds #-} module DCo_Phantom where ===================================== testsuite/tests/dcoercion/DCo_Phantom.stderr ===================================== @@ -1,5 +1,5 @@ -DCo_Phantom.hs:35:11: warning: [-Wtyped-holes (in -Wdefault)] +DCo_Phantom.hs:35:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: _a :: [Integer] -> Sorted (O ('NLogN 2 0)) (O N) 'True Integer Or perhaps ‘_a’ is mis-spelled, or not in scope ===================================== testsuite/tests/dcoercion/DCo_Specialise.hs ===================================== @@ -4,6 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module DCo_Specialise ( rnStmts1 ) where ===================================== testsuite/tests/dcoercion/DCo_T15703_aux.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -8,7 +9,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e07c825ebf2028273066e8201de4ffec97ab806 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e07c825ebf2028273066e8201de4ffec97ab806 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 23:27:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 19:27:42 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts: Ensure non-moving gc is not running when pausing Message-ID: <645ecb6e105e_171ad9bce1c16868f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - 2 changed files: - rts/RtsAPI.c - rts/sm/Storage.c Changes: ===================================== rts/RtsAPI.c ===================================== @@ -19,6 +19,7 @@ #include "StablePtr.h" #include "Threads.h" #include "Weak.h" +#include "sm/NonMoving.h" /* ---------------------------------------------------------------------------- Building Haskell objects from C datatypes. @@ -709,6 +710,16 @@ Capability *pauseTokenCapability(PauseToken *pauseToken) { // See Note [Locking and Pausing the RTS] PauseToken *rts_pause (void) { + + // Wait for any nonmoving collection to finish before pausing the RTS. + // The nonmoving collector needs to synchronise with the mutator, + // so pausing the mutator while a collection is ongoing might lead to deadlock or + // capabilities being prematurely re-awoken. + if (RtsFlags.GcFlags.useNonmoving) { + ACQUIRE_LOCK(&nonmoving_collection_mutex); + } + + // It is an error if this thread already paused the RTS. If another // thread has paused the RTS, then rts_pause will block until rts_resume is // called (and compete with other threads calling rts_pause). The blocking @@ -771,6 +782,10 @@ void rts_resume (PauseToken *pauseToken) releaseAllCapabilities(getNumCapabilities(), NULL, task); exitMyTask(); stgFree(pauseToken); + + if (RtsFlags.GcFlags.useNonmoving) { + RELEASE_LOCK(&nonmoving_collection_mutex); + } } // See RtsAPI.h ===================================== rts/sm/Storage.c ===================================== @@ -42,7 +42,7 @@ #include "GC.h" #include "Evac.h" #include "NonMovingAllocate.h" -#include "sm/NonMovingMark.h" +#include "NonMovingMark.h" #if defined(ios_HOST_OS) || defined(darwin_HOST_OS) #include "Hash.h" #endif @@ -365,11 +365,20 @@ listGenBlocks (ListBlocksCb cb, void *user, generation* gen) cb(user, gen->compact_blocks_in_import); } +static void +listSegmentBlocks (ListBlocksCb cb, void *user, struct NonmovingSegment *seg) +{ + while (seg) { + cb(user, Bdescr((StgPtr) seg)); + seg = seg->link; + } +} + // Traverse all the different places that the rts stores blocks // and call a callback on each of them. void listAllBlocks (ListBlocksCb cb, void *user) { - uint32_t g, i; + uint32_t g, i, s; for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (i = 0; i < getNumCapabilities(); i++) { cb(user, getCapability(i)->mut_lists[g]); @@ -389,6 +398,24 @@ void listAllBlocks (ListBlocksCb cb, void *user) } cb(user, getCapability(i)->pinned_object_blocks); cb(user, getCapability(i)->pinned_object_empty); + + // list capabilities' current segments + if(RtsFlags.GcFlags.useNonmoving) { + for (s = 0; s < NONMOVING_ALLOCA_CNT; s++) { + listSegmentBlocks(cb, user, getCapability(i)->current_segments[s]); + } + } + } + + // list blocks on the nonmoving heap + if(RtsFlags.GcFlags.useNonmoving) { + for(s = 0; s < NONMOVING_ALLOCA_CNT; s++) { + listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].filled); + listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].saved_filled); + listSegmentBlocks(cb, user, nonmovingHeap.allocators[s].active); + } + cb(user, nonmoving_large_objects); + cb(user, nonmoving_compact_objects); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb60ec18eff7943fb9f22b2d2ad29709b56ce02d...5ad776abbb7c72d65d2ae27de5b2ec48b6e72cde -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb60ec18eff7943fb9f22b2d2ad29709b56ce02d...5ad776abbb7c72d65d2ae27de5b2ec48b6e72cde You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 23:28:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 19:28:16 -0400 Subject: [Git][ghc/ghc][master] Fix coercion optimisation for SelCo (#23362) Message-ID: <645ecb90c0702_171ad9bce1c172168@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 3 changed files: - compiler/GHC/Core/Coercion.hs - + testsuite/tests/simplCore/should_compile/T23362.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1355,7 +1355,7 @@ mkProofIrrelCo r kco g1 g2 = mkUnivCo (ProofIrrelProv kco) r -- | Converts a coercion to be nominal, if possible. -- See Note [Role twiddling functions] setNominalRole_maybe :: Role -- of input coercion - -> Coercion -> Maybe Coercion + -> Coercion -> Maybe CoercionN setNominalRole_maybe r co | r == Nominal = Just co | otherwise = setNominalRole_maybe_helper co @@ -1380,10 +1380,19 @@ setNominalRole_maybe r co = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2 setNominalRole_maybe_helper (ForAllCo tv kind_co co) = ForAllCo tv kind_co <$> setNominalRole_maybe_helper co - setNominalRole_maybe_helper (SelCo n co) + setNominalRole_maybe_helper (SelCo cs co) = -- NB, this case recurses via setNominalRole_maybe, not -- setNominalRole_maybe_helper! - = SelCo n <$> setNominalRole_maybe (coercionRole co) co + case cs of + SelTyCon n _r -> + -- Remember to update the role in SelTyCon to nominal; + -- not doing this caused #23362. + -- See the typing rule in Note [SelCo] in GHC.Core.TyCo.Rep. + SelCo (SelTyCon n Nominal) <$> setNominalRole_maybe (coercionRole co) co + SelFun fs -> + SelCo (SelFun fs) <$> setNominalRole_maybe (coercionRole co) co + SelForAll -> + pprPanic "setNominalRole_maybe: the coercion should already be nominal" (ppr co) setNominalRole_maybe_helper (InstCo co arg) = InstCo <$> setNominalRole_maybe_helper co <*> pure arg setNominalRole_maybe_helper (UnivCo prov _ co1 co2) ===================================== testsuite/tests/simplCore/should_compile/T23362.hs ===================================== @@ -0,0 +1,21 @@ +module T23362 where + +import Unsafe.Coerce +import Data.Kind + +type Phantom :: Type -> Type +data Phantom a = MkPhantom + +newtype Id a = MkId a +newtype First a = MkFirst (Id a) +data Second a = MkSecond (First a) +data Third a = MkThird !(Second a) + +a :: Second (Phantom Int) +a = MkSecond (MkFirst (MkId MkPhantom)) + +uc :: Second (Phantom Int) -> Second (Phantom Bool) +uc = unsafeCoerce + +b :: Third (Phantom Bool) +b = MkThird (uc a) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -478,3 +478,4 @@ test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -d test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) +test('T23362', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d683b2e5b91a39a2bf16796f5800f605a0281004 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d683b2e5b91a39a2bf16796f5800f605a0281004 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 23:29:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 19:29:02 -0400 Subject: [Git][ghc/ghc][master] hadrian: Fix linker script flag for MergeObjects builder Message-ID: <645ecbbecbd84_171ad9bce94175990@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 1 changed file: - hadrian/src/Settings/Builders/SplitSections.hs Changes: ===================================== hadrian/src/Settings/Builders/SplitSections.hs ===================================== @@ -30,7 +30,7 @@ splitSectionsArgs = do ( mconcat [ builder (Ghc CompileHs) ? arg "-fsplit-sections" , builder MergeObjects ? ifM (expr isWinTarget) - (pure ["-t", "driver/utils/merge_sections_pe.ld"]) - (pure ["-t", "driver/utils/merge_sections.ld"]) + (pure ["-T", "driver/utils/merge_sections_pe.ld"]) + (pure ["-T", "driver/utils/merge_sections.ld"]) ] ) else mempty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59aa4676a49b4f9d09c1cd3cc3b47c3c54b6ed80 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59aa4676a49b4f9d09c1cd3cc3b47c3c54b6ed80 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 12 23:59:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 19:59:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: rts: Ensure non-moving gc is not running when pausing Message-ID: <645ed2f1c33b4_171ad96aaa55418399a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 6a6cc128 by Adam Gundry at 2023-05-12T19:59:37-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - f40b5ea6 by Adam Gundry at 2023-05-12T19:59:37-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 763190f9 by Simon Peyton Jones at 2023-05-12T19:59:38-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 7b0f327b by Bartłomiej Cieślar at 2023-05-12T19:59:41-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - 28 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fea09651a87cb6048271f731b0aaf12ecde641a5...7b0f327b461340a862da7ed1d732aa4ed748c6bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fea09651a87cb6048271f731b0aaf12ecde641a5...7b0f327b461340a862da7ed1d732aa4ed748c6bf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 03:50:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 23:50:08 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Less coercion optimization for non-newtype axioms Message-ID: <645f08f0e24e0_171ad99f7230419948b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 2 changed files: - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -4,7 +4,6 @@ module GHC.Core.Coercion.Opt ( optCoercion - , checkAxInstCo , OptCoercionOpts (..) ) where @@ -804,37 +803,38 @@ opt_trans_rule is co1 co2 -- Push transitivity inside axioms opt_trans_rule is co1 co2 - -- See Note [Why call checkAxInstCo during optimisation] + -- See Note [Push transitivity inside axioms] and + -- Note [Push transitivity inside newtype axioms only] -- TrPushSymAxR | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos2 <- matchAxiom sym con ind co2 , let newAxInst = AxiomInstCo con ind (opt_transList is (map mkSymCo cos2) cos1) - , Nothing <- checkAxInstCo newAxInst = fireTransRule "TrPushSymAxR" co1 co2 $ SymCo newAxInst -- TrPushAxR | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos2 <- matchAxiom sym con ind co2 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) - , Nothing <- checkAxInstCo newAxInst = fireTransRule "TrPushAxR" co1 co2 newAxInst -- TrPushSymAxL | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 , let newAxInst = AxiomInstCo con ind (opt_transList is cos2 (map mkSymCo cos1)) - , Nothing <- checkAxInstCo newAxInst = fireTransRule "TrPushSymAxL" co1 co2 $ SymCo newAxInst -- TrPushAxL | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) - , Nothing <- checkAxInstCo newAxInst = fireTransRule "TrPushAxL" co1 co2 newAxInst -- TrPushAxSym/TrPushSymAx @@ -915,30 +915,87 @@ fireTransRule _rule _co1 _co2 res = Just res {- -Note [Conflict checking with AxiomInstCo] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the following type family and axiom: +Note [Push transitivity inside axioms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +opt_trans_rule tries to push transitivity inside axioms to deal with cases like +the following: + + newtype N a = MkN a + + axN :: N a ~R# a + + covar :: a ~R# b + co1 = axN :: N a ~R# a + co2 = axN :: N b ~R# b + + co :: a ~R# b + co = sym co1 ; N covar ; co2 + +When we are optimising co, we want to notice that the two axiom instantiations +cancel out. This is implemented by rules such as TrPushSymAxR, which transforms + sym (axN ) ; N covar +into + sym (axN covar) +so that TrPushSymAx can subsequently transform + sym (axN covar) ; axN +into + covar +which is much more compact. In some perf test cases this kind of pattern can be +generated repeatedly during simplification, so it is very important we squash it +to stop coercions growing exponentially. For more details see the paper: + + Evidence normalisation in System FC + Dimitrios Vytiniotis and Simon Peyton Jones + RTA'13, 2013 + https://www.microsoft.com/en-us/research/publication/evidence-normalization-system-fc-2/ + + +Note [Push transitivity inside newtype axioms only] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The optimization described in Note [Push transitivity inside axioms] is possible +for both newtype and type family axioms. However, for type family axioms it is +relatively common to have transitive sequences of axioms instantiations, for +example: + + data Nat = Zero | Suc Nat + + type family Index (n :: Nat) (xs :: [Type]) :: Type where + Index Zero (x : xs) = x + Index (Suc n) (x : xs) = Index n xs + + axIndex :: { forall x::Type. forall xs::[Type]. Index Zero (x : xs) ~ x + ; forall n::Nat. forall x::Type. forall xs::[Type]. Index (Suc n) (x : xs) ~ Index n xs } + + co :: Index (Suc (Suc Zero)) [a, b, c] ~ c + co = axIndex[1] <[b, c]> + ; axIndex[1] <[c]> + ; axIndex[0] <[]> + +Not only are there no cancellation opportunities here, but calling matchAxiom +repeatedly down the transitive chain is very expensive. Hence we do not attempt +to push transitivity inside type family axioms. See #8095, !9210 and related tickets. + +This is implemented by opt_trans_rule checking that the axiom is for a newtype +constructor (i.e. not a type family). Adding these guards substantially +improved performance (reduced bytes allocated by more than 10%) for the tests +CoOpt_Singletons, LargeRecord, T12227, T12545, T13386, T15703, T5030, T8095. + +A side benefit is that we do not risk accidentally creating an ill-typed +coercion; see Note [Why call checkAxInstCo during optimisation]. + +There may exist programs that previously relied on pushing transitivity inside +type family axioms to avoid creating huge coercions, which will regress in +compile time performance as a result of this change. We do not currently know +of any examples, but if any come to light we may need to reconsider this +behaviour. -type family Equal (a :: k) (b :: k) :: Bool -type instance where - Equal a a = True - Equal a b = False --- -Equal :: forall k::*. k -> k -> Bool -axEqual :: { forall k::*. forall a::k. Equal k a a ~ True - ; forall k::*. forall a::k. forall b::k. Equal k a b ~ False } - -We wish to disallow (axEqual[1] <*> ) :: (Equal * Int Int ~ -False) and that all is OK. But, all is not OK: we want to use the first branch -of the axiom in this case, not the second. The problem is that the parameters -of the first branch can unify with the supplied coercions, thus meaning that -the first branch should be taken. See also Note [Apartness] in -"GHC.Core.FamInstEnv". Note [Why call checkAxInstCo during optimisation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +NB: The following is no longer relevant, because we no longer push transitivity +into type family axioms (Note [Push transitivity inside newtype axioms only]). +It is retained for reference in case we change this behaviour in the future. + It is possible that otherwise-good-looking optimisations meet with disaster in the presence of axioms with multiple equations. Consider @@ -1029,39 +1086,6 @@ The problem described here was first found in dependent/should_compile/dynamic-p -} --- | Check to make sure that an AxInstCo is internally consistent. --- Returns the conflicting branch, if it exists --- See Note [Conflict checking with AxiomInstCo] -checkAxInstCo :: Coercion -> Maybe CoAxBranch --- defined here to avoid dependencies in GHC.Core.Coercion --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] in GHC.Core.Lint -checkAxInstCo (AxiomInstCo ax ind cos) - = let branch = coAxiomNthBranch ax ind - tvs = coAxBranchTyVars branch - cvs = coAxBranchCoVars branch - incomps = coAxBranchIncomps branch - (tys, cotys) = splitAtList tvs (map coercionLKind cos) - co_args = map stripCoercionTy cotys - subst = zipTvSubst tvs tys `composeTCvSubst` - zipCvSubst cvs co_args - target = Type.substTys subst (coAxBranchLHS branch) - in_scope = mkInScopeSet $ - unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps) - flattened_target = flattenTys in_scope target in - check_no_conflict flattened_target incomps - where - check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch - check_no_conflict _ [] = Nothing - check_no_conflict flat (b at CoAxBranch { cab_lhs = lhs_incomp } : rest) - -- See Note [Apartness] in GHC.Core.FamInstEnv - | SurelyApart <- tcUnifyTysFG alwaysBindFun flat lhs_incomp - = check_no_conflict flat rest - | otherwise - = Just b -checkAxInstCo _ = Nothing - - ----------- wrapSym :: SymFlag -> Coercion -> Coercion wrapSym sym co | sym = mkSymCo co ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -56,7 +56,6 @@ import GHC.Core.TyCon as TyCon import GHC.Core.Coercion.Axiom import GHC.Core.FamInstEnv( compatibleBranches ) import GHC.Core.Unify -import GHC.Core.Coercion.Opt ( checkAxInstCo ) import GHC.Core.Opt.Arity ( typeArity, exprIsDeadEnd ) import GHC.Core.Opt.Monad @@ -2531,6 +2530,70 @@ lintCoercion (HoleCo h) = do { addErrL $ text "Unfilled coercion hole:" <+> ppr h ; lintCoercion (CoVarCo (coHoleCoVar h)) } + +{- +Note [Conflict checking with AxiomInstCo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the following type family and axiom: + +type family Equal (a :: k) (b :: k) :: Bool +type instance where + Equal a a = True + Equal a b = False +-- +Equal :: forall k::*. k -> k -> Bool +axEqual :: { forall k::*. forall a::k. Equal k a a ~ True + ; forall k::*. forall a::k. forall b::k. Equal k a b ~ False } + +The coercion (axEqual[1] <*> ) :: (Equal * Int Int ~ False) + +and that all is OK. But, all is not OK: we want to use the first branch of the +axiom in this case, not the second. The problem is that the parameters of the +first branch can unify with the supplied coercions, thus meaning that the first +branch should be taken. See also Note [Apartness] in "GHC.Core.FamInstEnv". + +For more details, see the section "Branched axiom conflict checking" in +docs/core-spec, which defines the corresponding no_conflict function used by the +Co_AxiomInstCo rule in the section "Coercion typing". +-} + +-- | Check to make sure that an AxInstCo is internally consistent. +-- Returns the conflicting branch, if it exists +-- See Note [Conflict checking with AxiomInstCo] +checkAxInstCo :: Coercion -> Maybe CoAxBranch +-- defined here to avoid dependencies in GHC.Core.Coercion +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] in GHC.Core.Lint +checkAxInstCo (AxiomInstCo ax ind cos) + = let branch = coAxiomNthBranch ax ind + tvs = coAxBranchTyVars branch + cvs = coAxBranchCoVars branch + incomps = coAxBranchIncomps branch + (tys, cotys) = splitAtList tvs (map coercionLKind cos) + co_args = map stripCoercionTy cotys + subst = zipTvSubst tvs tys `composeTCvSubst` + zipCvSubst cvs co_args + target = Type.substTys subst (coAxBranchLHS branch) + in_scope = mkInScopeSet $ + unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps) + flattened_target = flattenTys in_scope target in + check_no_conflict flattened_target incomps + where + check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch + check_no_conflict _ [] = Nothing + check_no_conflict flat (b at CoAxBranch { cab_lhs = lhs_incomp } : rest) + -- See Note [Apartness] in GHC.Core.FamInstEnv + | SurelyApart <- tcUnifyTysFG alwaysBindFun flat lhs_incomp + = check_no_conflict flat rest + | otherwise + = Just b +checkAxInstCo _ = Nothing + + {- ************************************************************************ * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/59aa4676a49b4f9d09c1cd3cc3b47c3c54b6ed80...dc0c957439c2fae14547de24ff665fc4f5db56a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/59aa4676a49b4f9d09c1cd3cc3b47c3c54b6ed80...dc0c957439c2fae14547de24ff665fc4f5db56a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 03:50:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 23:50:42 -0400 Subject: [Git][ghc/ghc][master] Use the eager unifier in the constraint solver Message-ID: <645f0912d514f_171ad99f5e02020293b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 28 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b9b7dbc913b66795c283683c7fe1fb48672666d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b9b7dbc913b66795c283683c7fe1fb48672666d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 03:51:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 12 May 2023 23:51:24 -0400 Subject: [Git][ghc/ghc][master] Cleanup of dynflags override in export renaming Message-ID: <645f093c61e21_171ad96aaa554206422@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - 4 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -54,6 +54,7 @@ module GHC.Rename.Env ( lookupQualifiedDoName, lookupNameWithQualifier, -- Constructing usage information + DeprecationWarnings(..), addUsedGRE, addUsedGREs, addUsedDataCons, @@ -406,7 +407,8 @@ lookupInstDeclBndr cls what rdr -- to use a qualified name for the method -- (Although it'd make perfect sense.) ; mb_name <- lookupSubBndrOcc - False -- False => we don't give deprecated + DisableDeprecationWarnings + -- we don't give deprecated -- warnings when a deprecated class -- method is defined. We only warn -- when it's used @@ -551,7 +553,7 @@ lookupRecFieldOcc mb_con rdr_name , text "rdr_name:" <+> ppr rdr_name , text "flds:" <+> ppr flds , text "mb_gre:" <+> ppr mb_gre ] - ; mapM_ (addUsedGRE True) mb_gre + ; mapM_ (addUsedGRE EnableDeprecationWarnings) mb_gre ; return $ flSelector . fieldGRELabel <$> mb_gre } ; case mb_nm of { Nothing -> do { addErr (badFieldConErr con lbl) @@ -681,7 +683,7 @@ lookupGlobalOccRn will find it. -- | Used in export lists to lookup the children. -lookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName +lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings -> Name -> RdrName -> RnM ChildLookupResult lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name | isUnboundName parent @@ -842,7 +844,7 @@ instance Outputable ChildLookupResult where = text "IncorrectParent" <+> hsep [ppr p, ppr $ greName g, ppr ns] -lookupSubBndrOcc :: Bool +lookupSubBndrOcc :: DeprecationWarnings -> Name -- Parent -> SDoc -> RdrName @@ -1407,7 +1409,7 @@ lookupFieldGREs env (L loc rdr) lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt) lookupGlobalOccRn_overloaded rdr_name = lookupExactOrOrig_maybe rdr_name id $ - do { res <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name + do { res <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name EnableDeprecationWarnings ; case res of GreNotFound -> lookupOneQualifiedNameGHCi WantNormal rdr_name OneNameMatch gre -> return $ Just gre @@ -1627,7 +1629,7 @@ lookupGreRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt) -- Uses addUsedRdrName to record use and deprecations lookupGreRn_maybe which_gres rdr_name = do - res <- lookupGreRn_helper which_gres rdr_name + res <- lookupGreRn_helper which_gres rdr_name EnableDeprecationWarnings case res of OneNameMatch gre -> return $ Just gre MultipleNames gres -> do @@ -1663,12 +1665,12 @@ is enabled then we defer the selection until the typechecker. -- Internal Function -lookupGreRn_helper :: WhichGREs GREInfo -> RdrName -> RnM GreLookupResult -lookupGreRn_helper which_gres rdr_name +lookupGreRn_helper :: WhichGREs GREInfo -> RdrName -> DeprecationWarnings -> RnM GreLookupResult +lookupGreRn_helper which_gres rdr_name warn_if_deprec = do { env <- getGlobalRdrEnv ; case lookupGRE_RdrName which_gres env rdr_name of [] -> return GreNotFound - [gre] -> do { addUsedGRE True gre + [gre] -> do { addUsedGRE warn_if_deprec gre ; return (OneNameMatch gre) } -- Don't record usage for ambiguous names -- until we know which is meant @@ -1680,7 +1682,7 @@ lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt) -- Uses addUsedRdrName to record use and deprecations lookupGreAvailRn rdr_name = do - mb_gre <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name + mb_gre <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name DisableDeprecationWarnings case mb_gre of GreNotFound -> do @@ -1726,11 +1728,18 @@ addUsedDataCons rdr_env tycon | dc <- tyConDataCons tycon , Just gre <- [lookupGRE_Name rdr_env (dataConName dc)] ] -addUsedGRE :: Bool -> GlobalRdrElt-> RnM () +-- | Whether to report deprecation warnings when registering a used GRE +data DeprecationWarnings + = DisableDeprecationWarnings + | EnableDeprecationWarnings + +addUsedGRE :: DeprecationWarnings -> GlobalRdrElt-> RnM () -- Called for both local and imported things -- Add usage *and* warn if deprecated addUsedGRE warn_if_deprec gre - = do { when warn_if_deprec (warnIfDeprecated gre) + = do { case warn_if_deprec of + EnableDeprecationWarnings -> warnIfDeprecated gre + DisableDeprecationWarnings -> return () ; unless (isLocalGRE gre) $ do { env <- getGblEnv ; traceRn "addUsedGRE" (ppr gre) @@ -2065,7 +2074,7 @@ lookupBindGroupOcc ctxt what rdr_name else lookup_top (`elemNameSet` ns) where lookup_cls_op cls - = lookupSubBndrOcc True cls doc rdr_name + = lookupSubBndrOcc EnableDeprecationWarnings cls doc rdr_name where doc = text "method of class" <+> quotes (ppr cls) ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -167,10 +167,6 @@ rnExports :: Bool -- False => no 'module M(..) where' header at all rnExports explicit_mod exports = checkNoErrs $ -- Fail if anything in rnExports finds -- an error fails, to avoid error cascade - updTopFlags wopt_unset_all_custom $ - -- Do not report deprecations arising from the export - -- list, to avoid bleating about re-exporting a deprecated - -- thing (especially via 'module Foo' export item) do { hsc_env <- getTopEnv ; tcg_env <- getGblEnv ; let dflags = hsc_dflags hsc_env @@ -336,73 +332,70 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod ------------- lookup_ie :: ExportOccMap -> IE GhcPs -> RnM (Maybe (ExportOccMap, IE GhcRn, AvailInfo)) - lookup_ie occs ie@(IEVar ann (L l rdr)) - = do mb_gre <- lookupGreAvailRn $ ieWrappedName rdr + lookup_ie occs ie@(IEVar ann l) + = do mb_gre <- lookupGreAvailRn $ lieWrappedName l for mb_gre $ \ gre -> do let avail = availFromGRE gre name = greName gre occs' <- check_occs occs ie [gre] - return (occs', IEVar ann (L l (replaceWrappedName rdr name)), avail) + return (occs', IEVar ann (replaceLWrappedName l name), avail) - lookup_ie occs ie@(IEThingAbs ann (L l rdr)) - = do mb_gre <- lookupGreAvailRn $ ieWrappedName rdr + lookup_ie occs ie@(IEThingAbs ann l) + = do mb_gre <- lookupGreAvailRn $ lieWrappedName l for mb_gre $ \ gre -> do let avail = availFromGRE gre name = greName gre occs' <- check_occs occs ie [gre] return ( occs' - , IEThingAbs ann (L l (replaceWrappedName rdr name)) + , IEThingAbs ann (replaceLWrappedName l name) , avail) - lookup_ie occs ie@(IEThingAll ann n') - = do - (par, kids) <- lookup_ie_all ie n' - let name = greName par - avails = map greName kids - occs' <- check_occs occs ie (par:kids) - return $ Just - ( occs' - , IEThingAll ann (replaceLWrappedName n' name) - , AvailTC name (name:avails)) + lookup_ie occs ie@(IEThingAll ann l) + = do mb_gre <- lookupGreAvailRn $ lieWrappedName l + for mb_gre $ \ par -> do + all_kids <- lookup_ie_kids_all ie l par + let name = greName par + kids_avails = map greName all_kids + occs' <- check_occs occs ie (par:all_kids) + return ( occs' + , IEThingAll ann (replaceLWrappedName l name) + , AvailTC name (name:kids_avails)) lookup_ie occs ie@(IEThingWith ann l wc sub_rdrs) - = do - (par_gre, subs, with_gres) - <- addExportErrCtxt ie $ lookup_ie_with l sub_rdrs - - wc_gres <- - case wc of - NoIEWildcard -> return [] - IEWildcard _ -> snd <$> lookup_ie_all ie l - - let par = greName par_gre - all_names = par : map greName (with_gres ++ wc_gres) - gres = par_gre : with_gres ++ wc_gres - - occs' <- check_occs occs ie gres - return $ Just $ - ( occs' - , IEThingWith ann (replaceLWrappedName l par) wc subs - , AvailTC par all_names) + = do mb_gre <- addExportErrCtxt ie + $ lookupGreAvailRn $ lieWrappedName l + for mb_gre $ \ par -> do + (subs, with_kids) + <- addExportErrCtxt ie + $ lookup_ie_kids_with par sub_rdrs + + wc_kids <- + case wc of + NoIEWildcard -> return [] + IEWildcard _ -> lookup_ie_kids_all ie l par + + let name = greName par + all_kids = with_kids ++ wc_kids + kids_avails = map greName all_kids + occs' <- check_occs occs ie (par:all_kids) + return ( occs' + , IEThingWith ann (replaceLWrappedName l name) wc subs + , AvailTC name (name:kids_avails)) lookup_ie _ _ = panic "lookup_ie" -- Other cases covered earlier - lookup_ie_with :: LIEWrappedName GhcPs -> [LIEWrappedName GhcPs] - -> RnM (GlobalRdrElt, [LIEWrappedName GhcRn], [GlobalRdrElt]) - lookup_ie_with (L _ rdr) sub_rdrs = - do { gre <- lookupGlobalOccRn $ ieWrappedName rdr - ; let name = greName gre + lookup_ie_kids_with :: GlobalRdrElt -> [LIEWrappedName GhcPs] + -> RnM ([LIEWrappedName GhcRn], [GlobalRdrElt]) + lookup_ie_kids_with gre sub_rdrs = + do { let name = greName gre ; kids <- lookupChildrenExport name sub_rdrs - ; if isUnboundName name - then return (gre, [], [gre]) - else return (gre, map fst kids, map snd kids) } - - lookup_ie_all :: IE GhcPs -> LIEWrappedName GhcPs - -> RnM (GlobalRdrElt, [GlobalRdrElt]) - lookup_ie_all ie (L _ rdr) = - do { gre <- lookupGlobalOccRn $ ieWrappedName rdr - ; let name = greName gre + ; return (map fst kids, map snd kids) } + + lookup_ie_kids_all :: IE GhcPs -> LIEWrappedName GhcPs -> GlobalRdrElt + -> RnM [GlobalRdrElt] + lookup_ie_kids_all ie (L _ rdr) gre = + do { let name = greName gre gres = findChildren kids_env name ; addUsedKids (ieWrappedName rdr) gres ; when (null gres) $ @@ -411,7 +404,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod else -- This occurs when you export T(..), but -- only import T abstractly, or T is a synonym. addErr (TcRnExportHiddenComponents ie) - ; return (gre, gres) } + ; return gres } ------------- lookup_doc_ie :: IE GhcPs -> RnM (Maybe (IE GhcRn)) @@ -510,7 +503,7 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items doOne n = do let bareName = (ieWrappedName . unLoc) n - lkup v = lookupSubBndrOcc_helper False True + lkup v = lookupSubBndrOcc_helper False DisableDeprecationWarnings -- Do not report export list deprecations spec_parent (setRdrNameSpace bareName v) name <- combineChildLookupResult $ map lkup $ ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Tc.Gen.Bind ( tcLocalBinds ) import GHC.Tc.Instance.Family ( tcGetFamInstEnvs ) import GHC.Core.FamInstEnv ( FamInstEnvs ) import GHC.Rename.Expr ( mkExpandedExpr ) -import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls ) +import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls, DeprecationWarnings(EnableDeprecationWarnings) ) import GHC.Tc.Utils.Env import GHC.Tc.Gen.Arrow import GHC.Tc.Gen.Match @@ -1417,7 +1417,7 @@ disambiguateRecordBinds record_expr record_rho possible_parents rbnds res_ty -- Mark the record fields as used, now that we have disambiguated. -- There is no risk of duplicate deprecation warnings, as we have -- not marked the GREs as used previously. - ; setSrcSpanA loc $ mapM_ (addUsedGRE True) mb_gre + ; setSrcSpanA loc $ mapM_ (addUsedGRE EnableDeprecationWarnings) mb_gre ; sel <- tcLookupId $ flSelector $ fieldGRELabel fl ; let L loc af = hfbLHS upd lbl = ambiguousFieldOccRdrName af ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin (InstanceWhat (..), SafeOverlapping) import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst ) -import GHC.Rename.Env( addUsedGRE ) +import GHC.Rename.Env( addUsedGRE, DeprecationWarnings(EnableDeprecationWarnings) ) import GHC.Builtin.Types import GHC.Builtin.Types.Prim @@ -949,7 +949,7 @@ matchHasField dflags short_cut clas tys -- it must not be higher-rank. ; if not (isNaughtyRecordSelector sel_id) && isTauTy sel_ty then do { -- See Note [Unused name reporting and HasField] - addUsedGRE True gre + addUsedGRE EnableDeprecationWarnings gre ; keepAlive (greName gre) ; return OneInst { cir_new_theta = theta , cir_mk_ev = mk_ev View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cad28e73bf9a1a535fa9ed22800156c1ba2e6c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cad28e73bf9a1a535fa9ed22800156c1ba2e6c8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 09:16:01 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 13 May 2023 05:16:01 -0400 Subject: [Git][ghc/ghc][wip/T23307] 9 commits: rts: Ensure non-moving gc is not running when pausing Message-ID: <645f555174fea_171ad912a7e8a8238489@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23307 at Glasgow Haskell Compiler / GHC Commits: aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - 48b7d0f3 by Simon Peyton Jones at 2023-05-13T10:15:55+01:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - 28 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87c38b0a8c09c11b5f7391d9c5222e5966892e15...48b7d0f3d914603176dc4c011226d01a18466328 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87c38b0a8c09c11b5f7391d9c5222e5966892e15...48b7d0f3d914603176dc4c011226d01a18466328 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 10:06:48 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Sat, 13 May 2023 06:06:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-driver-dynflags Message-ID: <645f6138892c3_171ad9f49785c25534f@gitlab.mail> Oleg Grenrus pushed new branch wip/ghc-driver-dynflags at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-driver-dynflags You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 10:25:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 13 May 2023 06:25:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Less coercion optimization for non-newtype axioms Message-ID: <645f658b83e39_171ad9f49785c26053f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - f48462e9 by Alexis King at 2023-05-13T06:25:06-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 639c12e0 by Bodigrim at 2023-05-13T06:25:10-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Plugin.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Interact.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b0f327b461340a862da7ed1d732aa4ed748c6bf...639c12e0e9c565d99d210c4653a27ced2f92760a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b0f327b461340a862da7ed1d732aa4ed748c6bf...639c12e0e9c565d99d210c4653a27ced2f92760a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 12:45:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 13 May 2023 08:45:48 -0400 Subject: [Git][ghc/ghc][master] Use a uniform return convention in bytecode for unary results Message-ID: <645f867c69720_171ad917d593ac284137@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 15 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - rts/Disassembler.c - rts/Interpreter.c - rts/Printer.c - rts/StgMiscClosures.cmm - rts/include/rts/Bytecodes.h - rts/include/stg/MiscClosures.h - + testsuite/tests/ghci/should_run/T22958a.hs - + testsuite/tests/ghci/should_run/T22958a.stdout - + testsuite/tests/ghci/should_run/T22958b.hs - + testsuite/tests/ghci/should_run/T22958b.stdout - testsuite/tests/ghci/should_run/all.T Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -395,10 +395,7 @@ assembleI platform i = case i of PUSH_BCO proto -> do let ul_bco = assembleBCO platform proto p <- ioptr (liftM BCOPtrBCO ul_bco) emit bci_PUSH_G [Op p] - PUSH_ALTS proto -> do let ul_bco = assembleBCO platform proto - p <- ioptr (liftM BCOPtrBCO ul_bco) - emit bci_PUSH_ALTS [Op p] - PUSH_ALTS_UNLIFTED proto pk + PUSH_ALTS proto pk -> do let ul_bco = assembleBCO platform proto p <- ioptr (liftM BCOPtrBCO ul_bco) emit (push_alts pk) [Op p] @@ -504,8 +501,7 @@ assembleI platform i = case i of SWIZZLE stkoff n -> emit bci_SWIZZLE [SmallOp stkoff, SmallOp n] JMP l -> emit bci_JMP [LabelOp l] ENTER -> emit bci_ENTER [] - RETURN -> emit bci_RETURN [] - RETURN_UNLIFTED rep -> emit (return_unlifted rep) [] + RETURN rep -> emit (return_non_tuple rep) [] RETURN_TUPLE -> emit bci_RETURN_T [] CCALL off m_addr i -> do np <- addr m_addr emit bci_CCALL [SmallOp off, Op np, SmallOp i] @@ -574,16 +570,16 @@ push_alts V16 = error "push_alts: vector" push_alts V32 = error "push_alts: vector" push_alts V64 = error "push_alts: vector" -return_unlifted :: ArgRep -> Word16 -return_unlifted V = bci_RETURN_V -return_unlifted P = bci_RETURN_P -return_unlifted N = bci_RETURN_N -return_unlifted L = bci_RETURN_L -return_unlifted F = bci_RETURN_F -return_unlifted D = bci_RETURN_D -return_unlifted V16 = error "return_unlifted: vector" -return_unlifted V32 = error "return_unlifted: vector" -return_unlifted V64 = error "return_unlifted: vector" +return_non_tuple :: ArgRep -> Word16 +return_non_tuple V = bci_RETURN_V +return_non_tuple P = bci_RETURN_P +return_non_tuple N = bci_RETURN_N +return_non_tuple L = bci_RETURN_L +return_non_tuple F = bci_RETURN_F +return_non_tuple D = bci_RETURN_D +return_non_tuple V16 = error "return_non_tuple: vector" +return_non_tuple V32 = error "return_non_tuple: vector" +return_non_tuple V64 = error "return_non_tuple: vector" {- we can only handle up to a fixed number of words on the stack, ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -88,8 +88,7 @@ data BCInstr | PUSH_BCO (ProtoBCO Name) -- Push an alt continuation - | PUSH_ALTS (ProtoBCO Name) - | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep + | PUSH_ALTS (ProtoBCO Name) ArgRep | PUSH_ALTS_TUPLE (ProtoBCO Name) -- continuation !NativeCallInfo (ProtoBCO Name) -- tuple return BCO @@ -197,9 +196,10 @@ data BCInstr -- To Infinity And Beyond | ENTER - | RETURN -- return a lifted value - | RETURN_UNLIFTED ArgRep -- return an unlifted value, here's its rep - | RETURN_TUPLE -- return an unboxed tuple (info already on stack) + | RETURN ArgRep -- return a non-tuple value, here's its rep; see + -- Note [Return convention for non-tuple values] in GHC.StgToByteCode + | RETURN_TUPLE -- return an unboxed tuple (info already on stack); see + -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode -- Breakpoints | BRK_FUN Word16 Unique (RemotePtr CostCentre) @@ -274,8 +274,7 @@ instance Outputable BCInstr where <> ppr op ppr (PUSH_BCO bco) = hang (text "PUSH_BCO") 2 (ppr bco) - ppr (PUSH_ALTS bco) = hang (text "PUSH_ALTS") 2 (ppr bco) - ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text "PUSH_ALTS_UNLIFTED" <+> ppr pk) 2 (ppr bco) + ppr (PUSH_ALTS bco pk) = hang (text "PUSH_ALTS" <+> ppr pk) 2 (ppr bco) ppr (PUSH_ALTS_TUPLE bco call_info tuple_bco) = hang (text "PUSH_ALTS_TUPLE" <+> ppr call_info) 2 @@ -352,8 +351,7 @@ instance Outputable BCInstr where ppr (SWIZZLE stkoff n) = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff <+> text "by" <+> ppr n ppr ENTER = text "ENTER" - ppr RETURN = text "RETURN" - ppr (RETURN_UNLIFTED pk) = text "RETURN_UNLIFTED " <+> ppr pk + ppr (RETURN pk) = text "RETURN " <+> ppr pk ppr (RETURN_TUPLE) = text "RETURN_TUPLE" ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> mb_uniq <+> text "" where mb_uniq = sdocOption sdocSuppressUniques $ \case @@ -389,10 +387,8 @@ bciStackUse PUSH32_W{} = 1 -- takes exactly 1 word bciStackUse PUSH_G{} = 1 bciStackUse PUSH_PRIMOP{} = 1 bciStackUse PUSH_BCO{} = 1 -bciStackUse (PUSH_ALTS bco) = 2 {- profiling only, restore CCCS -} + +bciStackUse (PUSH_ALTS bco _) = 2 {- profiling only, restore CCCS -} + 3 + protoBCOStackUse bco -bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 {- profiling only, restore CCCS -} + - 4 + protoBCOStackUse bco bciStackUse (PUSH_ALTS_TUPLE bco info _) = -- (tuple_bco, call_info word, cont_bco, stg_ctoi_t) -- tuple @@ -452,8 +448,7 @@ bciStackUse TESTEQ_P{} = 0 bciStackUse CASEFAIL{} = 0 bciStackUse JMP{} = 0 bciStackUse ENTER{} = 0 -bciStackUse RETURN{} = 0 -bciStackUse RETURN_UNLIFTED{} = 1 -- pushes stg_ret_X for some X +bciStackUse RETURN{} = 1 -- pushes stg_ret_X for some X bciStackUse RETURN_TUPLE{} = 1 -- pushes stg_ret_t header bciStackUse CCALL{} = 0 bciStackUse PRIMCALL{} = 1 -- pushes stg_primcall ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -319,7 +319,7 @@ schemeTopBind (id, rhs) -- by just re-using the single top-level definition. So -- for the worker itself, we must allocate it directly. -- ioToBc (putStrLn $ "top level BCO") - emitBc (mkProtoBCO platform (getName id) (toOL [PACK data_con 0, RETURN]) + emitBc (mkProtoBCO platform (getName id) (toOL [PACK data_con 0, RETURN P]) (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-}) | otherwise @@ -480,9 +480,9 @@ returnUnliftedReps d s szb reps = do non_void VoidRep = False non_void _ = True ret <- case filter non_void reps of - -- use RETURN_UBX for unary representations - [] -> return (unitOL $ RETURN_UNLIFTED V) - [rep] -> return (unitOL $ RETURN_UNLIFTED (toArgRep platform rep)) + -- use RETURN for nullary/unary representations + [] -> return (unitOL $ RETURN V) + [rep] -> return (unitOL $ RETURN (toArgRep platform rep)) -- otherwise use RETURN_TUPLE with a tuple descriptor nv_reps -> do let (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 (primRepCmmType platform) nv_reps @@ -526,7 +526,7 @@ schemeE :: StackDepth -> Sequel -> BCEnv -> CgStgExpr -> BcM BCInstrList schemeE d s p (StgLit lit) = returnUnliftedAtom d s p (StgLitArg lit) schemeE d s p (StgApp x []) - | not (usePlainReturn (idType x)) = returnUnliftedAtom d s p (StgVarArg x) + | isUnliftedType (idType x) = returnUnliftedAtom d s p (StgVarArg x) -- Delegate tail-calls to schemeT. schemeE d s p e@(StgApp {}) = schemeT d s p e schemeE d s p e@(StgConApp {}) = schemeT d s p e @@ -681,8 +681,8 @@ schemeT d s p (StgOpApp (StgPrimOp op) args _ty) schemeT d s p (StgOpApp (StgPrimCallOp (PrimCall label unit)) args result_ty) = generatePrimCall d s p label (Just unit) result_ty args - -- Case 2: Unboxed tuple schemeT d s p (StgConApp con _cn args _tys) + -- Case 2: Unboxed tuple | isUnboxedTupleDataCon con || isUnboxedSumDataCon con = returnUnboxedTuple d s p args @@ -691,7 +691,7 @@ schemeT d s p (StgConApp con _cn args _tys) = do alloc_con <- mkConAppCode d s p con args platform <- profilePlatform <$> getProfile return (alloc_con `appOL` - mkSlideW 1 (bytesToWords platform $ d - s) `snocOL` RETURN) + mkSlideW 1 (bytesToWords platform $ d - s) `snocOL` RETURN P) -- Case 4: Tail call of function schemeT d s p (StgApp fn args) @@ -831,14 +831,11 @@ doCase d s p scrut bndr alts -- have the same runtime rep. We have more efficient specialized -- return frames for the situations with one non-void element. + non_void_arg_reps = non_void (typeArgReps platform bndr_ty) ubx_tuple_frame = (isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty) && length non_void_arg_reps > 1 - ubx_frame = not ubx_tuple_frame && not (usePlainReturn bndr_ty) - - non_void_arg_reps = non_void (typeArgReps platform bndr_ty) - profiling | Just interp <- hsc_interp hsc_env = interpreterProfiled interp @@ -847,7 +844,8 @@ doCase d s p scrut bndr alts -- Top of stack is the return itbl, as usual. -- underneath it is the pointer to the alt_code BCO. -- When an alt is entered, it assumes the returned value is - -- on top of the itbl. + -- on top of the itbl; see Note [Return convention for non-tuple values] + -- for details. ret_frame_size_b :: StackDepth ret_frame_size_b | ubx_tuple_frame = (if profiling then 5 else 4) * wordSize platform @@ -861,7 +859,6 @@ doCase d s p scrut bndr alts -- The size of the return frame info table pointer if one exists unlifted_itbl_size_b :: StackDepth unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform - | ubx_frame = wordSize platform | otherwise = 0 (bndr_size, call_info, args_offsets) @@ -1052,17 +1049,11 @@ doCase d s p scrut bndr alts then do tuple_bco <- emitBc (tupleBCO platform call_info args_offsets) return (PUSH_ALTS_TUPLE alt_bco' call_info tuple_bco `consOL` scrut_code) - else let push_alts - | not ubx_frame - = PUSH_ALTS alt_bco' - | otherwise - = let unlifted_rep = - case non_void_arg_reps of - [] -> V - [rep] -> rep - _ -> panic "schemeE(StgCase).push_alts" - in PUSH_ALTS_UNLIFTED alt_bco' unlifted_rep - in return (push_alts `consOL` scrut_code) + else let scrut_rep = case non_void_arg_reps of + [] -> V + [rep] -> rep + _ -> panic "schemeE(StgCase).push_alts" + in return (PUSH_ALTS alt_bco' scrut_rep `consOL` scrut_code) -- ----------------------------------------------------------------------------- @@ -1130,21 +1121,38 @@ layoutNativeCall profile call_type start_off arg_ty reps = (orig_stk_params ++ map get_byte_off new_stk_params) ) -{- - We use the plain return convention (ENTER/PUSH_ALTS) for - lifted types and unlifted algebraic types. - - Other types use PUSH_ALTS_UNLIFTED/PUSH_ALTS_TUPLE which expect - additional data on the stack. - -} -usePlainReturn :: Type -> Bool -usePlainReturn t - | isUnboxedTupleType t || isUnboxedSumType t = False - | otherwise = typePrimRep t == [LiftedRep] || - (typePrimRep t == [UnliftedRep] && isAlgType t) - -{- Note [unboxed tuple bytecodes and tuple_BCO] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Return convention for non-tuple values] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The RETURN and ENTER instructions are used to return values. RETURN directly +returns the value at the top of the stack while ENTER evaluates it first (so +RETURN is only used when the result is already known to be evaluated), but the +end result is the same: control returns to the enclosing stack frame with the +result at the top of the stack. + +The PUSH_ALTS instruction pushes a two-word stack frame that receives a single +lifted value. Its payload is a BCO that is executed when control returns, with +the stack set up as if a RETURN instruction had just been executed: the returned +value is at the top of the stack, and beneath it is the two-word frame being +returned to. It is the continuation BCO’s job to pop its own frame off the +stack, so the simplest possible continuation consists of two instructions: + + SLIDE 1 2 -- pop the return frame off the stack, keeping the returned value + RETURN P -- return the returned value to our caller + +RETURN and PUSH_ALTS are not really instructions but are in fact representation- +polymorphic *families* of instructions indexed by ArgRep. ENTER, however, is a +single real instruction, since it is only used to return lifted values, which +are always pointers. + +The RETURN, ENTER, and PUSH_ALTS instructions are only used when the returned +value has nullary or unary representation. Returning/receiving an unboxed +tuple (or, indirectly, an unboxed sum, since unboxed sums have been desugared to +unboxed tuples by Unarise) containing two or more results uses the special +RETURN_TUPLE/PUSH_ALTS_TUPLE instructions, which use a different return +convention. See Note [unboxed tuple bytecodes and tuple_BCO] for details. + +Note [unboxed tuple bytecodes and tuple_BCO] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We have the bytecode instructions RETURN_TUPLE and PUSH_ALTS_TUPLE to return and receive arbitrary unboxed tuples, respectively. These instructions use the helper data tuple_BCO and call_info. @@ -1580,7 +1588,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args -- slide and return d_after_r_min_s = bytesToWords platform (d_after_r - s) wrapup = mkSlideW (trunc16W r_sizeW) (d_after_r_min_s - r_sizeW) - `snocOL` RETURN_UNLIFTED (toArgRep platform r_rep) + `snocOL` RETURN (toArgRep platform r_rep) --trace (show (arg1_offW, args_offW , (map argRepSizeW a_reps) )) $ return ( push_args `appOL` @@ -1694,7 +1702,6 @@ as a consequence. The [Name] is a list of the constructors of this The code we generate is this: push arg - push bogus-word TESTEQ_I 0 L1 PUSH_G @@ -1712,13 +1719,6 @@ The code we generate is this: L_exit: SLIDE 1 n ENTER - -The 'bogus-word' push is because TESTEQ_I expects the top of the stack -to have an info-table, and the next word to have the value to be -tested. This is very weird, but it's the way it is right now. See -Interpreter.c. We don't actually need an info-table here; we just -need to have the argument to be one-from-top on the stack, hence pushing -a 1-word null. See #8383. -} @@ -1744,14 +1744,10 @@ implement_tagToId d s p arg names slide_ws = bytesToWords platform (d - s + arg_bytes) return (push_arg - `appOL` unitOL (PUSH_UBX LitNullAddr 1) - -- Push bogus word (see Note [Implementing tagToEnum#]) `appOL` concatOL steps `appOL` toOL [ LABEL label_fail, CASEFAIL, LABEL label_exit ] - `appOL` mkSlideW 1 (slide_ws + 1) - -- "+1" to account for bogus word - -- (see Note [Implementing tagToEnum#]) + `appOL` mkSlideW 1 slide_ws `appOL` unitOL ENTER) where mkStep l_exit (my_label, next_label, n, name_for_n) ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -308,8 +308,7 @@ type DynTag = Int -- The tag on a *pointer* -- Also see Note [Tagging big families] in GHC.StgToCmm.Expr -- -- The interpreter also needs to be updated if we change the --- tagging strategy. See Note [Data constructor dynamic tags] in --- rts/Interpreter.c +-- tagging strategy; see tagConstr in rts/Interpreter.c. isSmallFamily :: Platform -> Int -> Bool isSmallFamily platform fam_size = fam_size <= mAX_PTR_TAG platform ===================================== rts/Disassembler.c ===================================== @@ -123,10 +123,6 @@ disInstr ( StgBCO *bco, int pc ) debugBelch("PUSH_G " ); printPtr( ptrs[instrs[pc]] ); debugBelch("\n" ); pc += 1; break; - case bci_PUSH_ALTS: - debugBelch("PUSH_ALTS " ); printPtr( ptrs[instrs[pc]] ); - debugBelch("\n"); - pc += 1; break; case bci_PUSH_ALTS_P: debugBelch("PUSH_ALTS_P " ); printPtr( ptrs[instrs[pc]] ); debugBelch("\n"); @@ -408,9 +404,6 @@ disInstr ( StgBCO *bco, int pc ) debugBelch("ENTER\n"); break; - case bci_RETURN: - debugBelch("RETURN\n" ); - break; case bci_RETURN_P: debugBelch("RETURN_P\n" ); break; ===================================== rts/Interpreter.c ===================================== @@ -283,6 +283,14 @@ StgClosure * copyPAP (Capability *cap, StgPAP *oldpap) #endif +// Compute the pointer tag for the constructor and tag the pointer; +// see Note [Data constructor dynamic tags] in GHC.StgToCmm.Closure. +// +// Note: we need to update this if we change the tagging strategy. +STATIC_INLINE StgClosure *tagConstr(StgClosure *con) { + return TAG_CLOSURE(stg_min(TAG_MASK, 1 + GET_TAG(con)), con); +} + static StgWord app_ptrs_itbl[] = { (W_)&stg_ap_p_info, (W_)&stg_ap_pp_info, @@ -363,11 +371,22 @@ interpretBCO (Capability* cap) // ------------------------------------------------------------------------ // Case 3: // - // We have an unlifted value to return. See comment before - // do_return_lifted, below. + // We have a pointer to return. See comment before + // do_return_pointer, below. + // + else if (SpW(0) == (W_)&stg_ret_p_info) { + tagged_obj = (StgClosure *)SpW(1); + Sp_addW(2); + goto do_return_pointer; + } + + // ------------------------------------------------------------------------ + // Case 4: + // + // We have a nonpointer to return. // else { - goto do_return_unlifted; + goto do_return_nonpointer; } // Evaluate the object on top of the stack. @@ -412,6 +431,11 @@ eval_obj: 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: @@ -533,16 +557,16 @@ eval_obj: } // ------------------------------------------------------------------------ - // We now have an evaluated object (tagged_obj). The next thing to + // We now have a pointer to return (tagged_obj). The next thing to // do is return it to the stack frame on top of the stack. -do_return: +do_return_pointer: obj = UNTAG_CLOSURE(tagged_obj); - ASSERT(closure_HNF(obj)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(obj)); IF_DEBUG(interpreter, debugBelch( "\n---------------------------------------------------------------\n"); - debugBelch("Returning: "); printObj(obj); + debugBelch("Returning closure: "); printObj(obj); debugBelch("Sp = %p\n", Sp); #if defined(PROFILING) fprintCCS(stderr, cap->r.rCCCS); @@ -567,7 +591,7 @@ do_return: info == (StgInfoTable *)&stg_restore_cccs_eval_info) { cap->r.rCCCS = (CostCentreStack*)SpW(1); Sp_addW(2); - goto do_return; + goto do_return_pointer; } if (info == (StgInfoTable *)&stg_ap_v_info) { @@ -621,7 +645,7 @@ do_return: updateThunk(cap, cap->r.rCurrentTSO, ((StgUpdateFrame *)Sp)->updatee, tagged_obj); Sp_addW(sizeofW(StgUpdateFrame)); - goto do_return; + goto do_return_pointer; case RET_BCO: // Returning to an interpreted continuation: put the object on @@ -631,7 +655,7 @@ do_return: SpW(0) = (W_)tagged_obj; obj = (StgClosure*)SpW(2); ASSERT(get_itbl(obj)->type == BCO); - goto run_BCO_return; + goto run_BCO_return_pointer; default: do_return_unrecognised: @@ -644,7 +668,7 @@ do_return: ); Sp_subW(2); SpW(1) = (W_)tagged_obj; - SpW(0) = (W_)&stg_enter_info; + SpW(0) = (W_)&stg_ret_p_info; RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding); } } @@ -672,12 +696,11 @@ do_return: // We're only interested in the case when the real return address // is a BCO; otherwise we'll return to the scheduler. -do_return_unlifted: +do_return_nonpointer: { int offset; ASSERT( SpW(0) == (W_)&stg_ret_v_info - || SpW(0) == (W_)&stg_ret_p_info || SpW(0) == (W_)&stg_ret_n_info || SpW(0) == (W_)&stg_ret_f_info || SpW(0) == (W_)&stg_ret_d_info @@ -688,7 +711,7 @@ do_return_unlifted: IF_DEBUG(interpreter, debugBelch( "\n---------------------------------------------------------------\n"); - debugBelch("Returning unlifted\n"); + debugBelch("Returning nonpointer\n"); debugBelch("Sp = %p\n", Sp); #if defined(PROFILING) fprintCCS(stderr, cap->r.rCCCS); @@ -705,12 +728,13 @@ do_return_unlifted: switch (get_itbl((StgClosure*)(Sp_plusW(offset)))->type) { case RET_BCO: - // Returning to an interpreted continuation: put the object on - // the stack, and start executing the BCO. + // Returning to an interpreted continuation: pop the return frame + // so the returned value is at the top of the stack, and start + // executing the BCO. INTERP_TICK(it_retto_BCO); obj = (StgClosure*)SpW(offset+1); ASSERT(get_itbl(obj)->type == BCO); - goto run_BCO_return_unlifted; + goto run_BCO_return_nonpointer; default: { @@ -815,7 +839,7 @@ do_apply: SET_HDR(new_pap,&stg_PAP_info,cap->r.rCCCS); tagged_obj = (StgClosure *)new_pap; Sp_addW(m); - goto do_return; + goto do_return_pointer; } } @@ -858,7 +882,7 @@ do_apply: SET_HDR(pap, &stg_PAP_info,cap->r.rCCCS); tagged_obj = (StgClosure *)pap; Sp_addW(m); - goto do_return; + goto do_return_pointer; } } @@ -917,10 +941,10 @@ do_apply: // to do: -run_BCO_return: +run_BCO_return_pointer: // Heap check if (doYouWantToGC(cap)) { - Sp_subW(1); SpW(0) = (W_)&stg_enter_info; + Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info; RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow); } // Stack checks aren't necessary at return points, the stack use @@ -928,7 +952,7 @@ run_BCO_return: goto run_BCO; -run_BCO_return_unlifted: +run_BCO_return_nonpointer: // Heap check if (doYouWantToGC(cap)) { RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow); @@ -973,6 +997,9 @@ run_BCO_return_unlifted: } #endif + if (SpW(0) != (W_)&stg_ret_t_info) { + Sp_addW(1); + } goto run_BCO; run_BCO_fun: @@ -1274,7 +1301,7 @@ run_BCO: goto nextInsn; } - case bci_PUSH_ALTS: { + case bci_PUSH_ALTS_P: { int o_bco = BCO_GET_LARGE_ARG; Sp_subW(2); SpW(1) = BCO_PTR(o_bco); @@ -1287,19 +1314,6 @@ run_BCO: goto nextInsn; } - case bci_PUSH_ALTS_P: { - int o_bco = BCO_GET_LARGE_ARG; - SpW(-2) = (W_)&stg_ctoi_R1unpt_info; - SpW(-1) = BCO_PTR(o_bco); - Sp_subW(2); -#if defined(PROFILING) - Sp_subW(2); - SpW(1) = (W_)cap->r.rCCCS; - SpW(0) = (W_)&stg_restore_cccs_info; -#endif - goto nextInsn; - } - case bci_PUSH_ALTS_N: { int o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_R1n_info; @@ -1678,19 +1692,7 @@ run_BCO: StgInfoTable *con_itbl = (StgInfoTable*) BCO_LIT(o_itbl); SET_HDR(con, con_itbl, cap->r.rCCCS); - // Note [Data constructor dynamic tags] - // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - // compute the pointer tag for the constructor and tag the pointer - // - // - 1..(TAG_MASK-1): for first TAG_MASK-1 constructors - // - TAG_MASK: look in info table - // - // Note: we need to update this if we change the tagging strategy - // - // For full details of the invariants on tagging, see - // https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/haskell-execution/pointer-tagging - - StgClosure* tagged_con = TAG_CLOSURE(stg_min(TAG_MASK, 1 + GET_TAG(con)), con); + StgClosure* tagged_con = tagConstr(con); SpW(0) = (W_)tagged_con; IF_DEBUG(interpreter, @@ -1721,60 +1723,54 @@ run_BCO: } case bci_TESTLT_I: { - // There should be an Int at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - I_ stackInt = (I_)SpW(1); + I_ stackInt = (I_)SpW(0); if (stackInt >= (I_)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_I64: { - // There should be an Int64 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt64 stackInt = (*(StgInt64*)Sp_plusW(1)); + StgInt64 stackInt = (*(StgInt64*)Sp); if (stackInt >= BCO_LITI64(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_I32: { - // There should be an Int32 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt32 stackInt = (*(StgInt32*)Sp_plusW(1)); + StgInt32 stackInt = (*(StgInt32*)Sp); if (stackInt >= (StgInt32)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_I16: { - // There should be an Int16 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt16 stackInt = (*(StgInt16*)Sp_plusW(1)); + StgInt16 stackInt = (*(StgInt16*)Sp); if (stackInt >= (StgInt16)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_I8: { - // There should be an Int8 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt8 stackInt = (*(StgInt8*)Sp_plusW(1)); + StgInt8 stackInt = (*(StgInt8*)Sp); if (stackInt >= (StgInt8)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTEQ_I: { - // There should be an Int at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - I_ stackInt = (I_)SpW(1); + I_ stackInt = (I_)SpW(0); if (stackInt != (I_)BCO_LIT(discr)) { bciPtr = failto; } @@ -1782,10 +1778,9 @@ run_BCO: } case bci_TESTEQ_I64: { - // There should be an Int64 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt64 stackInt = (*(StgInt64*)Sp_plusW(1)); + StgInt64 stackInt = (*(StgInt64*)Sp); if (stackInt != BCO_LITI64(discr)) { bciPtr = failto; } @@ -1793,10 +1788,9 @@ run_BCO: } case bci_TESTEQ_I32: { - // There should be an Int32 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt32 stackInt = (*(StgInt32*)Sp_plusW(1)); + StgInt32 stackInt = (*(StgInt32*)Sp); if (stackInt != (StgInt32)BCO_LIT(discr)) { bciPtr = failto; } @@ -1804,10 +1798,9 @@ run_BCO: } case bci_TESTEQ_I16: { - // There should be an Int16 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt16 stackInt = (*(StgInt16*)Sp_plusW(1)); + StgInt16 stackInt = (*(StgInt16*)Sp); if (stackInt != (StgInt16)BCO_LIT(discr)) { bciPtr = failto; } @@ -1815,10 +1808,9 @@ run_BCO: } case bci_TESTEQ_I8: { - // There should be an Int8 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt8 stackInt = (*(StgInt8*)Sp_plusW(1)); + StgInt8 stackInt = (*(StgInt8*)Sp); if (stackInt != (StgInt8)BCO_LIT(discr)) { bciPtr = failto; } @@ -1826,60 +1818,54 @@ run_BCO: } case bci_TESTLT_W: { - // There should be a Word at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - W_ stackWord = (W_)SpW(1); + W_ stackWord = (W_)SpW(0); if (stackWord >= (W_)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_W64: { - // There should be a Word64 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord64 stackWord = (*(StgWord64*)Sp_plusW(1)); + StgWord64 stackWord = (*(StgWord64*)Sp); if (stackWord >= BCO_LITW64(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_W32: { - // There should be a Word32 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord32 stackWord = (*(StgWord32*)Sp_plusW(1)); + StgWord32 stackWord = (*(StgWord32*)Sp); if (stackWord >= (StgWord32)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_W16: { - // There should be a Word16 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord16 stackWord = (*(StgWord16*)Sp_plusW(1)); + StgWord16 stackWord = (*(StgWord16*)Sp); if (stackWord >= (StgWord16)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_W8: { - // There should be a Word8 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord8 stackWord = (*(StgWord8*)Sp_plusW(1)); + StgWord8 stackWord = (*(StgWord8*)Sp); if (stackWord >= (StgWord8)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTEQ_W: { - // There should be a Word at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - W_ stackWord = (W_)SpW(1); + W_ stackWord = (W_)SpW(0); if (stackWord != (W_)BCO_LIT(discr)) { bciPtr = failto; } @@ -1887,10 +1873,9 @@ run_BCO: } case bci_TESTEQ_W64: { - // There should be a Word64 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord64 stackWord = (*(StgWord64*)Sp_plusW(1)); + StgWord64 stackWord = (*(StgWord64*)Sp); if (stackWord != BCO_LITW64(discr)) { bciPtr = failto; } @@ -1898,10 +1883,9 @@ run_BCO: } case bci_TESTEQ_W32: { - // There should be a Word32 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord32 stackWord = (*(StgWord32*)Sp_plusW(1)); + StgWord32 stackWord = (*(StgWord32*)Sp); if (stackWord != (StgWord32)BCO_LIT(discr)) { bciPtr = failto; } @@ -1909,10 +1893,9 @@ run_BCO: } case bci_TESTEQ_W16: { - // There should be a Word16 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord16 stackWord = (*(StgWord16*)Sp_plusW(1)); + StgWord16 stackWord = (*(StgWord16*)Sp); if (stackWord != (StgWord16)BCO_LIT(discr)) { bciPtr = failto; } @@ -1920,10 +1903,9 @@ run_BCO: } case bci_TESTEQ_W8: { - // There should be a Word8 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord8 stackWord = (*(StgWord8*)Sp_plusW(1)); + StgWord8 stackWord = (*(StgWord8*)Sp); if (stackWord != (StgWord8)BCO_LIT(discr)) { bciPtr = failto; } @@ -1931,11 +1913,10 @@ run_BCO: } case bci_TESTLT_D: { - // There should be a Double at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgDouble stackDbl, discrDbl; - stackDbl = PK_DBL( & SpW(1) ); + stackDbl = PK_DBL( & SpW(0) ); discrDbl = PK_DBL( & BCO_LIT(discr) ); if (stackDbl >= discrDbl) { bciPtr = failto; @@ -1944,11 +1925,10 @@ run_BCO: } case bci_TESTEQ_D: { - // There should be a Double at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgDouble stackDbl, discrDbl; - stackDbl = PK_DBL( & SpW(1) ); + stackDbl = PK_DBL( & SpW(0) ); discrDbl = PK_DBL( & BCO_LIT(discr) ); if (stackDbl != discrDbl) { bciPtr = failto; @@ -1957,11 +1937,10 @@ run_BCO: } case bci_TESTLT_F: { - // There should be a Float at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgFloat stackFlt, discrFlt; - stackFlt = PK_FLT( & SpW(1) ); + stackFlt = PK_FLT( & SpW(0) ); discrFlt = PK_FLT( & BCO_LIT(discr) ); if (stackFlt >= discrFlt) { bciPtr = failto; @@ -1970,11 +1949,10 @@ run_BCO: } case bci_TESTEQ_F: { - // There should be a Float at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgFloat stackFlt, discrFlt; - stackFlt = PK_FLT( & SpW(1) ); + stackFlt = PK_FLT( & SpW(0) ); discrFlt = PK_FLT( & BCO_LIT(discr) ); if (stackFlt != discrFlt) { bciPtr = failto; @@ -1995,40 +1973,36 @@ run_BCO: } goto eval; - case bci_RETURN: + case bci_RETURN_P: tagged_obj = (StgClosure *)SpW(0); Sp_addW(1); - goto do_return; + goto do_return_pointer; - case bci_RETURN_P: - Sp_subW(1); - SpW(0) = (W_)&stg_ret_p_info; - goto do_return_unlifted; case bci_RETURN_N: Sp_subW(1); SpW(0) = (W_)&stg_ret_n_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_F: Sp_subW(1); SpW(0) = (W_)&stg_ret_f_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_D: Sp_subW(1); SpW(0) = (W_)&stg_ret_d_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_L: Sp_subW(1); SpW(0) = (W_)&stg_ret_l_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_V: Sp_subW(1); SpW(0) = (W_)&stg_ret_v_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_T: { /* tuple_info and tuple_bco must already be on the stack */ Sp_subW(1); SpW(0) = (W_)&stg_ret_t_info; - goto do_return_unlifted; + goto do_return_nonpointer; } case bci_SWIZZLE: { ===================================== rts/Printer.c ===================================== @@ -652,8 +652,6 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) if (c == (StgWord)&stg_ctoi_R1p_info) { debugBelch("stg_ctoi_R1p_info" ); - } else if (c == (StgWord)&stg_ctoi_R1unpt_info) { - debugBelch("stg_ctoi_R1unpt_info" ); } else if (c == (StgWord)&stg_ctoi_R1n_info) { debugBelch("stg_ctoi_R1n_info" ); } else if (c == (StgWord)&stg_ctoi_F1_info) { ===================================== rts/StgMiscClosures.cmm ===================================== @@ -147,18 +147,6 @@ stg_interp_constr7_entry (P_ ret) { return (ret + 7); } INFO_TABLE_RET( stg_ctoi_R1p, RET_BCO) /* explicit stack */ -{ - Sp_adj(-2); - Sp(1) = R1; - Sp(0) = stg_enter_info; - jump stg_yield_to_interpreter []; -} - -/* - * When the returned value is a pointer, but unlifted, in R1 ... - */ -INFO_TABLE_RET( stg_ctoi_R1unpt, RET_BCO ) - /* explicit stack */ { Sp_adj(-2); Sp(1) = R1; ===================================== rts/include/rts/Bytecodes.h ===================================== @@ -34,7 +34,6 @@ #define bci_PUSH16_W 9 #define bci_PUSH32_W 10 #define bci_PUSH_G 11 -#define bci_PUSH_ALTS 12 #define bci_PUSH_ALTS_P 13 #define bci_PUSH_ALTS_N 14 #define bci_PUSH_ALTS_F 15 @@ -81,7 +80,6 @@ #define bci_CCALL 56 #define bci_SWIZZLE 57 #define bci_ENTER 58 -#define bci_RETURN 59 #define bci_RETURN_P 60 #define bci_RETURN_N 61 #define bci_RETURN_F 62 ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -82,7 +82,6 @@ RTS_RET(stg_prompt_frame); /* Magic glue code for when compiled code returns a value in R1/F1/D1 or a VoidRep to the interpreter. */ RTS_RET(stg_ctoi_R1p); -RTS_RET(stg_ctoi_R1unpt); RTS_RET(stg_ctoi_R1n); RTS_RET(stg_ctoi_F1); RTS_RET(stg_ctoi_D1); ===================================== testsuite/tests/ghci/should_run/T22958a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +import GHC.Exts +import GHC.IO + +unit :: () +unit = () + +i :: State# RealWorld -> (# State# RealWorld, () #) +i s = case seq# unit s of (# s', a #) -> (# s', a #) + +bad :: IO () +bad = IO i + +main :: IO () +main = bad >>= print ===================================== testsuite/tests/ghci/should_run/T22958a.stdout ===================================== @@ -0,0 +1 @@ +() ===================================== testsuite/tests/ghci/should_run/T22958b.hs ===================================== @@ -0,0 +1,25 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedDatatypes #-} +import GHC.Exts + +type D1 :: TYPE (BoxedRep Unlifted) +data D1 = MkD1 !Int + +showD1 :: D1 -> String +showD1 (MkD1 i) = "MkD1 " ++ show i + +type D2 :: TYPE (BoxedRep Lifted) +data D2 = MkD2 !Int deriving stock Show + +risky :: forall {r} (a :: TYPE (BoxedRep Unlifted)) (b :: TYPE r). a -> b +risky = unsafeCoerce# +{-# NOINLINE risky #-} + +main :: IO () +main = do + putStrLn (showD1 (unsafeCoerce# (MkD1 11))) -- foo11 + print (unsafeCoerce# (MkD1 12) :: D2) -- foo12 + putStrLn (showD1 (risky (MkD1 11))) -- bar11 + print (risky (MkD1 12) :: D2) -- bar12 ===================================== testsuite/tests/ghci/should_run/T22958b.stdout ===================================== @@ -0,0 +1,4 @@ +MkD1 11 +MkD2 12 +MkD1 11 +MkD2 12 ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -88,3 +88,5 @@ test('UnliftedDataType2', just_ghci, compile_and_run, ['']) test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], compile_and_run, ['']) test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script']) +test('T22958a', just_ghci, compile_and_run, ['']) +test('T22958b', just_ghci, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d85ed900b271109185251cb0494d51048a4cf213 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d85ed900b271109185251cb0494d51048a4cf213 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 12:46:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 13 May 2023 08:46:16 -0400 Subject: [Git][ghc/ghc][master] Add more instances for Compose: Enum, Bounded, Num, Real, Integral Message-ID: <645f8698eb830_171ad916a0bd402874e5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 2 changed files: - libraries/base/Data/Functor/Compose.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -156,3 +156,14 @@ instance (TestEquality f) => TestEquality (Compose f g) where case testEquality x y of -- :: Maybe (g x :~: g y) Just Refl -> Just Refl -- :: Maybe (x :~: y) Nothing -> Nothing + +-- | @since 4.19.0.0 +deriving instance Enum (f (g a)) => Enum (Compose f g a) +-- | @since 4.19.0.0 +deriving instance Bounded (f (g a)) => Bounded (Compose f g a) +-- | @since 4.19.0.0 +deriving instance Num (f (g a)) => Num (Compose f g a) +-- | @since 4.19.0.0 +deriving instance Real (f (g a)) => Real (Compose f g a) +-- | @since 4.19.0.0 +deriving instance Integral (f (g a)) => Integral (Compose f g a) ===================================== libraries/base/changelog.md ===================================== @@ -25,6 +25,7 @@ adding the class `Unsatisfiable :: ErrorMessage -> TypeError` to `GHC.TypeError`, which provides a mechanism for custom type errors that reports the errors in a more predictable behaviour than `TypeError`. + * Add more instances for `Compose`: `Enum`, `Bounded`, `Num`, `Real`, `Integral` ([CLC proposal #160](https://github.com/haskell/core-libraries-committee/issues/160)) * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a0d45f7d846e92cf4b6641fd8c67606412cdb3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a0d45f7d846e92cf4b6641fd8c67606412cdb3a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 14:04:58 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Sat, 13 May 2023 10:04:58 -0400 Subject: [Git][ghc/ghc][wip/amg/dcoercion] 11 commits: rts: Ensure non-moving gc is not running when pausing Message-ID: <645f990ab042_171ad91a044c403006c5@gitlab.mail> sheaf pushed to branch wip/amg/dcoercion at Glasgow Haskell Compiler / GHC Commits: aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - efc61741 by Adam Gundry at 2023-05-13T14:59:47+02:00 Directed coercions We introduce a slimmer version of coercions, directed coercions, which store fewer types within them. This more compact representation considerably speeds up programs which involve many type family reductions, as the coercion size no longer grows quadratically in the number of reduction steps. - - - - - fbb0665a by sheaf at 2023-05-13T15:58:48+02:00 WIP: remove LHS type in Reduction - - - - - b7db69ce by sheaf at 2023-05-13T15:59:10+02:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 6 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - + compiler/GHC/Core/FamInstEnv.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e07c825ebf2028273066e8201de4ffec97ab806...b7db69ceb32dbb4161193e9e558b8281e0873cfb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e07c825ebf2028273066e8201de4ffec97ab806...b7db69ceb32dbb4161193e9e558b8281e0873cfb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 14:59:59 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Sat, 13 May 2023 10:59:59 -0400 Subject: [Git][ghc/ghc][wip/ghc-driver-dynflags] Split DynFlags structure into own module Message-ID: <645fa5ef27951_171ad91a33e23430818a@gitlab.mail> Oleg Grenrus pushed to branch wip/ghc-driver-dynflags at Glasgow Haskell Compiler / GHC Commits: bfbc574c by Oleg Grenrus at 2023-05-13T17:59:20+03:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 25 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/State.hs - compiler/ghc.cabal.in - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -26,7 +26,7 @@ import qualified Text.ParserCombinators.ReadP as P import GHC.Prelude import GHC.Utils.Outputable as Outputable -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.CostCentre import GHC.Types.CostCentre.State import GHC.Types.Name hiding (varName) ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Core.Opt.Monad ( import GHC.Prelude hiding ( read ) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv ) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Unit.Module.Env import GHC.Unit.Module.ModGuts( ModGuts(..) ) import GHC.Unit.Module.Deps( Dependencies(..) ) -import GHC.Driver.Session( DynFlags ) +import GHC.Driver.DynFlags( DynFlags ) import GHC.Driver.Ppr( showSDoc ) import GHC.Core -- All of it ===================================== compiler/GHC/Data/IOEnv.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Data.IOEnv ( import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Hooks import GHC.IO (catchException) import GHC.Utils.Exception ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Driver.Config.Diagnostic where import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Prelude import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Config/Logger.hs ===================================== @@ -5,7 +5,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Logger (LogFlags (..)) import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -0,0 +1,1507 @@ +{-# LANGUAGE LambdaCase #-} +module GHC.Driver.DynFlags ( + -- * Dynamic flags and associated configuration types + DumpFlag(..), + GeneralFlag(..), + WarningFlag(..), DiagnosticReason(..), + Language(..), + FatalMessager, FlushOut(..), + ProfAuto(..), + dopt, dopt_set, dopt_unset, + gopt, gopt_set, gopt_unset, + wopt, wopt_set, wopt_unset, + wopt_fatal, wopt_set_fatal, wopt_unset_fatal, + wopt_set_all_custom, wopt_unset_all_custom, + wopt_set_all_fatal_custom, wopt_unset_all_fatal_custom, + wopt_set_custom, wopt_unset_custom, + wopt_set_fatal_custom, wopt_unset_fatal_custom, + wopt_any_custom, + xopt, xopt_set, xopt_unset, + xopt_set_unlessExplSpec, + xopt_DuplicateRecordFields, + xopt_FieldSelectors, + lang_set, + DynamicTooState(..), dynamicTooState, setDynamicNow, + OnOff(..), + DynFlags(..), + ParMakeCount(..), + ways, + HasDynFlags(..), ContainsDynFlags(..), + RtsOptsEnabled(..), + GhcMode(..), isOneShot, + GhcLink(..), isNoLink, + PackageFlag(..), PackageArg(..), ModRenaming(..), + packageFlagsChanged, + IgnorePackageFlag(..), TrustFlag(..), + PackageDBFlag(..), PkgDbRef(..), + Option(..), showOpt, + DynLibLoader(..), + positionIndependent, + optimisationFlags, + + -- ** Manipulating DynFlags + defaultDynFlags, -- Settings -> DynFlags + initDynFlags, -- DynFlags -> IO DynFlags + defaultFatalMessager, + defaultFlushOut, + optLevelFlags, + languageExtensions, + + TurnOnFlag, + turnOn, + turnOff, + + -- ** System tool settings and locations + programName, projectVersion, + ghcUsagePath, ghciUsagePath, topDir, toolDir, + versionedAppDir, versionedFilePath, + extraGccViaCFlags, globalPackageDatabasePath, + + -- * Linker/compiler information + LinkerInfo(..), + CompilerInfo(..), + + -- * Include specifications + IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes, + addImplicitQuoteInclude, + + -- * SDoc + initSDocContext, initDefaultSDocContext, + initPromotionTickContext, +) where + +import GHC.Prelude + +import GHC.Platform +import GHC.Platform.Ways + +import GHC.CmmToAsm.CFG.Weight +import GHC.Core.Unfold +import GHC.Data.Bool +import GHC.Data.EnumSet (EnumSet) +import GHC.Data.Maybe +import GHC.Builtin.Names ( mAIN_NAME ) +import GHC.Driver.Backend +import GHC.Driver.Flags +import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.Plugins.External +import GHC.Settings +import GHC.Settings.Constants +import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) +import GHC.Types.Error (DiagnosticReason(..)) +import GHC.Types.ProfAuto +import GHC.Types.SafeHaskell +import GHC.Types.SrcLoc +import GHC.Unit.Module +import GHC.Unit.Module.Warnings +import GHC.Utils.CliOption +import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) +import GHC.UniqueSubdir (uniqueSubdir) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.TmpFs + +import qualified GHC.Types.FieldLabel as FieldLabel +import qualified GHC.Utils.Ppr.Colour as Col +import qualified GHC.Data.EnumSet as EnumSet + +import {-# SOURCE #-} GHC.Core.Opt.CallerCC + +import Control.Monad (msum, (<=<)) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.Writer (WriterT) +import Data.IORef +import System.IO +import System.IO.Error (catchIOError) +import System.Environment (lookupEnv) +import System.FilePath (normalise, ()) +import System.Directory +import GHC.Foreign (withCString, peekCString) + +import qualified Data.Set as Set + +import qualified GHC.LanguageExtensions as LangExt + +-- ----------------------------------------------------------------------------- +-- DynFlags + +-- | Contains not only a collection of 'GeneralFlag's but also a plethora of +-- information relating to the compilation of a single file or GHC session +data DynFlags = DynFlags { + ghcMode :: GhcMode, + ghcLink :: GhcLink, + backend :: !Backend, + -- ^ The backend to use (if any). + -- + -- Whenever you change the backend, also make sure to set 'ghcLink' to + -- something sensible. + -- + -- 'NoBackend' can be used to avoid generating any output, however, note that: + -- + -- * If a program uses Template Haskell the typechecker may need to run code + -- from an imported module. To facilitate this, code generation is enabled + -- for modules imported by modules that use template haskell, using the + -- default backend for the platform. + -- See Note [-fno-code mode]. + + + -- formerly Settings + ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, + fileSettings :: {-# UNPACK #-} !FileSettings, + targetPlatform :: Platform, -- Filled in by SysTools + toolSettings :: {-# UNPACK #-} !ToolSettings, + platformMisc :: {-# UNPACK #-} !PlatformMisc, + rawSettings :: [(String, String)], + tmpDir :: TempDir, + + llvmOptLevel :: Int, -- ^ LLVM optimisation level + verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] + debugLevel :: Int, -- ^ How much debug information to produce + simplPhases :: Int, -- ^ Number of simplifier phases + maxSimplIterations :: Int, -- ^ Max simplifier iterations + ruleCheck :: Maybe String, + strictnessBefore :: [Int], -- ^ Additional demand analysis + + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. + + enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? + ghcHeapSize :: Maybe Int, -- ^ The heap size to set. + + maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt + -- to show in type error messages + maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show + -- in typed hole error messages + maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole + -- fits to show in typed hole error + -- messages + refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for + -- refinement hole fits in typed hole + -- error messages + maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show + -- in non-exhaustiveness warnings + maxPmCheckModels :: Int, -- ^ Soft limit on the number of models + -- the pattern match checker checks + -- a pattern against. A safe guard + -- against exponential blow-up. + simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks + dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an + -- Unboxed demand on returned products with at most + -- this number of fields + specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr + specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function + specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types + -- Not optional; otherwise ForceSpecConstr can diverge. + binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above + -- this threshold will be dumped in a binary file + -- by the assembler code generator. 0 and Nothing disables + -- this feature. See 'GHC.StgToCmm.Config'. + liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase + floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating + -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' + + liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- recursive function. + liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- non-recursive function. + liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call + -- into an unknown call. + + cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. + + historySize :: Int, -- ^ Simplification history size + + importPaths :: [FilePath], + mainModuleNameIs :: ModuleName, + mainFunIs :: Maybe String, + reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth + solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver + -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + homeUnitId_ :: UnitId, -- ^ Target home unit-id + homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate + homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations + + -- Note [Filepaths and Multiple Home Units] + workingDirectory :: Maybe FilePath, + thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units + hiddenModules :: Set.Set ModuleName, + reexportedModules :: Set.Set ModuleName, + + -- ways + targetWays_ :: Ways, -- ^ Target way flags from the command line + + -- For object splitting + splitInfo :: Maybe (String,Int), + + -- paths etc. + objectDir :: Maybe String, + dylibInstallName :: Maybe String, + hiDir :: Maybe String, + hieDir :: Maybe String, + stubDir :: Maybe String, + dumpDir :: Maybe String, + + objectSuf_ :: String, + hcSuf :: String, + hiSuf_ :: String, + hieSuf :: String, + + dynObjectSuf_ :: String, + dynHiSuf_ :: String, + + outputFile_ :: Maybe String, + dynOutputFile_ :: Maybe String, + outputHi :: Maybe String, + dynOutputHi :: Maybe String, + dynLibLoader :: DynLibLoader, + + dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output + -- because of -dynamic-too. This predicate is + -- used to query the appropriate fields + -- (outputFile/dynOutputFile, ways, etc.) + + -- | This defaults to 'non-module'. It can be set by + -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on + -- where its output is going. + dumpPrefix :: FilePath, + + -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' + -- or 'ghc.GHCi.UI.runStmt'. + -- Set by @-ddump-file-prefix@ + dumpPrefixForce :: Maybe FilePath, + + ldInputs :: [Option], + + includePaths :: IncludeSpecs, + libraryPaths :: [String], + frameworkPaths :: [String], -- used on darwin only + cmdlineFrameworks :: [String], -- ditto + + rtsOpts :: Maybe String, + rtsOptsEnabled :: RtsOptsEnabled, + rtsOptsSuggestions :: Bool, + + hpcDir :: String, -- ^ Path to store the .mix files + + -- Plugins + pluginModNames :: [ModuleName], + -- ^ the @-fplugin@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + pluginModNameOpts :: [(ModuleName,String)], + frontendPluginOpts :: [String], + -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + + externalPluginSpecs :: [ExternalPluginSpec], + -- ^ External plugins loaded from shared libraries + + -- For ghc -M + depMakefile :: FilePath, + depIncludePkgDeps :: Bool, + depIncludeCppDeps :: Bool, + depExcludeMods :: [ModuleName], + depSuffixes :: [String], + + -- Package flags + packageDBFlags :: [PackageDBFlag], + -- ^ The @-package-db@ flags given on the command line, In + -- *reverse* order that they're specified on the command line. + -- This is intended to be applied with the list of "initial" + -- package databases derived from @GHC_PACKAGE_PATH@; see + -- 'getUnitDbRefs'. + + ignorePackageFlags :: [IgnorePackageFlag], + -- ^ The @-ignore-package@ flags from the command line. + -- In *reverse* order that they're specified on the command line. + packageFlags :: [PackageFlag], + -- ^ The @-package@ and @-hide-package@ flags from the command-line. + -- In *reverse* order that they're specified on the command line. + pluginPackageFlags :: [PackageFlag], + -- ^ The @-plugin-package-id@ flags from command line. + -- In *reverse* order that they're specified on the command line. + trustFlags :: [TrustFlag], + -- ^ The @-trust@ and @-distrust@ flags. + -- In *reverse* order that they're specified on the command line. + packageEnv :: Maybe FilePath, + -- ^ Filepath to the package environment file (if overriding default) + + + -- hsc dynamic flags + dumpFlags :: EnumSet DumpFlag, + generalFlags :: EnumSet GeneralFlag, + warningFlags :: EnumSet WarningFlag, + fatalWarningFlags :: EnumSet WarningFlag, + customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] + fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings + -- Don't change this without updating extensionFlags: + language :: Maybe Language, + -- | Safe Haskell mode + safeHaskell :: SafeHaskellMode, + safeInfer :: Bool, + safeInferred :: Bool, + -- We store the location of where some extension and flags were turned on so + -- we can produce accurate error messages when Safe Haskell fails due to + -- them. + thOnLoc :: SrcSpan, + newDerivOnLoc :: SrcSpan, + deriveViaOnLoc :: SrcSpan, + overlapInstLoc :: SrcSpan, + incoherentOnLoc :: SrcSpan, + pkgTrustOnLoc :: SrcSpan, + warnSafeOnLoc :: SrcSpan, + warnUnsafeOnLoc :: SrcSpan, + trustworthyOnLoc :: SrcSpan, + -- Don't change this without updating extensionFlags: + -- Here we collect the settings of the language extensions + -- from the command line, the ghci config file and + -- from interactive :set / :seti commands. + extensions :: [OnOff LangExt.Extension], + -- extensionFlags should always be equal to + -- flattenExtensionFlags language extensions + -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used + -- by template-haskell + extensionFlags :: EnumSet LangExt.Extension, + + -- | Unfolding control + -- See Note [Discounts and thresholds] in GHC.Core.Unfold + unfoldingOpts :: !UnfoldingOpts, + + maxWorkerArgs :: Int, + + ghciHistSize :: Int, + + flushOut :: FlushOut, + + ghcVersionFile :: Maybe FilePath, + haddockOptions :: Maybe String, + + -- | GHCi scripts specified by -ghci-script, in reverse order + ghciScripts :: [String], + + -- Output style options + pprUserLength :: Int, + pprCols :: Int, + + useUnicode :: Bool, + useColor :: OverridingBool, + canUseColor :: Bool, + colScheme :: Col.Scheme, + + -- | what kind of {-# SCC #-} to add automatically + profAuto :: ProfAuto, + callerCcFilters :: [CallerCcFilter], + + interactivePrint :: Maybe String, + + -- | Machine dependent flags (-m\ stuff) + sseVersion :: Maybe SseVersion, + bmiVersion :: Maybe BmiVersion, + avx :: Bool, + avx2 :: Bool, + avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. + avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. + avx512f :: Bool, -- Enable AVX-512 instructions. + avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. + fma :: Bool, -- ^ Enable FMA instructions. + + -- | Run-time linker information (what options we need, etc.) + rtldInfo :: IORef (Maybe LinkerInfo), + + -- | Run-time C compiler information + rtccInfo :: IORef (Maybe CompilerInfo), + + -- | Run-time assembler information + rtasmInfo :: IORef (Maybe CompilerInfo), + + -- Constants used to control the amount of optimization done. + + -- | Max size, in bytes, of inline array allocations. + maxInlineAllocSize :: Int, + + -- | Only inline memcpy if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemcpyInsns :: Int, + + -- | Only inline memset if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemsetInsns :: Int, + + -- | Reverse the order of error messages in GHC/GHCi + reverseErrors :: Bool, + + -- | Limit the maximum number of errors to show + maxErrors :: Maybe Int, + + -- | Unique supply configuration for testing build determinism + initialUnique :: Word, + uniqueIncrement :: Int, + -- 'Int' because it can be used to test uniques in decreasing order. + + -- | Temporary: CFG Edge weights for fast iterations + cfgWeights :: Weights +} + +class HasDynFlags m where + getDynFlags :: m DynFlags + +{- It would be desirable to have the more generalised + + instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where + getDynFlags = lift getDynFlags + +instance definition. However, that definition would overlap with the +`HasDynFlags (GhcT m)` instance. Instead we define instances for a +couple of common Monad transformers explicitly. -} + +instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where + getDynFlags = lift getDynFlags + +class ContainsDynFlags t where + extractDynFlags :: t -> DynFlags + +----------------------------------------------------------------------------- + +-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value +initDynFlags :: DynFlags -> IO DynFlags +initDynFlags dflags = do + let + refRtldInfo <- newIORef Nothing + refRtccInfo <- newIORef Nothing + refRtasmInfo <- newIORef Nothing + canUseUnicode <- do let enc = localeEncoding + str = "‘’" + (withCString enc str $ \cstr -> + do str' <- peekCString enc cstr + return (str == str')) + `catchIOError` \_ -> return False + ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" + let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode + maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" + maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" + let adjustCols (Just env) = Col.parseScheme env + adjustCols Nothing = id + let (useColor', colScheme') = + (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) + (useColor dflags, colScheme dflags) + tmp_dir <- normalise <$> getTemporaryDirectory + return dflags{ + useUnicode = useUnicode', + useColor = useColor', + canUseColor = stderrSupportsAnsiColors, + colScheme = colScheme', + rtldInfo = refRtldInfo, + rtccInfo = refRtccInfo, + rtasmInfo = refRtasmInfo, + tmpDir = TempDir tmp_dir + } + +-- | The normal 'DynFlags'. Note that they are not suitable for use in this form +-- and must be fully initialized by 'GHC.runGhc' first. +defaultDynFlags :: Settings -> DynFlags +defaultDynFlags mySettings = +-- See Note [Updating flag description in the User's Guide] + DynFlags { + ghcMode = CompManager, + ghcLink = LinkBinary, + backend = platformDefaultBackend (sTargetPlatform mySettings), + verbosity = 0, + debugLevel = 0, + simplPhases = 2, + maxSimplIterations = 4, + ruleCheck = Nothing, + binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) + maxRelevantBinds = Just 6, + maxValidHoleFits = Just 6, + maxRefHoleFits = Just 6, + refLevelHoleFits = Nothing, + maxUncoveredPatterns = 4, + maxPmCheckModels = 30, + simplTickFactor = 100, + dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple + specConstrThreshold = Just 2000, + specConstrCount = Just 3, + specConstrRecursive = 3, + liberateCaseThreshold = Just 2000, + floatLamArgs = Just 0, -- Default: float only if no fvs + liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsKnown = False, -- Default: don't turn known calls into unknown ones + cmmProcAlignment = Nothing, + + historySize = 20, + strictnessBefore = [], + + parMakeCount = Nothing, + + enableTimeStats = False, + ghcHeapSize = Nothing, + + importPaths = ["."], + mainModuleNameIs = mAIN_NAME, + mainFunIs = Nothing, + reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, + solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, + + homeUnitId_ = mainUnitId, + homeUnitInstanceOf_ = Nothing, + homeUnitInstantiations_ = [], + + workingDirectory = Nothing, + thisPackageName = Nothing, + hiddenModules = Set.empty, + reexportedModules = Set.empty, + + objectDir = Nothing, + dylibInstallName = Nothing, + hiDir = Nothing, + hieDir = Nothing, + stubDir = Nothing, + dumpDir = Nothing, + + objectSuf_ = phaseInputExt StopLn, + hcSuf = phaseInputExt HCc, + hiSuf_ = "hi", + hieSuf = "hie", + + dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, + dynHiSuf_ = "dyn_hi", + dynamicNow = False, + + pluginModNames = [], + pluginModNameOpts = [], + frontendPluginOpts = [], + + externalPluginSpecs = [], + + outputFile_ = Nothing, + dynOutputFile_ = Nothing, + outputHi = Nothing, + dynOutputHi = Nothing, + dynLibLoader = SystemDependent, + dumpPrefix = "non-module.", + dumpPrefixForce = Nothing, + ldInputs = [], + includePaths = IncludeSpecs [] [] [], + libraryPaths = [], + frameworkPaths = [], + cmdlineFrameworks = [], + rtsOpts = Nothing, + rtsOptsEnabled = RtsOptsSafeOnly, + rtsOptsSuggestions = True, + + hpcDir = ".hpc", + + packageDBFlags = [], + packageFlags = [], + pluginPackageFlags = [], + ignorePackageFlags = [], + trustFlags = [], + packageEnv = Nothing, + targetWays_ = Set.empty, + splitInfo = Nothing, + + ghcNameVersion = sGhcNameVersion mySettings, + fileSettings = sFileSettings mySettings, + toolSettings = sToolSettings mySettings, + targetPlatform = sTargetPlatform mySettings, + platformMisc = sPlatformMisc mySettings, + rawSettings = sRawSettings mySettings, + + tmpDir = panic "defaultDynFlags: uninitialized tmpDir", + + llvmOptLevel = 0, + + -- ghc -M values + depMakefile = "Makefile", + depIncludePkgDeps = False, + depIncludeCppDeps = False, + depExcludeMods = [], + depSuffixes = [], + -- end of ghc -M values + ghcVersionFile = Nothing, + haddockOptions = Nothing, + dumpFlags = EnumSet.empty, + generalFlags = EnumSet.fromList (defaultFlags mySettings), + warningFlags = EnumSet.fromList standardWarnings, + fatalWarningFlags = EnumSet.empty, + customWarningCategories = completeWarningCategorySet, + fatalCustomWarningCategories = emptyWarningCategorySet, + ghciScripts = [], + language = Nothing, + safeHaskell = Sf_None, + safeInfer = True, + safeInferred = True, + thOnLoc = noSrcSpan, + newDerivOnLoc = noSrcSpan, + deriveViaOnLoc = noSrcSpan, + overlapInstLoc = noSrcSpan, + incoherentOnLoc = noSrcSpan, + pkgTrustOnLoc = noSrcSpan, + warnSafeOnLoc = noSrcSpan, + warnUnsafeOnLoc = noSrcSpan, + trustworthyOnLoc = noSrcSpan, + extensions = [], + extensionFlags = flattenExtensionFlags Nothing [], + + unfoldingOpts = defaultUnfoldingOpts, + maxWorkerArgs = 10, + + ghciHistSize = 50, -- keep a log of length 50 by default + + flushOut = defaultFlushOut, + pprUserLength = 5, + pprCols = 100, + useUnicode = False, + useColor = Auto, + canUseColor = False, + colScheme = Col.defaultScheme, + profAuto = NoProfAuto, + callerCcFilters = [], + interactivePrint = Nothing, + sseVersion = Nothing, + bmiVersion = Nothing, + avx = False, + avx2 = False, + avx512cd = False, + avx512er = False, + avx512f = False, + avx512pf = False, + fma = False, + rtldInfo = panic "defaultDynFlags: no rtldInfo", + rtccInfo = panic "defaultDynFlags: no rtccInfo", + rtasmInfo = panic "defaultDynFlags: no rtasmInfo", + + maxInlineAllocSize = 128, + maxInlineMemcpyInsns = 32, + maxInlineMemsetInsns = 32, + + initialUnique = 0, + uniqueIncrement = 1, + + reverseErrors = False, + maxErrors = Nothing, + cfgWeights = defaultWeights + } + +type FatalMessager = String -> IO () + +defaultFatalMessager :: FatalMessager +defaultFatalMessager = hPutStrLn stderr + + +newtype FlushOut = FlushOut (IO ()) + +defaultFlushOut :: FlushOut +defaultFlushOut = FlushOut $ hFlush stdout + + + +data OnOff a = On a + | Off a + deriving (Eq, Show) + +instance Outputable a => Outputable (OnOff a) where + ppr (On x) = text "On" <+> ppr x + ppr (Off x) = text "Off" <+> ppr x + +-- OnOffs accumulate in reverse order, so we use foldr in order to +-- process them in the right order +flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension +flattenExtensionFlags ml = foldr g defaultExtensionFlags + where g (On f) flags = EnumSet.insert f flags + g (Off f) flags = EnumSet.delete f flags + defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) + +-- ----------------------------------------------------------------------------- +-- -jN + +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + -- | Use this many processors (@-j@ flag). + = ParMakeThisMany Int + -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). + | ParMakeNumProcessors + -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). + | ParMakeSemaphore FilePath + +-- ----------------------------------------------------------------------------- +-- Linker/compiler information + +-- LinkerInfo contains any extra options needed by the system linker. +data LinkerInfo + = GnuLD [Option] + | Mold [Option] + | GnuGold [Option] + | LlvmLLD [Option] + | DarwinLD [Option] + | SolarisLD [Option] + | AixLD [Option] + | UnknownLD + deriving Eq + +-- CompilerInfo tells us which C compiler we're using +data CompilerInfo + = GCC + | Clang + | AppleClang + | AppleClang51 + | Emscripten + | UnknownCC + deriving Eq + +-- | The 'GhcMode' tells us whether we're doing multi-module +-- compilation (controlled via the "GHC" API) or one-shot +-- (single-module) compilation. This makes a difference primarily to +-- the "GHC.Unit.Finder": in one-shot mode we look for interface files for +-- imported modules, but in multi-module mode we look for source files +-- in order to check whether they need to be recompiled. +data GhcMode + = CompManager -- ^ @\-\-make@, GHCi, etc. + | OneShot -- ^ @ghc -c Foo.hs@ + | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this + deriving Eq + +instance Outputable GhcMode where + ppr CompManager = text "CompManager" + ppr OneShot = text "OneShot" + ppr MkDepend = text "MkDepend" + +isOneShot :: GhcMode -> Bool +isOneShot OneShot = True +isOneShot _other = False + +-- | What to do in the link step, if there is one. +data GhcLink + = NoLink -- ^ Don't link at all + | LinkBinary -- ^ Link object code into a binary + | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both + -- bytecode and object code). + | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) + | LinkStaticLib -- ^ Link objects into a static lib + | LinkMergedObj -- ^ Link objects into a merged "GHCi object" + deriving (Eq, Show) + +isNoLink :: GhcLink -> Bool +isNoLink NoLink = True +isNoLink _ = False + +-- | We accept flags which make packages visible, but how they select +-- the package varies; this data type reflects what selection criterion +-- is used. +data PackageArg = + PackageArg String -- ^ @-package@, by 'PackageName' + | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' + deriving (Eq, Show) + +instance Outputable PackageArg where + ppr (PackageArg pn) = text "package" <+> text pn + ppr (UnitIdArg uid) = text "unit" <+> ppr uid + +-- | Represents the renaming that may be associated with an exposed +-- package, e.g. the @rns@ part of @-package "foo (rns)"@. +-- +-- Here are some example parsings of the package flags (where +-- a string literal is punned to be a 'ModuleName': +-- +-- * @-package foo@ is @ModRenaming True []@ +-- * @-package foo ()@ is @ModRenaming False []@ +-- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ +-- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ +-- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ +data ModRenaming = ModRenaming { + modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? + modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope + -- under name @n at . + } deriving (Eq) +instance Outputable ModRenaming where + ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) + +-- | Flags for manipulating the set of non-broken packages. +newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ + deriving (Eq) + +-- | Flags for manipulating package trust. +data TrustFlag + = TrustPackage String -- ^ @-trust@ + | DistrustPackage String -- ^ @-distrust@ + deriving (Eq) + +-- | Flags for manipulating packages visibility. +data PackageFlag + = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ + | HidePackage String -- ^ @-hide-package@ + deriving (Eq) -- NB: equality instance is used by packageFlagsChanged + +data PackageDBFlag + = PackageDB PkgDbRef + | NoUserPackageDB + | NoGlobalPackageDB + | ClearPackageDBs + deriving (Eq) + +packageFlagsChanged :: DynFlags -> DynFlags -> Bool +packageFlagsChanged idflags1 idflags0 = + packageFlags idflags1 /= packageFlags idflags0 || + ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || + pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || + trustFlags idflags1 /= trustFlags idflags0 || + packageDBFlags idflags1 /= packageDBFlags idflags0 || + packageGFlags idflags1 /= packageGFlags idflags0 + where + packageGFlags dflags = map (`gopt` dflags) + [ Opt_HideAllPackages + , Opt_HideAllPluginPackages + , Opt_AutoLinkPackages ] + +instance Outputable PackageFlag where + ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) + ppr (HidePackage str) = text "-hide-package" <+> text str + +data DynLibLoader + = Deployable + | SystemDependent + deriving Eq + +data RtsOptsEnabled + = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly + | RtsOptsAll + deriving (Show) + +-- | Are we building with @-fPIE@ or @-fPIC@ enabled? +positionIndependent :: DynFlags -> Bool +positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags + +-- Note [-dynamic-too business] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- With -dynamic-too flag, we try to build both the non-dynamic and dynamic +-- objects in a single run of the compiler: the pipeline is the same down to +-- Core optimisation, then the backend (from Core to object code) is executed +-- twice. +-- +-- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic +-- and dynamic loaded interfaces (#9176). +-- +-- To make matters worse, we automatically enable -dynamic-too when some modules +-- need Template-Haskell and GHC is dynamically linked (cf +-- GHC.Driver.Pipeline.compileOne'). +-- +-- We used to try and fall back from a dynamic-too failure but this feature +-- didn't work as expected (#20446) so it was removed to simplify the +-- implementation and not obscure latent bugs. + +data DynamicTooState + = DT_Dont -- ^ Don't try to build dynamic objects too + | DT_OK -- ^ Will still try to generate dynamic objects + | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) + deriving (Eq,Show,Ord) + +dynamicTooState :: DynFlags -> DynamicTooState +dynamicTooState dflags + | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont + | dynamicNow dflags = DT_Dyn + | otherwise = DT_OK + +setDynamicNow :: DynFlags -> DynFlags +setDynamicNow dflags0 = + dflags0 + { dynamicNow = True + } + +data PkgDbRef + = GlobalPkgDb + | UserPkgDb + | PkgDbPath FilePath + deriving Eq + +-- | Used to differentiate the scope an include needs to apply to. +-- We have to split the include paths to avoid accidentally forcing recursive +-- includes since -I overrides the system search paths. See #14312. +data IncludeSpecs + = IncludeSpecs { includePathsQuote :: [String] + , includePathsGlobal :: [String] + -- | See Note [Implicit include paths] + , includePathsQuoteImplicit :: [String] + } + deriving Show + +-- | Append to the list of includes a path that shall be included using `-I` +-- when the C compiler is called. These paths override system search paths. +addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addGlobalInclude spec paths = let f = includePathsGlobal spec + in spec { includePathsGlobal = f ++ paths } + +-- | Append to the list of includes a path that shall be included using +-- `-iquote` when the C compiler is called. These paths only apply when quoted +-- includes are used. e.g. #include "foo.h" +addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addQuoteInclude spec paths = let f = includePathsQuote spec + in spec { includePathsQuote = f ++ paths } + +-- | These includes are not considered while fingerprinting the flags for iface +-- | See Note [Implicit include paths] +addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec + in spec { includePathsQuoteImplicit = f ++ paths } + + +-- | Concatenate and flatten the list of global and quoted includes returning +-- just a flat list of paths. +flattenIncludes :: IncludeSpecs -> [String] +flattenIncludes specs = + includePathsQuote specs ++ + includePathsQuoteImplicit specs ++ + includePathsGlobal specs + +{- Note [Implicit include paths] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The compile driver adds the path to the folder containing the source file being + compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' + that are used later to compute the interface file. Because of this, + the flags fingerprint derived from these 'DynFlags' and recorded in the + interface file will end up containing the absolute path to the source folder. + + Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) + store the build artifacts produced by a build BA for reuse in subsequent builds. + + Embedding source paths in interface fingerprints will thwart these attempts and + lead to unnecessary recompilations when the source paths in BA differ from the + source paths in subsequent builds. + -} + +-- | Test whether a 'DumpFlag' is set +dopt :: DumpFlag -> DynFlags -> Bool +dopt = getDumpFlagFrom verbosity dumpFlags + +-- | Set a 'DumpFlag' +dopt_set :: DynFlags -> DumpFlag -> DynFlags +dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } + +-- | Unset a 'DumpFlag' +dopt_unset :: DynFlags -> DumpFlag -> DynFlags +dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } + +-- | Test whether a 'GeneralFlag' is set +-- +-- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) +-- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables +-- Opt_SplitSections. +-- +gopt :: GeneralFlag -> DynFlags -> Bool +gopt Opt_PIC dflags + | dynamicNow dflags = True +gopt Opt_ExternalDynamicRefs dflags + | dynamicNow dflags = True +gopt Opt_SplitSections dflags + | dynamicNow dflags = False +gopt f dflags = f `EnumSet.member` generalFlags dflags + +-- | Set a 'GeneralFlag' +gopt_set :: DynFlags -> GeneralFlag -> DynFlags +gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } + +-- | Unset a 'GeneralFlag' +gopt_unset :: DynFlags -> GeneralFlag -> DynFlags +gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } + +-- | Test whether a 'WarningFlag' is set +wopt :: WarningFlag -> DynFlags -> Bool +wopt f dflags = f `EnumSet.member` warningFlags dflags + +-- | Set a 'WarningFlag' +wopt_set :: DynFlags -> WarningFlag -> DynFlags +wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } + +-- | Unset a 'WarningFlag' +wopt_unset :: DynFlags -> WarningFlag -> DynFlags +wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } + +-- | Test whether a 'WarningFlag' is set as fatal +wopt_fatal :: WarningFlag -> DynFlags -> Bool +wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags + +-- | Mark a 'WarningFlag' as fatal (do not set the flag) +wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_set_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } + +-- | Mark a 'WarningFlag' as not fatal +wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_unset_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } + + +-- | Enable all custom warning categories. +wopt_set_all_custom :: DynFlags -> DynFlags +wopt_set_all_custom dfs + = dfs{ customWarningCategories = completeWarningCategorySet } + +-- | Disable all custom warning categories. +wopt_unset_all_custom :: DynFlags -> DynFlags +wopt_unset_all_custom dfs + = dfs{ customWarningCategories = emptyWarningCategorySet } + +-- | Mark all custom warning categories as fatal (do not set the flags). +wopt_set_all_fatal_custom :: DynFlags -> DynFlags +wopt_set_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = completeWarningCategorySet } + +-- | Mark all custom warning categories as non-fatal. +wopt_unset_all_fatal_custom :: DynFlags -> DynFlags +wopt_unset_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } + +-- | Set a custom 'WarningCategory' +wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } + +-- | Unset a custom 'WarningCategory' +wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as fatal (do not set the flag) +wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as not fatal +wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Are there any custom warning categories enabled? +wopt_any_custom :: DynFlags -> Bool +wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) + + +-- | Test whether a 'LangExt.Extension' is set +xopt :: LangExt.Extension -> DynFlags -> Bool +xopt f dflags = f `EnumSet.member` extensionFlags dflags + +-- | Set a 'LangExt.Extension' +xopt_set :: DynFlags -> LangExt.Extension -> DynFlags +xopt_set dfs f + = let onoffs = On f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Unset a 'LangExt.Extension' +xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags +xopt_unset dfs f + = let onoffs = Off f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Set or unset a 'LangExt.Extension', unless it has been explicitly +-- set or unset before. +xopt_set_unlessExplSpec + :: LangExt.Extension + -> (DynFlags -> LangExt.Extension -> DynFlags) + -> DynFlags -> DynFlags +xopt_set_unlessExplSpec ext setUnset dflags = + let referedExts = stripOnOff <$> extensions dflags + stripOnOff (On x) = x + stripOnOff (Off x) = x + in + if ext `elem` referedExts then dflags else setUnset dflags ext + +xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields +xopt_DuplicateRecordFields dfs + | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields + | otherwise = FieldLabel.NoDuplicateRecordFields + +xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors +xopt_FieldSelectors dfs + | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors + | otherwise = FieldLabel.NoFieldSelectors + +lang_set :: DynFlags -> Maybe Language -> DynFlags +lang_set dflags lang = + dflags { + language = lang, + extensionFlags = flattenExtensionFlags lang (extensions dflags) + } + +defaultFlags :: Settings -> [GeneralFlag] +defaultFlags settings +-- See Note [Updating flag description in the User's Guide] + = [ Opt_AutoLinkPackages, + Opt_DiagnosticsShowCaret, + Opt_EmbedManifest, + Opt_FamAppCache, + Opt_GenManifest, + Opt_GhciHistory, + Opt_GhciSandbox, + Opt_HelpfulErrors, + Opt_KeepHiFiles, + Opt_KeepOFiles, + Opt_OmitYields, + Opt_PrintBindContents, + Opt_ProfCountEntries, + Opt_SharedImplib, + Opt_SimplPreInlining, + Opt_VersionMacros, + Opt_RPath, + Opt_DumpWithWays, + Opt_CompactUnwind, + Opt_ShowErrorContext, + Opt_SuppressStgReps, + Opt_UnoptimizedCoreForInterpreter + ] + + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + + -- Default floating flags (see Note [RHS Floating]) + ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] + + + ++ default_PIC platform + + ++ validHoleFitDefaults + + + where platform = sTargetPlatform settings + +-- | These are the default settings for the display and sorting of valid hole +-- fits in typed-hole error messages. See Note [Valid hole fits include ...] + -- in the "GHC.Tc.Errors.Hole" module. +validHoleFitDefaults :: [GeneralFlag] +validHoleFitDefaults + = [ Opt_ShowTypeAppOfHoleFits + , Opt_ShowTypeOfHoleFits + , Opt_ShowProvOfHoleFits + , Opt_ShowMatchesOfHoleFits + , Opt_ShowValidHoleFits + , Opt_SortValidHoleFits + , Opt_SortBySizeHoleFits + , Opt_ShowHoleConstraints ] + + +-- +-- Note [Documenting optimisation flags] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- If you change the list of flags enabled for particular optimisation levels +-- please remember to update the User's Guide. The relevant file is: +-- +-- docs/users_guide/using-optimisation.rst +-- +-- Make sure to note whether a flag is implied by -O0, -O or -O2. + +optLevelFlags :: [([Int], GeneralFlag)] +-- Default settings of flags, before any command-line overrides +optLevelFlags -- see Note [Documenting optimisation flags] + = [ ([0,1,2], Opt_DoLambdaEtaExpansion) + , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] + , ([0,1,2], Opt_LlvmTBAA) + , ([0,1,2], Opt_ProfManualCcs ) + , ([2], Opt_DictsStrict) + + , ([0], Opt_IgnoreInterfacePragmas) + , ([0], Opt_OmitInterfacePragmas) + + , ([1,2], Opt_CoreConstantFolding) + + , ([1,2], Opt_CallArity) + , ([1,2], Opt_Exitification) + , ([1,2], Opt_CaseMerge) + , ([1,2], Opt_CaseFolding) + , ([1,2], Opt_CmmElimCommonBlocks) + , ([2], Opt_AsmShortcutting) + , ([1,2], Opt_CmmSink) + , ([1,2], Opt_CmmStaticPred) + , ([1,2], Opt_CSE) + , ([1,2], Opt_StgCSE) + , ([2], Opt_StgLiftLams) + , ([1,2], Opt_CmmControlFlow) + + , ([1,2], Opt_EnableRewriteRules) + -- Off for -O0. Otherwise we desugar list literals + -- to 'build' but don't run the simplifier passes that + -- would rewrite them back to cons cells! This seems + -- silly, and matters for the GHCi debugger. + + , ([1,2], Opt_FloatIn) + , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_IgnoreAsserts) + , ([1,2], Opt_Loopification) + , ([1,2], Opt_CfgBlocklayout) -- Experimental + + , ([1,2], Opt_Specialise) + , ([1,2], Opt_CrossModuleSpecialise) + , ([1,2], Opt_InlineGenerics) + , ([1,2], Opt_Strictness) + , ([1,2], Opt_UnboxSmallStrictFields) + , ([1,2], Opt_CprAnal) + , ([1,2], Opt_WorkerWrapper) + , ([1,2], Opt_SolveConstantDicts) + , ([1,2], Opt_NumConstantFolding) + + , ([2], Opt_LiberateCase) + , ([2], Opt_SpecConstr) + , ([2], Opt_FastPAPCalls) +-- , ([2], Opt_RegsGraph) +-- RegsGraph suffers performance regression. See #7679 +-- , ([2], Opt_StaticArgumentTransformation) +-- Static Argument Transformation needs investigation. See #9374 + ] + +type TurnOnFlag = Bool -- True <=> we are turning the flag on + -- False <=> we are turning the flag off +turnOn :: TurnOnFlag; turnOn = True +turnOff :: TurnOnFlag; turnOff = False + +default_PIC :: Platform -> [GeneralFlag] +default_PIC platform = + case (platformOS platform, platformArch platform) of + -- Darwin always requires PIC. Especially on more recent macOS releases + -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses + -- while we could work around this on x86_64 (like WINE does), we won't be + -- able on aarch64, where this is enforced. + (OSDarwin, ArchX86_64) -> [Opt_PIC] + -- For AArch64, we need to always have PIC enabled. The relocation model + -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't + -- control much how far apart symbols are in memory for our in-memory static + -- linker; and thus need to ensure we get sufficiently capable relocations. + -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top + -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to + -- be built with -fPIC. + (OSDarwin, ArchAArch64) -> [Opt_PIC] + (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in + -- OpenBSD since 5.3 release + -- (1 May 2013) we need to + -- always generate PIC. See + -- #10597 for more + -- information. + _ -> [] + +-- | The language extensions implied by the various language variants. +-- When updating this be sure to update the flag documentation in +-- @docs/users_guide/exts at . +languageExtensions :: Maybe Language -> [LangExt.Extension] + +-- Nothing: the default case +languageExtensions Nothing = languageExtensions (Just GHC2021) + +languageExtensions (Just Haskell98) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.NPlusKPatterns, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.FieldSelectors, + LangExt.NondecreasingIndentation, + -- strictly speaking non-standard, but we always had this + -- on implicitly before the option was added in 7.1, and + -- turning it off breaks code, so we're keeping it on for + -- backwards compatibility. Cabal uses -XHaskell98 by + -- default unless you specify another language. + LangExt.DeepSubsumption + -- Non-standard but enabled for backwards compatability (see GHC proposal #511) + ] + +languageExtensions (Just Haskell2010) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + LangExt.DeepSubsumption ] + +languageExtensions (Just GHC2021) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.MonomorphismRestriction, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + -- Now the new extensions (not in Haskell2010) + LangExt.BangPatterns, + LangExt.BinaryLiterals, + LangExt.ConstrainedClassMethods, + LangExt.ConstraintKinds, + LangExt.DeriveDataTypeable, + LangExt.DeriveFoldable, + LangExt.DeriveFunctor, + LangExt.DeriveGeneric, + LangExt.DeriveLift, + LangExt.DeriveTraversable, + LangExt.EmptyCase, + LangExt.EmptyDataDeriving, + LangExt.ExistentialQuantification, + LangExt.ExplicitForAll, + LangExt.FlexibleContexts, + LangExt.FlexibleInstances, + LangExt.GADTSyntax, + LangExt.GeneralizedNewtypeDeriving, + LangExt.HexFloatLiterals, + LangExt.ImportQualifiedPost, + LangExt.InstanceSigs, + LangExt.KindSignatures, + LangExt.MultiParamTypeClasses, + LangExt.NamedFieldPuns, + LangExt.NamedWildCards, + LangExt.NumericUnderscores, + LangExt.PolyKinds, + LangExt.PostfixOperators, + LangExt.RankNTypes, + LangExt.ScopedTypeVariables, + LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.StandaloneDeriving, + LangExt.StandaloneKindSignatures, + LangExt.TupleSections, + LangExt.TypeApplications, + LangExt.TypeOperators, + LangExt.TypeSynonymInstances] + + +ways :: DynFlags -> Ways +ways dflags + | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) + | otherwise = targetWays_ dflags +-- +-- System tool settings and locations + +programName :: DynFlags -> String +programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags +projectVersion :: DynFlags -> String +projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) +ghcUsagePath :: DynFlags -> FilePath +ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags +ghciUsagePath :: DynFlags -> FilePath +ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags +topDir :: DynFlags -> FilePath +topDir dflags = fileSettings_topDir $ fileSettings dflags +toolDir :: DynFlags -> Maybe FilePath +toolDir dflags = fileSettings_toolDir $ fileSettings dflags +extraGccViaCFlags :: DynFlags -> [String] +extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags +globalPackageDatabasePath :: DynFlags -> FilePath +globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags + +-- | The directory for this version of ghc in the user's app directory +-- The appdir used to be in ~/.ghc but to respect the XDG specification +-- we want to move it under $XDG_DATA_HOME/ +-- However, old tooling (like cabal) might still write package environments +-- to the old directory, so we prefer that if a subdirectory of ~/.ghc +-- with the correct target and GHC version suffix exists. +-- +-- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that +-- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR +-- +-- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version +versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath +versionedAppDir appname platform = do + -- Make sure we handle the case the HOME isn't set (see #11678) + -- We need to fallback to the old scheme if the subdirectory exists. + msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) + [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ + , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ + ] + where + checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case + True -> pure dir + False -> MaybeT (pure Nothing) + +versionedFilePath :: ArchOS -> FilePath +versionedFilePath platform = uniqueSubdir platform + +-- SDoc +------------------------------------------- + +-- | Initialize the pretty-printing options +initSDocContext :: DynFlags -> PprStyle -> SDocContext +initSDocContext dflags style = SDC + { sdocStyle = style + , sdocColScheme = colScheme dflags + , sdocLastColour = Col.colReset + , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) + , sdocDefaultDepth = pprUserLength dflags + , sdocLineLength = pprCols dflags + , sdocCanUseUnicode = useUnicode dflags + , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags + , sdocPprDebug = dopt Opt_D_ppr_debug dflags + , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags + , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags + , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags + , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags + , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags + , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags + , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags + , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags + , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags + , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags + , sdocSuppressTicks = gopt Opt_SuppressTicks dflags + , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags + , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags + , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags + , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags + , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags + , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags + , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags + , sdocSuppressUniques = gopt Opt_SuppressUniques dflags + , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags + , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags + , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags + , sdocErrorSpans = gopt Opt_ErrorSpans dflags + , sdocStarIsType = xopt LangExt.StarIsType dflags + , sdocLinearTypes = xopt LangExt.LinearTypes dflags + , sdocListTuplePuns = True + , sdocPrintTypeAbbreviations = True + , sdocUnitIdForUser = ftext + } + +-- | Initialize the pretty-printing options using the default user style +initDefaultSDocContext :: DynFlags -> SDocContext +initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle + +initPromotionTickContext :: DynFlags -> PromotionTickContext +initPromotionTickContext dflags = + PromTickCtx { + ptcListTuplePuns = True, + ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags + } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -41,7 +41,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Errors ( printOrThrowDiagnostics ) import GHC.Driver.Errors.Types ( GhcMessage ) import GHC.Driver.Config.Logger (initLogFlags) ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -7,7 +7,7 @@ module GHC.Driver.Env.Types import GHC.Driver.Errors.Types ( GhcMessage ) import {-# SOURCE #-} GHC.Driver.Hooks -import GHC.Driver.Session ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) +import GHC.Driver.DynFlags ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Prelude ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Prelude import GHC.Driver.Errors.Types import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () import GHC.Types.Error ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Prelude import Data.Bifunctor import Data.Typeable -import GHC.Driver.Session (DynFlags, PackageArg, gopt) +import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt) import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage)) import GHC.Types.Error import GHC.Unit.Module @@ -384,4 +384,4 @@ checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage checkBuildingCabalPackage dflags = if gopt Opt_BuildingCabalPackage dflags then YesBuildingCabalPackage - else NoBuildingCabalPackage \ No newline at end of file + else NoBuildingCabalPackage ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -32,7 +32,7 @@ where import GHC.Prelude import GHC.Driver.Env -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Pipeline.Phases import GHC.Hs.Decls ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -11,7 +11,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.State import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -230,53 +230,44 @@ import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile -import GHC.UniqueSubdir (uniqueSubdir) import GHC.Unit.Types import GHC.Unit.Parser import GHC.Unit.Module import GHC.Unit.Module.Warnings -import GHC.Builtin.Names ( mAIN_NAME ) -import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.DynFlags +import GHC.Driver.Config.Diagnostic import GHC.Driver.Flags import GHC.Driver.Backend +import GHC.Driver.Errors.Types import GHC.Driver.Plugins.External import GHC.Settings.Config -import GHC.Utils.CliOption import GHC.Core.Unfold import GHC.Driver.CmdLine -import GHC.Settings.Constants import GHC.Utils.Panic -import qualified GHC.Utils.Ppr.Colour as Col import GHC.Utils.Misc import GHC.Utils.Constants (debugIsOn) import GHC.Utils.GlobalVars import GHC.Data.Maybe import GHC.Data.Bool +import GHC.Types.Error +import GHC.Utils.Error import GHC.Utils.Monad -import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.SrcLoc import GHC.Types.SafeHaskell -import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) -import GHC.Types.ProfAuto -import qualified GHC.Types.FieldLabel as FieldLabel +import GHC.Types.Basic ( treatZeroAsInf ) import GHC.Data.FastString import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable import GHC.Settings import GHC.CmmToAsm.CFG.Weight -import {-# SOURCE #-} GHC.Core.Opt.CallerCC +import GHC.Core.Opt.CallerCC -import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) import Data.IORef import Control.Arrow ((&&&)) import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.Writer -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Except import Control.Monad.Trans.State as State import Data.Functor.Identity @@ -287,17 +278,11 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set import System.FilePath -import System.Directory -import System.Environment (lookupEnv) -import System.IO -import System.IO.Error import Text.ParserCombinators.ReadP hiding (char) import Text.ParserCombinators.ReadP as R -import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet -import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -- Note [Updating flag description in the User's Guide] @@ -376,388 +361,6 @@ import qualified GHC.LanguageExtensions as LangExt -- ----------------------------------------------------------------------------- -- DynFlags --- | Used to differentiate the scope an include needs to apply to. --- We have to split the include paths to avoid accidentally forcing recursive --- includes since -I overrides the system search paths. See #14312. -data IncludeSpecs - = IncludeSpecs { includePathsQuote :: [String] - , includePathsGlobal :: [String] - -- | See Note [Implicit include paths] - , includePathsQuoteImplicit :: [String] - } - deriving Show - --- | Append to the list of includes a path that shall be included using `-I` --- when the C compiler is called. These paths override system search paths. -addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addGlobalInclude spec paths = let f = includePathsGlobal spec - in spec { includePathsGlobal = f ++ paths } - --- | Append to the list of includes a path that shall be included using --- `-iquote` when the C compiler is called. These paths only apply when quoted --- includes are used. e.g. #include "foo.h" -addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addQuoteInclude spec paths = let f = includePathsQuote spec - in spec { includePathsQuote = f ++ paths } - --- | These includes are not considered while fingerprinting the flags for iface --- | See Note [Implicit include paths] -addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec - in spec { includePathsQuoteImplicit = f ++ paths } - - --- | Concatenate and flatten the list of global and quoted includes returning --- just a flat list of paths. -flattenIncludes :: IncludeSpecs -> [String] -flattenIncludes specs = - includePathsQuote specs ++ - includePathsQuoteImplicit specs ++ - includePathsGlobal specs - -{- Note [Implicit include paths] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - The compile driver adds the path to the folder containing the source file being - compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' - that are used later to compute the interface file. Because of this, - the flags fingerprint derived from these 'DynFlags' and recorded in the - interface file will end up containing the absolute path to the source folder. - - Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) - store the build artifacts produced by a build BA for reuse in subsequent builds. - - Embedding source paths in interface fingerprints will thwart these attempts and - lead to unnecessary recompilations when the source paths in BA differ from the - source paths in subsequent builds. - -} - - --- | Contains not only a collection of 'GeneralFlag's but also a plethora of --- information relating to the compilation of a single file or GHC session -data DynFlags = DynFlags { - ghcMode :: GhcMode, - ghcLink :: GhcLink, - backend :: !Backend, - -- ^ The backend to use (if any). - -- - -- Whenever you change the backend, also make sure to set 'ghcLink' to - -- something sensible. - -- - -- 'NoBackend' can be used to avoid generating any output, however, note that: - -- - -- * If a program uses Template Haskell the typechecker may need to run code - -- from an imported module. To facilitate this, code generation is enabled - -- for modules imported by modules that use template haskell, using the - -- default backend for the platform. - -- See Note [-fno-code mode]. - - - -- formerly Settings - ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, - fileSettings :: {-# UNPACK #-} !FileSettings, - targetPlatform :: Platform, -- Filled in by SysTools - toolSettings :: {-# UNPACK #-} !ToolSettings, - platformMisc :: {-# UNPACK #-} !PlatformMisc, - rawSettings :: [(String, String)], - tmpDir :: TempDir, - - llvmOptLevel :: Int, -- ^ LLVM optimisation level - verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] - debugLevel :: Int, -- ^ How much debug information to produce - simplPhases :: Int, -- ^ Number of simplifier phases - maxSimplIterations :: Int, -- ^ Max simplifier iterations - ruleCheck :: Maybe String, - strictnessBefore :: [Int], -- ^ Additional demand analysis - - parMakeCount :: Maybe ParMakeCount, - -- ^ The number of modules to compile in parallel - -- If unspecified, compile with a single job. - - enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? - ghcHeapSize :: Maybe Int, -- ^ The heap size to set. - - maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt - -- to show in type error messages - maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show - -- in typed hole error messages - maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole - -- fits to show in typed hole error - -- messages - refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for - -- refinement hole fits in typed hole - -- error messages - maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show - -- in non-exhaustiveness warnings - maxPmCheckModels :: Int, -- ^ Soft limit on the number of models - -- the pattern match checker checks - -- a pattern against. A safe guard - -- against exponential blow-up. - simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks - dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an - -- Unboxed demand on returned products with at most - -- this number of fields - specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr - specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function - specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types - -- Not optional; otherwise ForceSpecConstr can diverge. - binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above - -- this threshold will be dumped in a binary file - -- by the assembler code generator. 0 and Nothing disables - -- this feature. See 'GHC.StgToCmm.Config'. - liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase - floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating - -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' - - liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- recursive function. - liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- non-recursive function. - liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call - -- into an unknown call. - - cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. - - historySize :: Int, -- ^ Simplification history size - - importPaths :: [FilePath], - mainModuleNameIs :: ModuleName, - mainFunIs :: Maybe String, - reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth - solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver - -- Typically only 1 is needed - givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens - -- Should be < solverIterations - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - homeUnitId_ :: UnitId, -- ^ Target home unit-id - homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate - homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations - - -- Note [Filepaths and Multiple Home Units] - workingDirectory :: Maybe FilePath, - thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units - hiddenModules :: Set.Set ModuleName, - reexportedModules :: Set.Set ModuleName, - - -- ways - targetWays_ :: Ways, -- ^ Target way flags from the command line - - -- For object splitting - splitInfo :: Maybe (String,Int), - - -- paths etc. - objectDir :: Maybe String, - dylibInstallName :: Maybe String, - hiDir :: Maybe String, - hieDir :: Maybe String, - stubDir :: Maybe String, - dumpDir :: Maybe String, - - objectSuf_ :: String, - hcSuf :: String, - hiSuf_ :: String, - hieSuf :: String, - - dynObjectSuf_ :: String, - dynHiSuf_ :: String, - - outputFile_ :: Maybe String, - dynOutputFile_ :: Maybe String, - outputHi :: Maybe String, - dynOutputHi :: Maybe String, - dynLibLoader :: DynLibLoader, - - dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output - -- because of -dynamic-too. This predicate is - -- used to query the appropriate fields - -- (outputFile/dynOutputFile, ways, etc.) - - -- | This defaults to 'non-module'. It can be set by - -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on - -- where its output is going. - dumpPrefix :: FilePath, - - -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' - -- or 'ghc.GHCi.UI.runStmt'. - -- Set by @-ddump-file-prefix@ - dumpPrefixForce :: Maybe FilePath, - - ldInputs :: [Option], - - includePaths :: IncludeSpecs, - libraryPaths :: [String], - frameworkPaths :: [String], -- used on darwin only - cmdlineFrameworks :: [String], -- ditto - - rtsOpts :: Maybe String, - rtsOptsEnabled :: RtsOptsEnabled, - rtsOptsSuggestions :: Bool, - - hpcDir :: String, -- ^ Path to store the .mix files - - -- Plugins - pluginModNames :: [ModuleName], - -- ^ the @-fplugin@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - pluginModNameOpts :: [(ModuleName,String)], - frontendPluginOpts :: [String], - -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - - externalPluginSpecs :: [ExternalPluginSpec], - -- ^ External plugins loaded from shared libraries - - -- For ghc -M - depMakefile :: FilePath, - depIncludePkgDeps :: Bool, - depIncludeCppDeps :: Bool, - depExcludeMods :: [ModuleName], - depSuffixes :: [String], - - -- Package flags - packageDBFlags :: [PackageDBFlag], - -- ^ The @-package-db@ flags given on the command line, In - -- *reverse* order that they're specified on the command line. - -- This is intended to be applied with the list of "initial" - -- package databases derived from @GHC_PACKAGE_PATH@; see - -- 'getUnitDbRefs'. - - ignorePackageFlags :: [IgnorePackageFlag], - -- ^ The @-ignore-package@ flags from the command line. - -- In *reverse* order that they're specified on the command line. - packageFlags :: [PackageFlag], - -- ^ The @-package@ and @-hide-package@ flags from the command-line. - -- In *reverse* order that they're specified on the command line. - pluginPackageFlags :: [PackageFlag], - -- ^ The @-plugin-package-id@ flags from command line. - -- In *reverse* order that they're specified on the command line. - trustFlags :: [TrustFlag], - -- ^ The @-trust@ and @-distrust@ flags. - -- In *reverse* order that they're specified on the command line. - packageEnv :: Maybe FilePath, - -- ^ Filepath to the package environment file (if overriding default) - - - -- hsc dynamic flags - dumpFlags :: EnumSet DumpFlag, - generalFlags :: EnumSet GeneralFlag, - warningFlags :: EnumSet WarningFlag, - fatalWarningFlags :: EnumSet WarningFlag, - customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] - fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings - -- Don't change this without updating extensionFlags: - language :: Maybe Language, - -- | Safe Haskell mode - safeHaskell :: SafeHaskellMode, - safeInfer :: Bool, - safeInferred :: Bool, - -- We store the location of where some extension and flags were turned on so - -- we can produce accurate error messages when Safe Haskell fails due to - -- them. - thOnLoc :: SrcSpan, - newDerivOnLoc :: SrcSpan, - deriveViaOnLoc :: SrcSpan, - overlapInstLoc :: SrcSpan, - incoherentOnLoc :: SrcSpan, - pkgTrustOnLoc :: SrcSpan, - warnSafeOnLoc :: SrcSpan, - warnUnsafeOnLoc :: SrcSpan, - trustworthyOnLoc :: SrcSpan, - -- Don't change this without updating extensionFlags: - -- Here we collect the settings of the language extensions - -- from the command line, the ghci config file and - -- from interactive :set / :seti commands. - extensions :: [OnOff LangExt.Extension], - -- extensionFlags should always be equal to - -- flattenExtensionFlags language extensions - -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used - -- by template-haskell - extensionFlags :: EnumSet LangExt.Extension, - - -- | Unfolding control - -- See Note [Discounts and thresholds] in GHC.Core.Unfold - unfoldingOpts :: !UnfoldingOpts, - - maxWorkerArgs :: Int, - - ghciHistSize :: Int, - - flushOut :: FlushOut, - - ghcVersionFile :: Maybe FilePath, - haddockOptions :: Maybe String, - - -- | GHCi scripts specified by -ghci-script, in reverse order - ghciScripts :: [String], - - -- Output style options - pprUserLength :: Int, - pprCols :: Int, - - useUnicode :: Bool, - useColor :: OverridingBool, - canUseColor :: Bool, - colScheme :: Col.Scheme, - - -- | what kind of {-# SCC #-} to add automatically - profAuto :: ProfAuto, - callerCcFilters :: [CallerCcFilter], - - interactivePrint :: Maybe String, - - -- | Machine dependent flags (-m\ stuff) - sseVersion :: Maybe SseVersion, - bmiVersion :: Maybe BmiVersion, - avx :: Bool, - avx2 :: Bool, - avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. - avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. - avx512f :: Bool, -- Enable AVX-512 instructions. - avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. - fma :: Bool, -- ^ Enable FMA instructions. - - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - - -- Constants used to control the amount of optimization done. - - -- | Max size, in bytes, of inline array allocations. - maxInlineAllocSize :: Int, - - -- | Only inline memcpy if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemcpyInsns :: Int, - - -- | Only inline memset if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemsetInsns :: Int, - - -- | Reverse the order of error messages in GHC/GHCi - reverseErrors :: Bool, - - -- | Limit the maximum number of errors to show - maxErrors :: Maybe Int, - - -- | Unique supply configuration for testing build determinism - initialUnique :: Word, - uniqueIncrement :: Int, - -- 'Int' because it can be used to test uniques in decreasing order. - - -- | Temporary: CFG Edge weights for fast iterations - cfgWeights :: Weights -} - {- Note [RHS Floating] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We provide both 'Opt_LocalFloatOut' and 'Opt_LocalFloatOutTopLevel' to correspond to @@ -767,43 +370,6 @@ data DynFlags = DynFlags { allows for experimentation. -} -class HasDynFlags m where - getDynFlags :: m DynFlags - -{- It would be desirable to have the more generalised - - instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where - getDynFlags = lift getDynFlags - -instance definition. However, that definition would overlap with the -`HasDynFlags (GhcT m)` instance. Instead we define instances for a -couple of common Monad transformers explicitly. -} - -instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where - getDynFlags = lift getDynFlags - -class ContainsDynFlags t where - extractDynFlags :: t -> DynFlags - --- | The type for the -jN argument, specifying that -j on its own represents --- using the number of machine processors. -data ParMakeCount - -- | Use this many processors (@-j@ flag). - = ParMakeThisMany Int - -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). - | ParMakeNumProcessors - -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). - | ParMakeSemaphore FilePath - ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -820,22 +386,6 @@ settings dflags = Settings , sRawSettings = rawSettings dflags } -programName :: DynFlags -> String -programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags -projectVersion :: DynFlags -> String -projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) -ghcUsagePath :: DynFlags -> FilePath -ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags -ghciUsagePath :: DynFlags -> FilePath -ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags -toolDir :: DynFlags -> Maybe FilePath -toolDir dflags = fileSettings_toolDir $ fileSettings dflags -topDir :: DynFlags -> FilePath -topDir dflags = fileSettings_topDir $ fileSettings dflags -extraGccViaCFlags :: DynFlags -> [String] -extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags -globalPackageDatabasePath :: DynFlags -> FilePath -globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags pgm_L :: DynFlags -> String pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags pgm_P :: DynFlags -> (String,[Option]) @@ -909,430 +459,8 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags opt_i :: DynFlags -> [String] opt_i dflags= toolSettings_opt_i $ toolSettings dflags --- | The directory for this version of ghc in the user's app directory --- The appdir used to be in ~/.ghc but to respect the XDG specification --- we want to move it under $XDG_DATA_HOME/ --- However, old tooling (like cabal) might still write package environments --- to the old directory, so we prefer that if a subdirectory of ~/.ghc --- with the correct target and GHC version suffix exists. --- --- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that --- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR --- --- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version -versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath -versionedAppDir appname platform = do - -- Make sure we handle the case the HOME isn't set (see #11678) - -- We need to fallback to the old scheme if the subdirectory exists. - msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) - [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ - , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ - ] - where - checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case - True -> pure dir - False -> MaybeT (pure Nothing) - -versionedFilePath :: ArchOS -> FilePath -versionedFilePath platform = uniqueSubdir platform - --- | The 'GhcMode' tells us whether we're doing multi-module --- compilation (controlled via the "GHC" API) or one-shot --- (single-module) compilation. This makes a difference primarily to --- the "GHC.Unit.Finder": in one-shot mode we look for interface files for --- imported modules, but in multi-module mode we look for source files --- in order to check whether they need to be recompiled. -data GhcMode - = CompManager -- ^ @\-\-make@, GHCi, etc. - | OneShot -- ^ @ghc -c Foo.hs@ - | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this - deriving Eq - -instance Outputable GhcMode where - ppr CompManager = text "CompManager" - ppr OneShot = text "OneShot" - ppr MkDepend = text "MkDepend" - -isOneShot :: GhcMode -> Bool -isOneShot OneShot = True -isOneShot _other = False - --- | What to do in the link step, if there is one. -data GhcLink - = NoLink -- ^ Don't link at all - | LinkBinary -- ^ Link object code into a binary - | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both - -- bytecode and object code). - | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) - | LinkStaticLib -- ^ Link objects into a static lib - | LinkMergedObj -- ^ Link objects into a merged "GHCi object" - deriving (Eq, Show) - -isNoLink :: GhcLink -> Bool -isNoLink NoLink = True -isNoLink _ = False - --- | We accept flags which make packages visible, but how they select --- the package varies; this data type reflects what selection criterion --- is used. -data PackageArg = - PackageArg String -- ^ @-package@, by 'PackageName' - | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' - deriving (Eq, Show) - -instance Outputable PackageArg where - ppr (PackageArg pn) = text "package" <+> text pn - ppr (UnitIdArg uid) = text "unit" <+> ppr uid - --- | Represents the renaming that may be associated with an exposed --- package, e.g. the @rns@ part of @-package "foo (rns)"@. --- --- Here are some example parsings of the package flags (where --- a string literal is punned to be a 'ModuleName': --- --- * @-package foo@ is @ModRenaming True []@ --- * @-package foo ()@ is @ModRenaming False []@ --- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ --- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ --- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ -data ModRenaming = ModRenaming { - modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? - modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope - -- under name @n at . - } deriving (Eq) -instance Outputable ModRenaming where - ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) - --- | Flags for manipulating the set of non-broken packages. -newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ - deriving (Eq) - --- | Flags for manipulating package trust. -data TrustFlag - = TrustPackage String -- ^ @-trust@ - | DistrustPackage String -- ^ @-distrust@ - deriving (Eq) - --- | Flags for manipulating packages visibility. -data PackageFlag - = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ - | HidePackage String -- ^ @-hide-package@ - deriving (Eq) -- NB: equality instance is used by packageFlagsChanged - -data PackageDBFlag - = PackageDB PkgDbRef - | NoUserPackageDB - | NoGlobalPackageDB - | ClearPackageDBs - deriving (Eq) - -packageFlagsChanged :: DynFlags -> DynFlags -> Bool -packageFlagsChanged idflags1 idflags0 = - packageFlags idflags1 /= packageFlags idflags0 || - ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || - pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || - trustFlags idflags1 /= trustFlags idflags0 || - packageDBFlags idflags1 /= packageDBFlags idflags0 || - packageGFlags idflags1 /= packageGFlags idflags0 - where - packageGFlags dflags = map (`gopt` dflags) - [ Opt_HideAllPackages - , Opt_HideAllPluginPackages - , Opt_AutoLinkPackages ] - -instance Outputable PackageFlag where - ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) - ppr (HidePackage str) = text "-hide-package" <+> text str - -data DynLibLoader - = Deployable - | SystemDependent - deriving Eq - -data RtsOptsEnabled - = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly - | RtsOptsAll - deriving (Show) - --- | Are we building with @-fPIE@ or @-fPIC@ enabled? -positionIndependent :: DynFlags -> Bool -positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags - --- Note [-dynamic-too business] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- With -dynamic-too flag, we try to build both the non-dynamic and dynamic --- objects in a single run of the compiler: the pipeline is the same down to --- Core optimisation, then the backend (from Core to object code) is executed --- twice. --- --- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic --- and dynamic loaded interfaces (#9176). --- --- To make matters worse, we automatically enable -dynamic-too when some modules --- need Template-Haskell and GHC is dynamically linked (cf --- GHC.Driver.Pipeline.compileOne'). --- --- We used to try and fall back from a dynamic-too failure but this feature --- didn't work as expected (#20446) so it was removed to simplify the --- implementation and not obscure latent bugs. - -data DynamicTooState - = DT_Dont -- ^ Don't try to build dynamic objects too - | DT_OK -- ^ Will still try to generate dynamic objects - | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) - deriving (Eq,Show,Ord) - -dynamicTooState :: DynFlags -> DynamicTooState -dynamicTooState dflags - | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont - | dynamicNow dflags = DT_Dyn - | otherwise = DT_OK - -setDynamicNow :: DynFlags -> DynFlags -setDynamicNow dflags0 = - dflags0 - { dynamicNow = True - } - ----------------------------------------------------------------------------- --- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value -initDynFlags :: DynFlags -> IO DynFlags -initDynFlags dflags = do - let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing - canUseUnicode <- do let enc = localeEncoding - str = "‘’" - (withCString enc str $ \cstr -> - do str' <- peekCString enc cstr - return (str == str')) - `catchIOError` \_ -> return False - ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" - let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode - maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" - maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" - let adjustCols (Just env) = Col.parseScheme env - adjustCols Nothing = id - let (useColor', colScheme') = - (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) - (useColor dflags, colScheme dflags) - tmp_dir <- normalise <$> getTemporaryDirectory - return dflags{ - useUnicode = useUnicode', - useColor = useColor', - canUseColor = stderrSupportsAnsiColors, - colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, - tmpDir = TempDir tmp_dir - } - --- | The normal 'DynFlags'. Note that they are not suitable for use in this form --- and must be fully initialized by 'GHC.runGhc' first. -defaultDynFlags :: Settings -> DynFlags -defaultDynFlags mySettings = --- See Note [Updating flag description in the User's Guide] - DynFlags { - ghcMode = CompManager, - ghcLink = LinkBinary, - backend = platformDefaultBackend (sTargetPlatform mySettings), - verbosity = 0, - debugLevel = 0, - simplPhases = 2, - maxSimplIterations = 4, - ruleCheck = Nothing, - binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) - maxRelevantBinds = Just 6, - maxValidHoleFits = Just 6, - maxRefHoleFits = Just 6, - refLevelHoleFits = Nothing, - maxUncoveredPatterns = 4, - maxPmCheckModels = 30, - simplTickFactor = 100, - dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple - specConstrThreshold = Just 2000, - specConstrCount = Just 3, - specConstrRecursive = 3, - liberateCaseThreshold = Just 2000, - floatLamArgs = Just 0, -- Default: float only if no fvs - liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsKnown = False, -- Default: don't turn known calls into unknown ones - cmmProcAlignment = Nothing, - - historySize = 20, - strictnessBefore = [], - - parMakeCount = Nothing, - - enableTimeStats = False, - ghcHeapSize = Nothing, - - importPaths = ["."], - mainModuleNameIs = mAIN_NAME, - mainFunIs = Nothing, - reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, - solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, - givensFuel = mAX_GIVENS_FUEL, - wantedsFuel = mAX_WANTEDS_FUEL, - qcsFuel = mAX_QC_FUEL, - - homeUnitId_ = mainUnitId, - homeUnitInstanceOf_ = Nothing, - homeUnitInstantiations_ = [], - - workingDirectory = Nothing, - thisPackageName = Nothing, - hiddenModules = Set.empty, - reexportedModules = Set.empty, - - objectDir = Nothing, - dylibInstallName = Nothing, - hiDir = Nothing, - hieDir = Nothing, - stubDir = Nothing, - dumpDir = Nothing, - - objectSuf_ = phaseInputExt StopLn, - hcSuf = phaseInputExt HCc, - hiSuf_ = "hi", - hieSuf = "hie", - - dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, - dynHiSuf_ = "dyn_hi", - dynamicNow = False, - - pluginModNames = [], - pluginModNameOpts = [], - frontendPluginOpts = [], - - externalPluginSpecs = [], - - outputFile_ = Nothing, - dynOutputFile_ = Nothing, - outputHi = Nothing, - dynOutputHi = Nothing, - dynLibLoader = SystemDependent, - dumpPrefix = "non-module.", - dumpPrefixForce = Nothing, - ldInputs = [], - includePaths = IncludeSpecs [] [] [], - libraryPaths = [], - frameworkPaths = [], - cmdlineFrameworks = [], - rtsOpts = Nothing, - rtsOptsEnabled = RtsOptsSafeOnly, - rtsOptsSuggestions = True, - - hpcDir = ".hpc", - - packageDBFlags = [], - packageFlags = [], - pluginPackageFlags = [], - ignorePackageFlags = [], - trustFlags = [], - packageEnv = Nothing, - targetWays_ = Set.empty, - splitInfo = Nothing, - - ghcNameVersion = sGhcNameVersion mySettings, - fileSettings = sFileSettings mySettings, - toolSettings = sToolSettings mySettings, - targetPlatform = sTargetPlatform mySettings, - platformMisc = sPlatformMisc mySettings, - rawSettings = sRawSettings mySettings, - - tmpDir = panic "defaultDynFlags: uninitialized tmpDir", - - llvmOptLevel = 0, - - -- ghc -M values - depMakefile = "Makefile", - depIncludePkgDeps = False, - depIncludeCppDeps = False, - depExcludeMods = [], - depSuffixes = [], - -- end of ghc -M values - ghcVersionFile = Nothing, - haddockOptions = Nothing, - dumpFlags = EnumSet.empty, - generalFlags = EnumSet.fromList (defaultFlags mySettings), - warningFlags = EnumSet.fromList standardWarnings, - fatalWarningFlags = EnumSet.empty, - customWarningCategories = completeWarningCategorySet, - fatalCustomWarningCategories = emptyWarningCategorySet, - ghciScripts = [], - language = Nothing, - safeHaskell = Sf_None, - safeInfer = True, - safeInferred = True, - thOnLoc = noSrcSpan, - newDerivOnLoc = noSrcSpan, - deriveViaOnLoc = noSrcSpan, - overlapInstLoc = noSrcSpan, - incoherentOnLoc = noSrcSpan, - pkgTrustOnLoc = noSrcSpan, - warnSafeOnLoc = noSrcSpan, - warnUnsafeOnLoc = noSrcSpan, - trustworthyOnLoc = noSrcSpan, - extensions = [], - extensionFlags = flattenExtensionFlags Nothing [], - - unfoldingOpts = defaultUnfoldingOpts, - maxWorkerArgs = 10, - - ghciHistSize = 50, -- keep a log of length 50 by default - - flushOut = defaultFlushOut, - pprUserLength = 5, - pprCols = 100, - useUnicode = False, - useColor = Auto, - canUseColor = False, - colScheme = Col.defaultScheme, - profAuto = NoProfAuto, - callerCcFilters = [], - interactivePrint = Nothing, - sseVersion = Nothing, - bmiVersion = Nothing, - avx = False, - avx2 = False, - avx512cd = False, - avx512er = False, - avx512f = False, - avx512pf = False, - fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", - - maxInlineAllocSize = 128, - maxInlineMemcpyInsns = 32, - maxInlineMemsetInsns = 32, - - initialUnique = 0, - uniqueIncrement = 1, - - reverseErrors = False, - maxErrors = Nothing, - cfgWeights = defaultWeights - } - -type FatalMessager = String -> IO () - -defaultFatalMessager :: FatalMessager -defaultFatalMessager = hPutStrLn stderr - - -newtype FlushOut = FlushOut (IO ()) - -defaultFlushOut :: FlushOut -defaultFlushOut = FlushOut $ hFlush stdout - {- Note [Verbosity levels] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -1344,117 +472,6 @@ Note [Verbosity levels] 5 | "ghc -v -ddump-all" -} -data OnOff a = On a - | Off a - deriving (Eq, Show) - -instance Outputable a => Outputable (OnOff a) where - ppr (On x) = text "On" <+> ppr x - ppr (Off x) = text "Off" <+> ppr x - --- OnOffs accumulate in reverse order, so we use foldr in order to --- process them in the right order -flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension -flattenExtensionFlags ml = foldr f defaultExtensionFlags - where f (On f) flags = EnumSet.insert f flags - f (Off f) flags = EnumSet.delete f flags - defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) - --- | The language extensions implied by the various language variants. --- When updating this be sure to update the flag documentation in --- @docs/users_guide/exts at . -languageExtensions :: Maybe Language -> [LangExt.Extension] - --- Nothing: the default case -languageExtensions Nothing = languageExtensions (Just GHC2021) - -languageExtensions (Just Haskell98) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.NPlusKPatterns, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.FieldSelectors, - LangExt.NondecreasingIndentation, - -- strictly speaking non-standard, but we always had this - -- on implicitly before the option was added in 7.1, and - -- turning it off breaks code, so we're keeping it on for - -- backwards compatibility. Cabal uses -XHaskell98 by - -- default unless you specify another language. - LangExt.DeepSubsumption - -- Non-standard but enabled for backwards compatability (see GHC proposal #511) - ] - -languageExtensions (Just Haskell2010) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - LangExt.DeepSubsumption ] - -languageExtensions (Just GHC2021) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.MonomorphismRestriction, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - -- Now the new extensions (not in Haskell2010) - LangExt.BangPatterns, - LangExt.BinaryLiterals, - LangExt.ConstrainedClassMethods, - LangExt.ConstraintKinds, - LangExt.DeriveDataTypeable, - LangExt.DeriveFoldable, - LangExt.DeriveFunctor, - LangExt.DeriveGeneric, - LangExt.DeriveLift, - LangExt.DeriveTraversable, - LangExt.EmptyCase, - LangExt.EmptyDataDeriving, - LangExt.ExistentialQuantification, - LangExt.ExplicitForAll, - LangExt.FlexibleContexts, - LangExt.FlexibleInstances, - LangExt.GADTSyntax, - LangExt.GeneralizedNewtypeDeriving, - LangExt.HexFloatLiterals, - LangExt.ImportQualifiedPost, - LangExt.InstanceSigs, - LangExt.KindSignatures, - LangExt.MultiParamTypeClasses, - LangExt.NamedFieldPuns, - LangExt.NamedWildCards, - LangExt.NumericUnderscores, - LangExt.PolyKinds, - LangExt.PostfixOperators, - LangExt.RankNTypes, - LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" - LangExt.StandaloneDeriving, - LangExt.StandaloneKindSignatures, - LangExt.TupleSections, - LangExt.TypeApplications, - LangExt.TypeOperators, - LangExt.TypeSynonymInstances] - hasPprDebug :: DynFlags -> Bool hasPprDebug = dopt Opt_D_ppr_debug @@ -1467,160 +484,6 @@ hasNoStateHack = gopt Opt_G_NoStateHack hasNoOptCoercion :: DynFlags -> Bool hasNoOptCoercion = gopt Opt_G_NoOptCoercion - --- | Test whether a 'DumpFlag' is set -dopt :: DumpFlag -> DynFlags -> Bool -dopt = getDumpFlagFrom verbosity dumpFlags - --- | Set a 'DumpFlag' -dopt_set :: DynFlags -> DumpFlag -> DynFlags -dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } - --- | Unset a 'DumpFlag' -dopt_unset :: DynFlags -> DumpFlag -> DynFlags -dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } - --- | Test whether a 'GeneralFlag' is set --- --- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) --- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables --- Opt_SplitSections. --- -gopt :: GeneralFlag -> DynFlags -> Bool -gopt Opt_PIC dflags - | dynamicNow dflags = True -gopt Opt_ExternalDynamicRefs dflags - | dynamicNow dflags = True -gopt Opt_SplitSections dflags - | dynamicNow dflags = False -gopt f dflags = f `EnumSet.member` generalFlags dflags - --- | Set a 'GeneralFlag' -gopt_set :: DynFlags -> GeneralFlag -> DynFlags -gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } - --- | Unset a 'GeneralFlag' -gopt_unset :: DynFlags -> GeneralFlag -> DynFlags -gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } - --- | Test whether a 'WarningFlag' is set -wopt :: WarningFlag -> DynFlags -> Bool -wopt f dflags = f `EnumSet.member` warningFlags dflags - --- | Set a 'WarningFlag' -wopt_set :: DynFlags -> WarningFlag -> DynFlags -wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } - --- | Unset a 'WarningFlag' -wopt_unset :: DynFlags -> WarningFlag -> DynFlags -wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } - --- | Test whether a 'WarningFlag' is set as fatal -wopt_fatal :: WarningFlag -> DynFlags -> Bool -wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags - --- | Mark a 'WarningFlag' as fatal (do not set the flag) -wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_set_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } - --- | Mark a 'WarningFlag' as not fatal -wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_unset_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } - - --- | Enable all custom warning categories. -wopt_set_all_custom :: DynFlags -> DynFlags -wopt_set_all_custom dfs - = dfs{ customWarningCategories = completeWarningCategorySet } - --- | Disable all custom warning categories. -wopt_unset_all_custom :: DynFlags -> DynFlags -wopt_unset_all_custom dfs - = dfs{ customWarningCategories = emptyWarningCategorySet } - --- | Mark all custom warning categories as fatal (do not set the flags). -wopt_set_all_fatal_custom :: DynFlags -> DynFlags -wopt_set_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = completeWarningCategorySet } - --- | Mark all custom warning categories as non-fatal. -wopt_unset_all_fatal_custom :: DynFlags -> DynFlags -wopt_unset_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } - --- | Set a custom 'WarningCategory' -wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } - --- | Unset a custom 'WarningCategory' -wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as fatal (do not set the flag) -wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as not fatal -wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Are there any custom warning categories enabled? -wopt_any_custom :: DynFlags -> Bool -wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) - - --- | Test whether a 'LangExt.Extension' is set -xopt :: LangExt.Extension -> DynFlags -> Bool -xopt f dflags = f `EnumSet.member` extensionFlags dflags - --- | Set a 'LangExt.Extension' -xopt_set :: DynFlags -> LangExt.Extension -> DynFlags -xopt_set dfs f - = let onoffs = On f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Unset a 'LangExt.Extension' -xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags -xopt_unset dfs f - = let onoffs = Off f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Set or unset a 'LangExt.Extension', unless it has been explicitly --- set or unset before. -xopt_set_unlessExplSpec - :: LangExt.Extension - -> (DynFlags -> LangExt.Extension -> DynFlags) - -> DynFlags -> DynFlags -xopt_set_unlessExplSpec ext setUnset dflags = - let referedExts = stripOnOff <$> extensions dflags - stripOnOff (On x) = x - stripOnOff (Off x) = x - in - if ext `elem` referedExts then dflags else setUnset dflags ext - -xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields -xopt_DuplicateRecordFields dfs - | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields - | otherwise = FieldLabel.NoDuplicateRecordFields - -xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors -xopt_FieldSelectors dfs - | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors - | otherwise = FieldLabel.NoFieldSelectors - -lang_set :: DynFlags -> Maybe Language -> DynFlags -lang_set dflags lang = - dflags { - language = lang, - extensionFlags = flattenExtensionFlags lang (extensions dflags) - } - -- | Set the Haskell language standard to use setLanguage :: Language -> DynP () setLanguage l = upd (`lang_set` Just l) @@ -1697,14 +560,14 @@ combineSafeFlags a b | a == Sf_None = return b -- * function to test if the flag is on -- * function to turn the flag off unsafeFlags, unsafeFlagsForInfer - :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)] -unsafeFlags = [ ("-XGeneralizedNewtypeDeriving", newDerivOnLoc, + :: [(LangExt.Extension, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)] +unsafeFlags = [ (LangExt.GeneralizedNewtypeDeriving, newDerivOnLoc, xopt LangExt.GeneralizedNewtypeDeriving, flip xopt_unset LangExt.GeneralizedNewtypeDeriving) - , ("-XDerivingVia", deriveViaOnLoc, + , (LangExt.DerivingVia, deriveViaOnLoc, xopt LangExt.DerivingVia, flip xopt_unset LangExt.DerivingVia) - , ("-XTemplateHaskell", thOnLoc, + , (LangExt.TemplateHaskell, thOnLoc, xopt LangExt.TemplateHaskell, flip xopt_unset LangExt.TemplateHaskell) ] @@ -1905,7 +768,7 @@ updOptLevel n = fst . updOptLevelChanged n -- Throws a 'UsageError' if errors occurred during parsing (such as unknown -- flags or missing arguments). parseDynamicFlagsCmdLine :: MonadIO m => DynFlags -> [Located String] - -> m (DynFlags, [Located String], [Warn]) + -> m (DynFlags, [Located String], Messages DriverMessage) -- ^ Updated 'DynFlags', left-over arguments, and -- list of warnings. parseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAll True @@ -1915,7 +778,7 @@ parseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAll True -- (-package, -hide-package, -ignore-package, -hide-all-packages, -package-db). -- Used to parse flags set in a modules pragma. parseDynamicFilePragma :: MonadIO m => DynFlags -> [Located String] - -> m (DynFlags, [Located String], [Warn]) + -> m (DynFlags, [Located String], Messages DriverMessage) -- ^ Updated 'DynFlags', left-over arguments, and -- list of warnings. parseDynamicFilePragma = parseDynamicFlagsFull flagsDynamic False @@ -1947,7 +810,7 @@ processCmdLineP => [Flag (CmdLineP s)] -- ^ valid flags to match against -> s -- ^ current state -> [Located String] -- ^ arguments to parse - -> m (([Located String], [Err], [Warn]), s) + -> m (([Located String], [Err], Messages DriverMessage), s) -- ^ (leftovers, errors, warnings) processCmdLineP activeFlags s0 args = runStateT (processArgs (map (hoistFlag getCmdLineP) activeFlags) args parseResponseFile) s0 @@ -1955,6 +818,7 @@ processCmdLineP activeFlags s0 args = getCmdLineP :: CmdLineP s a -> StateT s m a getCmdLineP (CmdLineP k) = k + -- | Parses the dynamically set flags for GHC. This is the most general form of -- the dynamic flag parser that the other methods simply wrap. It allows -- saying which flags are valid flags and indicating if we are parsing @@ -1965,7 +829,7 @@ parseDynamicFlagsFull -> Bool -- ^ are the arguments from the command line? -> DynFlags -- ^ current dynamic flags -> [Located String] -- ^ arguments to parse - -> m (DynFlags, [Located String], [Warn]) + -> m (DynFlags, [Located String], Messages DriverMessage) parseDynamicFlagsFull activeFlags cmdline dflags0 args = do ((leftover, errs, warns), dflags1) <- processCmdLineP activeFlags dflags0 args @@ -1992,28 +856,29 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do liftIO $ setUnsafeGlobalDynFlags dflags3 - let warns' = map (Warn WarningWithoutFlag) (consistency_warnings ++ sh_warns) - - return (dflags3, leftover, warns' ++ warns) + return (dflags3, leftover, mconcat [consistency_warnings, sh_warns, warns]) -- | Check (and potentially disable) any extensions that aren't allowed -- in safe mode. -- -- The bool is to indicate if we are parsing command line flags (false means -- file pragma). This allows us to generate better warnings. -safeFlagCheck :: Bool -> DynFlags -> (DynFlags, [Located String]) +safeFlagCheck :: Bool -> DynFlags -> (DynFlags, Messages DriverMessage) safeFlagCheck _ dflags | safeLanguageOn dflags = (dflagsUnset, warns) where -- Handle illegal flags under safe language. - (dflagsUnset, warns) = foldl' check_method (dflags, []) unsafeFlags + (dflagsUnset, warns) = foldl' check_method (dflags, mempty) unsafeFlags - check_method (df, warns) (str,loc,test,fix) - | test df = (fix df, warns ++ safeFailure (loc df) str) + check_method (df, warns) (ext,loc,test,fix) + | test df = (fix df, addMessage (safeFailure (loc df) ext) warns) | otherwise = (df, warns) - safeFailure loc str - = [L loc $ str ++ " is not allowed in Safe Haskell; ignoring " - ++ str] + safeFailure loc ext + = mkPlainMsgEnvelope diag_opts loc $ DriverSafeHaskellIgnoredExtension ext + diag_opts = initDiagOpts dflags + +-- [L loc $ str ++ " is not allowed in Safe Haskell; ignoring " + -- ++ str] safeFlagCheck cmdl dflags = case safeInferOn dflags of @@ -2026,11 +891,10 @@ safeFlagCheck cmdl dflags = (dflags', warn) | not (safeHaskellModeEnabled dflags) && not cmdl && packageTrustOn dflags = (gopt_unset dflags Opt_PackageTrust, pkgWarnMsg) - | otherwise = (dflags, []) + | otherwise = (dflags, mempty) - pkgWarnMsg = [L (pkgTrustOnLoc dflags') $ - "-fpackage-trust ignored;" ++ - " must be specified with a Safe Haskell flag"] + pkgWarnMsg = singleMessage $ mkPlainMsgEnvelope diag_opts (pkgTrustOnLoc dflags') DriverPackageTrustIgnored + diag_opts = initDiagOpts dflags -- Have we inferred Unsafe? See Note [Safe Haskell Inference] in GHC.Driver.Main -- Force this to avoid retaining reference to old DynFlags value @@ -2215,7 +1079,7 @@ dynamic_flags_deps = [ deprecate $ "use -pgml-supports-no-pie instead" pure $ alterToolSettings (\s -> s { toolSettings_ccSupportsNoPie = True }) d) , make_ord_flag defFlag "pgms" - (HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8")) + (HasArg (\_ -> addWarnDynP "Object splitting was removed in GHC 8.8")) , make_ord_flag defFlag "pgma" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_a = (f,[]) } , make_ord_flag defFlag "pgml" @@ -2273,7 +1137,7 @@ dynamic_flags_deps = [ alterToolSettings $ \s -> s { toolSettings_opt_windres = f : toolSettings_opt_windres s } , make_ord_flag defGhcFlag "split-objs" - (NoArg $ addWarn "ignoring -split-objs") + (NoArg $ addWarnDynP "ignoring -split-objs") -- N.B. We may someday deprecate this in favor of -fsplit-sections, -- which has the benefit of also having a negating -fno-split-sections. @@ -3046,7 +1910,7 @@ warningControls set unset set_werror unset_fatal xs = customOrUnrecognisedWarning :: String -> (WarningCategory -> DynP ()) -> Flag (CmdLineP DynFlags) customOrUnrecognisedWarning prefix custom = defHiddenFlag prefix (Prefix action) where - action :: String -> EwM (CmdLineP DynFlags) () + action :: String -> DynP () action flag | validWarningCategory cat = custom cat | otherwise = unrecognised flag @@ -3054,9 +1918,8 @@ customOrUnrecognisedWarning prefix custom = defHiddenFlag prefix (Prefix action) cat = mkWarningCategory (mkFastString flag) unrecognised flag = do - f <- wopt Opt_WarnUnrecognisedWarningFlags <$> liftEwM getCmdLineState - when f $ addFlagWarn (WarningWithFlag Opt_WarnUnrecognisedWarningFlags) $ - "unrecognised warning flag: -" ++ prefix ++ flag + dflags <- liftEwM getCmdLineState + addFlagWarn (initDiagOpts dflags) (DriverUnrecognisedFlag (prefix ++ flag)) -- See Note [Supporting CLI completion] package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))] @@ -3119,11 +1982,6 @@ flagsForCompletion isInteractive modeFilter OnlyGhc = not isInteractive modeFilter HiddenFlag = False -type TurnOnFlag = Bool -- True <=> we are turning the flag on - -- False <=> we are turning the flag off -turnOn :: TurnOnFlag; turnOn = True -turnOff :: TurnOnFlag; turnOff = False - data FlagSpec flag = FlagSpec { flagSpecName :: String -- ^ Flag in string form @@ -3247,10 +2105,16 @@ mkFlag turn_on flagPrefix f (dep, (FlagSpec name flag extra_action mode)) Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on)) mode) -- here to avoid module cycle with GHC.Driver.CmdLine -deprecate :: Monad m => String -> EwM m () +addWarnDynP :: String -> DynP () +addWarnDynP msg = do + dflags <- liftEwM getCmdLineState + addWarn (initDiagOpts dflags) msg + +deprecate :: String -> DynP () deprecate s = do + dflags <- liftEwM getCmdLineState arg <- getArg - addFlagWarn (WarningWithFlag Opt_WarnDeprecatedFlags) (arg ++ " is deprecated: " ++ s) + addFlagWarn (initDiagOpts dflags) (DriverDeprecatedFlag arg s) deprecatedForExtension :: String -> TurnOnFlag -> String deprecatedForExtension lang turn_on @@ -3596,7 +2460,7 @@ fFlagsDeps = [ flagSpec' "compact-unwind" Opt_CompactUnwind (\turn_on -> updM (\dflags -> do unless (platformOS (targetPlatform dflags) == OSDarwin && turn_on) - (addWarn "-compact-unwind is only implemented by the darwin platform. Ignoring.") + (addWarn (initDiagOpts dflags) "-compact-unwind is only implemented by the darwin platform. Ignoring.") return dflags)), flagSpec "show-error-context" Opt_ShowErrorContext, flagSpec "cmm-thread-sanitizer" Opt_CmmThreadSanitizer, @@ -3874,62 +2738,6 @@ xFlagsDeps = [ flagSpec "ViewPatterns" LangExt.ViewPatterns ] -defaultFlags :: Settings -> [GeneralFlag] -defaultFlags settings --- See Note [Updating flag description in the User's Guide] - = [ Opt_AutoLinkPackages, - Opt_DiagnosticsShowCaret, - Opt_EmbedManifest, - Opt_FamAppCache, - Opt_GenManifest, - Opt_GhciHistory, - Opt_GhciSandbox, - Opt_HelpfulErrors, - Opt_KeepHiFiles, - Opt_KeepOFiles, - Opt_OmitYields, - Opt_PrintBindContents, - Opt_ProfCountEntries, - Opt_SharedImplib, - Opt_SimplPreInlining, - Opt_VersionMacros, - Opt_RPath, - Opt_DumpWithWays, - Opt_CompactUnwind, - Opt_ShowErrorContext, - Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter - ] - - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - - -- Default floating flags (see Note [RHS Floating]) - ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] - - - ++ default_PIC platform - - ++ validHoleFitDefaults - - - where platform = sTargetPlatform settings - --- | These are the default settings for the display and sorting of valid hole --- fits in typed-hole error messages. See Note [Valid hole fits include ...] - -- in the "GHC.Tc.Errors.Hole" module. -validHoleFitDefaults :: [GeneralFlag] -validHoleFitDefaults - = [ Opt_ShowTypeAppOfHoleFits - , Opt_ShowTypeOfHoleFits - , Opt_ShowProvOfHoleFits - , Opt_ShowMatchesOfHoleFits - , Opt_ShowValidHoleFits - , Opt_SortValidHoleFits - , Opt_SortBySizeHoleFits - , Opt_ShowHoleConstraints ] - - validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] validHoleFitsImpliedGFlags = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) @@ -3938,32 +2746,6 @@ validHoleFitsImpliedGFlags , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ] -default_PIC :: Platform -> [GeneralFlag] -default_PIC platform = - case (platformOS platform, platformArch platform) of - -- Darwin always requires PIC. Especially on more recent macOS releases - -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses - -- while we could work around this on x86_64 (like WINE does), we won't be - -- able on aarch64, where this is enforced. - (OSDarwin, ArchX86_64) -> [Opt_PIC] - -- For AArch64, we need to always have PIC enabled. The relocation model - -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't - -- control much how far apart symbols are in memory for our in-memory static - -- linker; and thus need to ensure we get sufficiently capable relocations. - -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top - -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to - -- be built with -fPIC. - (OSDarwin, ArchAArch64) -> [Opt_PIC] - (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in - -- OpenBSD since 5.3 release - -- (1 May 2013) we need to - -- always generate PIC. See - -- #10597 for more - -- information. - _ -> [] - -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] @@ -4065,73 +2847,6 @@ impliedXFlags -- NoStarIsType caused too much breakage on Hackage. -- --- Note [Documenting optimisation flags] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- If you change the list of flags enabled for particular optimisation levels --- please remember to update the User's Guide. The relevant file is: --- --- docs/users_guide/using-optimisation.rst --- --- Make sure to note whether a flag is implied by -O0, -O or -O2. - -optLevelFlags :: [([Int], GeneralFlag)] --- Default settings of flags, before any command-line overrides -optLevelFlags -- see Note [Documenting optimisation flags] - = [ ([0,1,2], Opt_DoLambdaEtaExpansion) - , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] - , ([0,1,2], Opt_LlvmTBAA) - , ([0,1,2], Opt_ProfManualCcs ) - , ([2], Opt_DictsStrict) - - , ([0], Opt_IgnoreInterfacePragmas) - , ([0], Opt_OmitInterfacePragmas) - - , ([1,2], Opt_CoreConstantFolding) - - , ([1,2], Opt_CallArity) - , ([1,2], Opt_Exitification) - , ([1,2], Opt_CaseMerge) - , ([1,2], Opt_CaseFolding) - , ([1,2], Opt_CmmElimCommonBlocks) - , ([2], Opt_AsmShortcutting) - , ([1,2], Opt_CmmSink) - , ([1,2], Opt_CmmStaticPred) - , ([1,2], Opt_CSE) - , ([1,2], Opt_StgCSE) - , ([2], Opt_StgLiftLams) - , ([1,2], Opt_CmmControlFlow) - - , ([1,2], Opt_EnableRewriteRules) - -- Off for -O0. Otherwise we desugar list literals - -- to 'build' but don't run the simplifier passes that - -- would rewrite them back to cons cells! This seems - -- silly, and matters for the GHCi debugger. - - , ([1,2], Opt_FloatIn) - , ([1,2], Opt_FullLaziness) - , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_Loopification) - , ([1,2], Opt_CfgBlocklayout) -- Experimental - - , ([1,2], Opt_Specialise) - , ([1,2], Opt_CrossModuleSpecialise) - , ([1,2], Opt_InlineGenerics) - , ([1,2], Opt_Strictness) - , ([1,2], Opt_UnboxSmallStrictFields) - , ([1,2], Opt_CprAnal) - , ([1,2], Opt_WorkerWrapper) - , ([1,2], Opt_SolveConstantDicts) - , ([1,2], Opt_NumConstantFolding) - - , ([2], Opt_LiberateCase) - , ([2], Opt_SpecConstr) - , ([2], Opt_FastPAPCalls) --- , ([2], Opt_RegsGraph) --- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) --- Static Argument Transformation needs investigation. See #9374 - ] -- | Things you get with `-dlint`. @@ -4439,11 +3154,7 @@ setDebugLevel mb_n = | n > 2 = setGeneralFlag' Opt_ExposeInternalSymbols | otherwise = id -data PkgDbRef - = GlobalPkgDb - | UserPkgDb - | PkgDbPath FilePath - deriving Eq + addPkgDbRef :: PkgDbRef -> DynP () addPkgDbRef p = upd $ \s -> @@ -4912,7 +3623,7 @@ T10052 and #10052). -- | Resolve any internal inconsistencies in a set of 'DynFlags'. -- Returns the consistent 'DynFlags' as well as a list of warnings -- to report to the user. -makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String]) +makeDynFlagsConsistent :: DynFlags -> (DynFlags, Messages DriverMessage) -- Whenever makeDynFlagsConsistent does anything, it starts over, to -- ensure that a later change doesn't invalidate an earlier check. -- Be careful not to introduce potential loops! @@ -4997,11 +3708,12 @@ makeDynFlagsConsistent dflags , Nothing <- outputFile dflags = pgmError "--output must be specified when using --merge-objs" - | otherwise = (dflags, []) - where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") + | otherwise = (dflags, mempty) + where diag_opts = initDiagOpts dflags + loc = mkGeneralSrcSpan (fsLit "when making flags consistent") loop updated_dflags warning = case makeDynFlagsConsistent updated_dflags of - (dflags', ws) -> (dflags', L loc warning : ws) + (dflags', ws) -> (dflags', addMessage (mkPlainMsgEnvelope diag_opts loc $ DriverInconsistentDynFlags warning) ws) platform = targetPlatform dflags arch = platformArch platform os = platformOS platform @@ -5070,29 +3782,6 @@ needSourceNotes dflags = debugLevel dflags > 0 -- ----------------------------------------------------------------------------- -- Linker/compiler information --- LinkerInfo contains any extra options needed by the system linker. -data LinkerInfo - = GnuLD [Option] - | Mold [Option] - | GnuGold [Option] - | LlvmLLD [Option] - | DarwinLD [Option] - | SolarisLD [Option] - | AixLD [Option] - | UnknownLD - deriving Eq - --- CompilerInfo tells us which C compiler we're using -data CompilerInfo - = GCC - | Clang - | AppleClang - | AppleClang51 - | Emscripten - | UnknownCC - deriving Eq - - -- | Should we use `-XLinker -rpath` when linking or not? -- See Note [-fno-use-rpaths] useXLinkerRPath :: DynFlags -> OS -> Bool @@ -5145,58 +3834,7 @@ foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO ( foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO () --- | Initialize the pretty-printing options -initSDocContext :: DynFlags -> PprStyle -> SDocContext -initSDocContext dflags style = SDC - { sdocStyle = style - , sdocColScheme = colScheme dflags - , sdocLastColour = Col.colReset - , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) - , sdocDefaultDepth = pprUserLength dflags - , sdocLineLength = pprCols dflags - , sdocCanUseUnicode = useUnicode dflags - , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags - , sdocPprDebug = dopt Opt_D_ppr_debug dflags - , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags - , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags - , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags - , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags - , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags - , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags - , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags - , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags - , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags - , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags - , sdocSuppressTicks = gopt Opt_SuppressTicks dflags - , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags - , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags - , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags - , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags - , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags - , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags - , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags - , sdocSuppressUniques = gopt Opt_SuppressUniques dflags - , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags - , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags - , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags - , sdocErrorSpans = gopt Opt_ErrorSpans dflags - , sdocStarIsType = xopt LangExt.StarIsType dflags - , sdocLinearTypes = xopt LangExt.LinearTypes dflags - , sdocListTuplePuns = True - , sdocPrintTypeAbbreviations = True - , sdocUnitIdForUser = ftext - } - --- | Initialize the pretty-printing options using the default user style -initDefaultSDocContext :: DynFlags -> SDocContext -initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle -initPromotionTickContext :: DynFlags -> PromotionTickContext -initPromotionTickContext dflags = - PromTickCtx { - ptcListTuplePuns = True, - ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags - } outputFile :: DynFlags -> Maybe String outputFile dflags @@ -5208,10 +3846,7 @@ objectSuf dflags | dynamicNow dflags = dynObjectSuf_ dflags | otherwise = objectSuf_ dflags -ways :: DynFlags -> Ways -ways dflags - | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) - | otherwise = targetWays_ dflags + -- | Pretty-print the difference between 2 DynFlags. -- ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -82,7 +82,7 @@ import GHC.Types.SrcLoc import GHC.Data.Bag -- collect ev vars from pats import GHC.Data.Maybe import GHC.Types.Name (Name, dataName) -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import qualified GHC.LanguageExtensions as LangExt import Data.Data ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude import GHC.Core (CoreRule, CoreExpr, RuleName) import GHC.Core.DataCon import GHC.Core.Type -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import GHC.Driver.Flags (WarningFlag) import GHC.Hs import GHC.HsToCore.Pmc.Solver.Types ===================================== compiler/GHC/Runtime/Context.hs ===================================== @@ -19,7 +19,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Plugins import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume ) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -119,7 +119,7 @@ import GHC.Core import GHC.Core.TyCo.Ppr import GHC.Utils.FV import GHC.Types.Var.Set -import GHC.Driver.Session (DynFlags(reductionDepth)) +import GHC.Driver.DynFlags (DynFlags(reductionDepth)) import GHC.Builtin.Names import GHC.Types.Basic import GHC.Types.Unique.Set ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -232,7 +232,7 @@ import {-# SOURCE #-} GHC.Tc.Types.Origin , FixedRuntimeRepOrigin, FixedRuntimeRepContext ) -- others: -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.Name as Name -- We use this to make dictionaries for type literals. -- Perhaps there's a better way to do this? ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -78,7 +78,7 @@ import GHC.Utils.Panic.Plain import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import GHC.Utils.Misc (HasDebugCallStack) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) import GHC.Unit.Module.ModIface ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -51,7 +51,7 @@ import GHC.Data.Maybe import GHC.Data.Graph.Directed import GHC.Driver.Backend -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.SourceFile ( hscSourceString ) ===================================== compiler/GHC/Unit/Module/ModSummary.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.Types import GHC.Unit.Module ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -75,7 +75,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Platform import GHC.Platform.Ways ===================================== compiler/ghc.cabal.in ===================================== @@ -434,6 +434,7 @@ Library GHC.Driver.Config.StgToCmm GHC.Driver.Config.Tidy GHC.Driver.Config.StgToJS + GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -1,21 +1,21 @@ ref compiler/GHC/Core/Coercion/Axiom.hs:463:2: Note [RoughMap and rm_empty] ref compiler/GHC/Core/Opt/OccurAnal.hs:983:7: Note [Loop breaking] ref compiler/GHC/Core/Opt/SetLevels.hs:1574:30: Note [Top level scope] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2825:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4009:8: Note [Lambda-bound unfoldings] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2826:13: Note [Case binder next] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4018:8: Note [Lambda-bound unfoldings] ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] -ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] -ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Core/Opt/Specialise.hs:1765:29: Note [Arity decrease] +ref compiler/GHC/Core/TyCo/Rep.hs:1565:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Driver/DynFlags.hs:1221:49: Note [Eta-reduction in -O0] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] -ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice] -ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices] +ref compiler/GHC/Hs/Expr.hs:1738:87: Note [Lifecycle of a splice] +ref compiler/GHC/Hs/Expr.hs:1774:7: Note [Pending Splices] ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constraints] ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations] +ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -32,12 +32,12 @@ ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested sp ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] +ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] -ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics] -ref compiler/GHC/Types/Demand.hs:306:25: Note [Preserving Boxity of results is rarely a win] +ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] +ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:410:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:200:31: Note [fun_id in Match] @@ -46,7 +46,7 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:272:10: Note [WayFlags] +ref testsuite/config/ghc:276:10: Note [WayFlags] ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfbc574c175518e0ebf8beb90235067a8a1505f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfbc574c175518e0ebf8beb90235067a8a1505f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 15:59:35 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Sat, 13 May 2023 11:59:35 -0400 Subject: [Git][ghc/ghc][wip/amg/dcoercion] 2 commits: Fix bad multiplicity role in tyConAppFunCo_maybe Message-ID: <645fb3e731ebe_171ad91d2a93e8320781@gitlab.mail> sheaf pushed to branch wip/amg/dcoercion at Glasgow Haskell Compiler / GHC Commits: a175170c by sheaf at 2023-05-13T17:50:46+02:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5264cfbd by Adam Gundry at 2023-05-13T17:59:21+02:00 Directed coercions This patch introduces a slimmer version of coercions, directed coercions, which store fewer types within them. This more compact representation considerably speeds up programs which involve many type family reductions, as the coercion size no longer grows quadratically in the number of reduction steps. ------------------------- Metric Decrease: LargeRecord T12227 T12545 T13386 T3064 T5030 T8095 T9872a T9872b T9872b_defer T9872c T9872d Metric Increase: CoOpt_Singletons T18223 T9872a T9872b T9872c T9872d ------------------------- - - - - - 9 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - + compiler/GHC/Core/FamInstEnv.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7db69ceb32dbb4161193e9e558b8281e0873cfb...5264cfbd6b81e0fdc5961e63b421bb8017db649f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7db69ceb32dbb4161193e9e558b8281e0873cfb...5264cfbd6b81e0fdc5961e63b421bb8017db649f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 16:48:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 13 May 2023 12:48:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Use a uniform return convention in bytecode for unary results Message-ID: <645fbf6f685b8_171ad91e325eb03350a6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - bfba6620 by Simon Peyton Jones at 2023-05-13T12:48:24-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - f77a8c02 by sheaf at 2023-05-13T12:48:29-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 29 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/Type.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Types/Id/Make.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/changelog.md - rts/Disassembler.c - rts/Interpreter.c - rts/Printer.c - rts/StgMiscClosures.cmm - rts/include/rts/Bytecodes.h - rts/include/stg/MiscClosures.h - + testsuite/tests/ghci/should_run/T22958a.hs - + testsuite/tests/ghci/should_run/T22958a.stdout - + testsuite/tests/ghci/should_run/T22958b.hs - + testsuite/tests/ghci/should_run/T22958b.stdout - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/simplCore/should_compile/T23307.hs - + testsuite/tests/simplCore/should_compile/T23307.stderr - + testsuite/tests/simplCore/should_compile/T23307a.hs - + testsuite/tests/simplCore/should_compile/T23307a.stderr - + testsuite/tests/simplCore/should_compile/T23307b.hs - + testsuite/tests/simplCore/should_compile/T23307c.hs - + testsuite/tests/simplCore/should_compile/T23307c.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -395,10 +395,7 @@ assembleI platform i = case i of PUSH_BCO proto -> do let ul_bco = assembleBCO platform proto p <- ioptr (liftM BCOPtrBCO ul_bco) emit bci_PUSH_G [Op p] - PUSH_ALTS proto -> do let ul_bco = assembleBCO platform proto - p <- ioptr (liftM BCOPtrBCO ul_bco) - emit bci_PUSH_ALTS [Op p] - PUSH_ALTS_UNLIFTED proto pk + PUSH_ALTS proto pk -> do let ul_bco = assembleBCO platform proto p <- ioptr (liftM BCOPtrBCO ul_bco) emit (push_alts pk) [Op p] @@ -504,8 +501,7 @@ assembleI platform i = case i of SWIZZLE stkoff n -> emit bci_SWIZZLE [SmallOp stkoff, SmallOp n] JMP l -> emit bci_JMP [LabelOp l] ENTER -> emit bci_ENTER [] - RETURN -> emit bci_RETURN [] - RETURN_UNLIFTED rep -> emit (return_unlifted rep) [] + RETURN rep -> emit (return_non_tuple rep) [] RETURN_TUPLE -> emit bci_RETURN_T [] CCALL off m_addr i -> do np <- addr m_addr emit bci_CCALL [SmallOp off, Op np, SmallOp i] @@ -574,16 +570,16 @@ push_alts V16 = error "push_alts: vector" push_alts V32 = error "push_alts: vector" push_alts V64 = error "push_alts: vector" -return_unlifted :: ArgRep -> Word16 -return_unlifted V = bci_RETURN_V -return_unlifted P = bci_RETURN_P -return_unlifted N = bci_RETURN_N -return_unlifted L = bci_RETURN_L -return_unlifted F = bci_RETURN_F -return_unlifted D = bci_RETURN_D -return_unlifted V16 = error "return_unlifted: vector" -return_unlifted V32 = error "return_unlifted: vector" -return_unlifted V64 = error "return_unlifted: vector" +return_non_tuple :: ArgRep -> Word16 +return_non_tuple V = bci_RETURN_V +return_non_tuple P = bci_RETURN_P +return_non_tuple N = bci_RETURN_N +return_non_tuple L = bci_RETURN_L +return_non_tuple F = bci_RETURN_F +return_non_tuple D = bci_RETURN_D +return_non_tuple V16 = error "return_non_tuple: vector" +return_non_tuple V32 = error "return_non_tuple: vector" +return_non_tuple V64 = error "return_non_tuple: vector" {- we can only handle up to a fixed number of words on the stack, ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -88,8 +88,7 @@ data BCInstr | PUSH_BCO (ProtoBCO Name) -- Push an alt continuation - | PUSH_ALTS (ProtoBCO Name) - | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep + | PUSH_ALTS (ProtoBCO Name) ArgRep | PUSH_ALTS_TUPLE (ProtoBCO Name) -- continuation !NativeCallInfo (ProtoBCO Name) -- tuple return BCO @@ -197,9 +196,10 @@ data BCInstr -- To Infinity And Beyond | ENTER - | RETURN -- return a lifted value - | RETURN_UNLIFTED ArgRep -- return an unlifted value, here's its rep - | RETURN_TUPLE -- return an unboxed tuple (info already on stack) + | RETURN ArgRep -- return a non-tuple value, here's its rep; see + -- Note [Return convention for non-tuple values] in GHC.StgToByteCode + | RETURN_TUPLE -- return an unboxed tuple (info already on stack); see + -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode -- Breakpoints | BRK_FUN Word16 Unique (RemotePtr CostCentre) @@ -274,8 +274,7 @@ instance Outputable BCInstr where <> ppr op ppr (PUSH_BCO bco) = hang (text "PUSH_BCO") 2 (ppr bco) - ppr (PUSH_ALTS bco) = hang (text "PUSH_ALTS") 2 (ppr bco) - ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text "PUSH_ALTS_UNLIFTED" <+> ppr pk) 2 (ppr bco) + ppr (PUSH_ALTS bco pk) = hang (text "PUSH_ALTS" <+> ppr pk) 2 (ppr bco) ppr (PUSH_ALTS_TUPLE bco call_info tuple_bco) = hang (text "PUSH_ALTS_TUPLE" <+> ppr call_info) 2 @@ -352,8 +351,7 @@ instance Outputable BCInstr where ppr (SWIZZLE stkoff n) = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff <+> text "by" <+> ppr n ppr ENTER = text "ENTER" - ppr RETURN = text "RETURN" - ppr (RETURN_UNLIFTED pk) = text "RETURN_UNLIFTED " <+> ppr pk + ppr (RETURN pk) = text "RETURN " <+> ppr pk ppr (RETURN_TUPLE) = text "RETURN_TUPLE" ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> mb_uniq <+> text "" where mb_uniq = sdocOption sdocSuppressUniques $ \case @@ -389,10 +387,8 @@ bciStackUse PUSH32_W{} = 1 -- takes exactly 1 word bciStackUse PUSH_G{} = 1 bciStackUse PUSH_PRIMOP{} = 1 bciStackUse PUSH_BCO{} = 1 -bciStackUse (PUSH_ALTS bco) = 2 {- profiling only, restore CCCS -} + +bciStackUse (PUSH_ALTS bco _) = 2 {- profiling only, restore CCCS -} + 3 + protoBCOStackUse bco -bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 {- profiling only, restore CCCS -} + - 4 + protoBCOStackUse bco bciStackUse (PUSH_ALTS_TUPLE bco info _) = -- (tuple_bco, call_info word, cont_bco, stg_ctoi_t) -- tuple @@ -452,8 +448,7 @@ bciStackUse TESTEQ_P{} = 0 bciStackUse CASEFAIL{} = 0 bciStackUse JMP{} = 0 bciStackUse ENTER{} = 0 -bciStackUse RETURN{} = 0 -bciStackUse RETURN_UNLIFTED{} = 1 -- pushes stg_ret_X for some X +bciStackUse RETURN{} = 1 -- pushes stg_ret_X for some X bciStackUse RETURN_TUPLE{} = 1 -- pushes stg_ret_t header bciStackUse CCALL{} = 0 bciStackUse PRIMCALL{} = 1 -- pushes stg_primcall ===================================== compiler/GHC/Core/Coercion.hs-boot ===================================== @@ -36,6 +36,8 @@ mkSubCo :: HasDebugCallStack => Coercion -> Coercion mkProofIrrelCo :: Role -> Coercion -> Coercion -> Coercion -> Coercion mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion +funRole :: Role -> FunSel -> Role + isGReflCo :: Coercion -> Bool isReflCo :: Coercion -> Bool isReflexiveCo :: Coercion -> Bool ===================================== compiler/GHC/Core/TyCo/Rep.hs-boot ===================================== @@ -8,6 +8,7 @@ import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) data Type data Coercion +data FunSel data CoSel data UnivCoProvenance data TyLit ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -274,7 +274,7 @@ import {-# SOURCE #-} GHC.Core.Coercion , mkTyConAppCo, mkAppCo , mkForAllCo, mkFunCo2, mkAxiomInstCo, mkUnivCo , mkSymCo, mkTransCo, mkSelCo, mkLRCo, mkInstCo - , mkKindCo, mkSubCo, mkFunCo + , mkKindCo, mkSubCo, mkFunCo, funRole , decomposePiCos, coercionKind , coercionRKind, coercionType , isReflexiveCo, seqCo @@ -1331,9 +1331,12 @@ tyConAppFunCo_maybe :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Maybe Coercion -- ^ Return Just if this TyConAppCo should be represented as a FunCo tyConAppFunCo_maybe r tc cos - | Just (af, mult, arg, res) <- ty_con_app_fun_maybe (mkReflCo r manyDataConTy) tc cos - = Just (mkFunCo r af mult arg res) - | otherwise = Nothing + | Just (af, mult, arg, res) <- ty_con_app_fun_maybe mult_refl tc cos + = Just (mkFunCo r af mult arg res) + | otherwise + = Nothing + where + mult_refl = mkReflCo (funRole r SelMult) manyDataConTy ty_con_app_fun_maybe :: (HasDebugCallStack, Outputable a) => a -> TyCon -> [a] -> Maybe (FunTyFlag, a, a, a) ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -319,7 +319,7 @@ schemeTopBind (id, rhs) -- by just re-using the single top-level definition. So -- for the worker itself, we must allocate it directly. -- ioToBc (putStrLn $ "top level BCO") - emitBc (mkProtoBCO platform (getName id) (toOL [PACK data_con 0, RETURN]) + emitBc (mkProtoBCO platform (getName id) (toOL [PACK data_con 0, RETURN P]) (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-}) | otherwise @@ -480,9 +480,9 @@ returnUnliftedReps d s szb reps = do non_void VoidRep = False non_void _ = True ret <- case filter non_void reps of - -- use RETURN_UBX for unary representations - [] -> return (unitOL $ RETURN_UNLIFTED V) - [rep] -> return (unitOL $ RETURN_UNLIFTED (toArgRep platform rep)) + -- use RETURN for nullary/unary representations + [] -> return (unitOL $ RETURN V) + [rep] -> return (unitOL $ RETURN (toArgRep platform rep)) -- otherwise use RETURN_TUPLE with a tuple descriptor nv_reps -> do let (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 (primRepCmmType platform) nv_reps @@ -526,7 +526,7 @@ schemeE :: StackDepth -> Sequel -> BCEnv -> CgStgExpr -> BcM BCInstrList schemeE d s p (StgLit lit) = returnUnliftedAtom d s p (StgLitArg lit) schemeE d s p (StgApp x []) - | not (usePlainReturn (idType x)) = returnUnliftedAtom d s p (StgVarArg x) + | isUnliftedType (idType x) = returnUnliftedAtom d s p (StgVarArg x) -- Delegate tail-calls to schemeT. schemeE d s p e@(StgApp {}) = schemeT d s p e schemeE d s p e@(StgConApp {}) = schemeT d s p e @@ -681,8 +681,8 @@ schemeT d s p (StgOpApp (StgPrimOp op) args _ty) schemeT d s p (StgOpApp (StgPrimCallOp (PrimCall label unit)) args result_ty) = generatePrimCall d s p label (Just unit) result_ty args - -- Case 2: Unboxed tuple schemeT d s p (StgConApp con _cn args _tys) + -- Case 2: Unboxed tuple | isUnboxedTupleDataCon con || isUnboxedSumDataCon con = returnUnboxedTuple d s p args @@ -691,7 +691,7 @@ schemeT d s p (StgConApp con _cn args _tys) = do alloc_con <- mkConAppCode d s p con args platform <- profilePlatform <$> getProfile return (alloc_con `appOL` - mkSlideW 1 (bytesToWords platform $ d - s) `snocOL` RETURN) + mkSlideW 1 (bytesToWords platform $ d - s) `snocOL` RETURN P) -- Case 4: Tail call of function schemeT d s p (StgApp fn args) @@ -831,14 +831,11 @@ doCase d s p scrut bndr alts -- have the same runtime rep. We have more efficient specialized -- return frames for the situations with one non-void element. + non_void_arg_reps = non_void (typeArgReps platform bndr_ty) ubx_tuple_frame = (isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty) && length non_void_arg_reps > 1 - ubx_frame = not ubx_tuple_frame && not (usePlainReturn bndr_ty) - - non_void_arg_reps = non_void (typeArgReps platform bndr_ty) - profiling | Just interp <- hsc_interp hsc_env = interpreterProfiled interp @@ -847,7 +844,8 @@ doCase d s p scrut bndr alts -- Top of stack is the return itbl, as usual. -- underneath it is the pointer to the alt_code BCO. -- When an alt is entered, it assumes the returned value is - -- on top of the itbl. + -- on top of the itbl; see Note [Return convention for non-tuple values] + -- for details. ret_frame_size_b :: StackDepth ret_frame_size_b | ubx_tuple_frame = (if profiling then 5 else 4) * wordSize platform @@ -861,7 +859,6 @@ doCase d s p scrut bndr alts -- The size of the return frame info table pointer if one exists unlifted_itbl_size_b :: StackDepth unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform - | ubx_frame = wordSize platform | otherwise = 0 (bndr_size, call_info, args_offsets) @@ -1052,17 +1049,11 @@ doCase d s p scrut bndr alts then do tuple_bco <- emitBc (tupleBCO platform call_info args_offsets) return (PUSH_ALTS_TUPLE alt_bco' call_info tuple_bco `consOL` scrut_code) - else let push_alts - | not ubx_frame - = PUSH_ALTS alt_bco' - | otherwise - = let unlifted_rep = - case non_void_arg_reps of - [] -> V - [rep] -> rep - _ -> panic "schemeE(StgCase).push_alts" - in PUSH_ALTS_UNLIFTED alt_bco' unlifted_rep - in return (push_alts `consOL` scrut_code) + else let scrut_rep = case non_void_arg_reps of + [] -> V + [rep] -> rep + _ -> panic "schemeE(StgCase).push_alts" + in return (PUSH_ALTS alt_bco' scrut_rep `consOL` scrut_code) -- ----------------------------------------------------------------------------- @@ -1130,21 +1121,38 @@ layoutNativeCall profile call_type start_off arg_ty reps = (orig_stk_params ++ map get_byte_off new_stk_params) ) -{- - We use the plain return convention (ENTER/PUSH_ALTS) for - lifted types and unlifted algebraic types. - - Other types use PUSH_ALTS_UNLIFTED/PUSH_ALTS_TUPLE which expect - additional data on the stack. - -} -usePlainReturn :: Type -> Bool -usePlainReturn t - | isUnboxedTupleType t || isUnboxedSumType t = False - | otherwise = typePrimRep t == [LiftedRep] || - (typePrimRep t == [UnliftedRep] && isAlgType t) - -{- Note [unboxed tuple bytecodes and tuple_BCO] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Return convention for non-tuple values] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The RETURN and ENTER instructions are used to return values. RETURN directly +returns the value at the top of the stack while ENTER evaluates it first (so +RETURN is only used when the result is already known to be evaluated), but the +end result is the same: control returns to the enclosing stack frame with the +result at the top of the stack. + +The PUSH_ALTS instruction pushes a two-word stack frame that receives a single +lifted value. Its payload is a BCO that is executed when control returns, with +the stack set up as if a RETURN instruction had just been executed: the returned +value is at the top of the stack, and beneath it is the two-word frame being +returned to. It is the continuation BCO’s job to pop its own frame off the +stack, so the simplest possible continuation consists of two instructions: + + SLIDE 1 2 -- pop the return frame off the stack, keeping the returned value + RETURN P -- return the returned value to our caller + +RETURN and PUSH_ALTS are not really instructions but are in fact representation- +polymorphic *families* of instructions indexed by ArgRep. ENTER, however, is a +single real instruction, since it is only used to return lifted values, which +are always pointers. + +The RETURN, ENTER, and PUSH_ALTS instructions are only used when the returned +value has nullary or unary representation. Returning/receiving an unboxed +tuple (or, indirectly, an unboxed sum, since unboxed sums have been desugared to +unboxed tuples by Unarise) containing two or more results uses the special +RETURN_TUPLE/PUSH_ALTS_TUPLE instructions, which use a different return +convention. See Note [unboxed tuple bytecodes and tuple_BCO] for details. + +Note [unboxed tuple bytecodes and tuple_BCO] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We have the bytecode instructions RETURN_TUPLE and PUSH_ALTS_TUPLE to return and receive arbitrary unboxed tuples, respectively. These instructions use the helper data tuple_BCO and call_info. @@ -1580,7 +1588,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args -- slide and return d_after_r_min_s = bytesToWords platform (d_after_r - s) wrapup = mkSlideW (trunc16W r_sizeW) (d_after_r_min_s - r_sizeW) - `snocOL` RETURN_UNLIFTED (toArgRep platform r_rep) + `snocOL` RETURN (toArgRep platform r_rep) --trace (show (arg1_offW, args_offW , (map argRepSizeW a_reps) )) $ return ( push_args `appOL` @@ -1694,7 +1702,6 @@ as a consequence. The [Name] is a list of the constructors of this The code we generate is this: push arg - push bogus-word TESTEQ_I 0 L1 PUSH_G @@ -1712,13 +1719,6 @@ The code we generate is this: L_exit: SLIDE 1 n ENTER - -The 'bogus-word' push is because TESTEQ_I expects the top of the stack -to have an info-table, and the next word to have the value to be -tested. This is very weird, but it's the way it is right now. See -Interpreter.c. We don't actually need an info-table here; we just -need to have the argument to be one-from-top on the stack, hence pushing -a 1-word null. See #8383. -} @@ -1744,14 +1744,10 @@ implement_tagToId d s p arg names slide_ws = bytesToWords platform (d - s + arg_bytes) return (push_arg - `appOL` unitOL (PUSH_UBX LitNullAddr 1) - -- Push bogus word (see Note [Implementing tagToEnum#]) `appOL` concatOL steps `appOL` toOL [ LABEL label_fail, CASEFAIL, LABEL label_exit ] - `appOL` mkSlideW 1 (slide_ws + 1) - -- "+1" to account for bogus word - -- (see Note [Implementing tagToEnum#]) + `appOL` mkSlideW 1 slide_ws `appOL` unitOL ENTER) where mkStep l_exit (my_label, next_label, n, name_for_n) ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -308,8 +308,7 @@ type DynTag = Int -- The tag on a *pointer* -- Also see Note [Tagging big families] in GHC.StgToCmm.Expr -- -- The interpreter also needs to be updated if we change the --- tagging strategy. See Note [Data constructor dynamic tags] in --- rts/Interpreter.c +-- tagging strategy; see tagConstr in rts/Interpreter.c. isSmallFamily :: Platform -> Int -> Bool isSmallFamily platform fam_size = fam_size <= mAX_PTR_TAG platform ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -1053,8 +1053,7 @@ dataConSrcToImplBang bang_opts fam_envs arg_ty arg_ty' = case mb_co of { Just redn -> scaledSet arg_ty (reductionReducedType redn) ; Nothing -> arg_ty } - , all (not . isNewTyCon . fst) (splitTyConApp_maybe $ scaledThing arg_ty') - , shouldUnpackTy bang_opts unpk_prag fam_envs arg_ty' + , shouldUnpackArgTy bang_opts unpk_prag fam_envs arg_ty' = if bang_opt_unbox_disable bang_opts then HsStrict True -- Not unpacking because of -O0 -- See Note [Detecting useless UNPACK pragmas] in GHC.Core.DataCon @@ -1329,69 +1328,95 @@ mkUbxSumAltTy :: [Type] -> Type mkUbxSumAltTy [ty] = ty mkUbxSumAltTy tys = mkTupleTy Unboxed tys -shouldUnpackTy :: BangOpts -> SrcUnpackedness -> FamInstEnvs -> Scaled Type -> Bool +shouldUnpackArgTy :: BangOpts -> SrcUnpackedness -> FamInstEnvs -> Scaled Type -> Bool -- True if we ought to unpack the UNPACK the argument type -- See Note [Recursive unboxing] -- We look "deeply" inside rather than relying on the DataCons -- we encounter on the way, because otherwise we might well -- end up relying on ourselves! -shouldUnpackTy bang_opts prag fam_envs ty - | Just data_cons <- unpackable_type_datacons (scaledThing ty) - = all (ok_con_args emptyNameSet) data_cons && should_unpack data_cons +shouldUnpackArgTy bang_opts prag fam_envs arg_ty + | Just data_cons <- unpackable_type_datacons (scaledThing arg_ty) + , all ok_con data_cons -- Returns True only if we can't get a + -- loop involving these data cons + , should_unpack prag arg_ty data_cons -- ...hence the call to dataConArgUnpack in + -- should_unpack won't loop + -- See Wrinkle (W1b) of Note [Recursive unboxing] for this loopy stuff + = True + | otherwise = False where - ok_con_args :: NameSet -> DataCon -> Bool - ok_con_args dcs con - | dc_name `elemNameSet` dcs - = False - | otherwise - = all (ok_arg dcs') - (dataConOrigArgTys con `zip` dataConSrcBangs con) - -- NB: dataConSrcBangs gives the *user* request; - -- We'd get a black hole if we used dataConImplBangs + ok_con :: DataCon -> Bool -- True <=> OK to unpack + ok_con top_con -- False <=> not safe + = ok_args emptyNameSet top_con where - dc_name = getName con - dcs' = dcs `extendNameSet` dc_name - - ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool - ok_arg dcs (Scaled _ ty, bang) - = not (attempt_unpack bang) || ok_ty dcs norm_ty - where - norm_ty = topNormaliseType fam_envs ty + top_con_name = getName top_con - ok_ty :: NameSet -> Type -> Bool - ok_ty dcs ty - | Just data_cons <- unpackable_type_datacons ty - = all (ok_con_args dcs) data_cons - | otherwise - = True -- NB True here, in contrast to False at top level - - attempt_unpack :: HsSrcBang -> Bool - attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict) - = bang_opt_strict_data bang_opts - attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict) - = True - attempt_unpack (HsSrcBang _ NoSrcUnpack SrcStrict) - = True -- Be conservative - attempt_unpack (HsSrcBang _ NoSrcUnpack NoSrcStrict) - = bang_opt_strict_data bang_opts -- Be conservative - attempt_unpack _ = False - - -- Determine whether we ought to unpack a field based on user annotations if present and heuristics if not. - should_unpack data_cons = + ok_args dcs con + = all (ok_arg dcs) $ + (dataConOrigArgTys con `zip` dataConSrcBangs con) + -- NB: dataConSrcBangs gives the *user* request; + -- We'd get a black hole if we used dataConImplBangs + + ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool + ok_arg dcs (Scaled _ ty, HsSrcBang _ unpack_prag str_prag) + | strict_field str_prag + , Just data_cons <- unpackable_type_datacons (topNormaliseType fam_envs ty) + , should_unpack_conservative unpack_prag data_cons -- Wrinkle (W3) + = all (ok_rec_con dcs) data_cons -- of Note [Recursive unboxing] + | otherwise + = True -- NB True here, in contrast to False at top level + + -- See Note [Recursive unboxing] + -- * Do not look at the HsImplBangs to `con`; see Wrinkle (W1a) + -- * For the "at the root" comments see Wrinkle (W2) + ok_rec_con dcs con + | dc_name == top_con_name = False -- Recursion at the root + | dc_name `elemNameSet` dcs = True -- Not at the root + | otherwise = ok_args (dcs `extendNameSet` dc_name) con + where + dc_name = getName con + + strict_field :: SrcStrictness -> Bool + -- True <=> strict field + strict_field NoSrcStrict = bang_opt_strict_data bang_opts + strict_field SrcStrict = True + strict_field SrcLazy = False + + -- Determine whether we ought to unpack a field, + -- based on user annotations if present. + -- A conservative version of should_unpack that doesn't look at how + -- many fields the field would unpack to... because that leads to a loop. + -- "Conservative" = err on the side of saying "yes". + should_unpack_conservative :: SrcUnpackedness -> [DataCon] -> Bool + should_unpack_conservative SrcNoUnpack _ = False -- {-# NOUNPACK #-} + should_unpack_conservative SrcUnpack _ = True -- {-# NOUNPACK #-} + should_unpack_conservative NoSrcUnpack dcs = not (is_sum dcs) + -- is_sum: we never unpack sums without a pragma; otherwise be conservative + + -- Determine whether we ought to unpack a field, + -- based on user annotations if present, and heuristics if not. + should_unpack :: SrcUnpackedness -> Scaled Type -> [DataCon] -> Bool + should_unpack prag arg_ty data_cons = case prag of SrcNoUnpack -> False -- {-# NOUNPACK #-} SrcUnpack -> True -- {-# UNPACK #-} NoSrcUnpack -- No explicit unpack pragma, so use heuristics - | (_:_:_) <- data_cons - -> False -- don't unpack sum types automatically, but they can be unpacked with an explicit source UNPACK. - | otherwise + | is_sum data_cons + -> False -- Don't unpack sum types automatically, but they can + -- be unpacked with an explicit source UNPACK. + | otherwise -- Wrinkle (W4) of Note [Recursive unboxing] -> bang_opt_unbox_strict bang_opts || (bang_opt_unbox_small bang_opts && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields] - where (rep_tys, _) = dataConArgUnpack ty + where + (rep_tys, _) = dataConArgUnpack arg_ty + is_sum :: [DataCon] -> Bool + -- We never unpack sum types automatically + -- (Product types, we do. Empty types are weeded out by unpackable_type_datacons.) + is_sum (_:_:_) = True + is_sum _ = False -- Given a type already assumed to have been normalized by topNormaliseType, -- unpackable_type_datacons ty = Just datacons @@ -1403,11 +1428,11 @@ shouldUnpackTy bang_opts prag fam_envs ty unpackable_type_datacons :: Type -> Maybe [DataCon] unpackable_type_datacons ty | Just (tc, _) <- splitTyConApp_maybe ty - , not (isNewTyCon tc) - -- Even though `ty` has been normalised, it could still - -- be a /recursive/ newtype, so we must check for that + , not (isNewTyCon tc) -- Even though `ty` has been normalised, it could still + -- be a /recursive/ newtype, so we must check for that , Just cons <- tyConDataCons_maybe tc - , not (null cons) + , not (null cons) -- Don't upack nullary sums; no need. + -- They already take zero bits , all (null . dataConExTyCoVars) cons = Just cons -- See Note [Unpacking GADTs and existentials] | otherwise @@ -1463,21 +1488,75 @@ But be careful not to try to unbox this! data T = MkT {-# UNPACK #-} !T Int Because then we'd get an infinite number of arguments. -Here is a more complicated case: - data S = MkS {-# UNPACK #-} !T Int - data T = MkT {-# UNPACK #-} !S Int -Each of S and T must decide independently whether to unpack -and they had better not both say yes. So they must both say no. - -Also behave conservatively when there is no UNPACK pragma - data T = MkS !T Int -with -funbox-strict-fields or -funbox-small-strict-fields -we need to behave as if there was an UNPACK pragma there. - -But it's the *argument* type that matters. This is fine: +Note that it's the *argument* type that matters. This is fine: data S = MkS S !Int because Int is non-recursive. +Wrinkles: + +(W1a) We have to be careful that the compiler doesn't go into a loop! + First, we must not look at the HsImplBang decisions of data constructors + in the same mutually recursive group. E.g. + data S = MkS {-# UNPACK #-} !T Int + data T = MkT {-# UNPACK #-} !S Int + Each of S and T must decide /independently/ whether to unpack + and they had better not both say yes. So they must both say no. + (We could detect when we leave the group, and /then/ we can rely on + HsImplBangs; but that requires more plumbing.) + +(W1b) Here is another way the compiler might go into a loop (test T23307b): + data data T = MkT !S Int + data S = MkS !T + Suppose we call `shouldUnpackArgTy` on the !S arg of `T`. In `should_unpack` + we ask if the number of fields that `MkS` unpacks to is small enough + (via rep_tys `lengthAtMost` 1). But how many field /does/ `MkS` unpack + to? Well it depends on the unpacking decision we make for `MkS`, which + in turn depends on `MkT`, which we are busy deciding. Black holes beckon. + + So we /first/ call `ok_con` on `MkS` (and `ok_con` is conservative; + see `should_unpack_conservative`), and only /then/ call `should_unpack`. + Tricky! + +(W2) As #23307 shows, we /do/ want to unpack the second arg of the Yes + data constructor in this example, despite the recursion in List: + data Stream a = Cons a !(Stream a) + data Unconsed a = Unconsed a !(Stream a) + data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) + When looking at + {-# UNPACK #-} (Unconsed a) + we can take Unconsed apart, but then get into a loop with Stream. + That's fine: we can still take Unconsed apart. It's only if we + have a loop /at the root/ that we must not unpack. + +(W3) Moreover (W2) can apply even if there is a recursive loop: + data List a = Nil | Cons {-# UNPACK #-} !(Unconsed a) + data Unconsed a = Unconsed a !(List a) + Here there is mutual recursion between `Unconsed` and `List`; and yet + we can unpack the field of `Cons` because we will not unpack the second + field of `Unconsed`: we never unpack a sum type without an explicit + pragma (see should_unpack). + +(W4) Consider + data T = MkT !Wombat + data Wombat = MkW {-# UNPACK #-} !S Int + data S = MkS {-# NOUNPACK #-} !Wombat Int + Suppose we are deciding whether to unpack the first field of MkT, by + calling (shouldUnpackArgTy Wombat). Then we'll try to unpack the !S field + of MkW, and be stopped by the {-# NOUNPACK #-}, and all is fine; we can + unpack MkT. + + If that NOUNPACK had been a UNPACK, though, we'd get a loop, and would + decide not to unpack the Wombat field of MkT. + + But what if there was no pragma in `data S`? Then we /still/ decide not + to unpack the Wombat field of MkT (at least when auto-unpacking is on), + because we don't know for sure which decision will be taken for the + Wombat field of MkS. + + TL;DR when there is no pragma, behave as if there was a UNPACK, at least + when auto-unpacking is on. See `should_unpack` in `shouldUnpackArgTy`. + + ************************************************************************ * * Wrapping and unwrapping newtypes and type families ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -156,3 +156,14 @@ instance (TestEquality f) => TestEquality (Compose f g) where case testEquality x y of -- :: Maybe (g x :~: g y) Just Refl -> Just Refl -- :: Maybe (x :~: y) Nothing -> Nothing + +-- | @since 4.19.0.0 +deriving instance Enum (f (g a)) => Enum (Compose f g a) +-- | @since 4.19.0.0 +deriving instance Bounded (f (g a)) => Bounded (Compose f g a) +-- | @since 4.19.0.0 +deriving instance Num (f (g a)) => Num (Compose f g a) +-- | @since 4.19.0.0 +deriving instance Real (f (g a)) => Real (Compose f g a) +-- | @since 4.19.0.0 +deriving instance Integral (f (g a)) => Integral (Compose f g a) ===================================== libraries/base/changelog.md ===================================== @@ -25,6 +25,7 @@ adding the class `Unsatisfiable :: ErrorMessage -> TypeError` to `GHC.TypeError`, which provides a mechanism for custom type errors that reports the errors in a more predictable behaviour than `TypeError`. + * Add more instances for `Compose`: `Enum`, `Bounded`, `Num`, `Real`, `Integral` ([CLC proposal #160](https://github.com/haskell/core-libraries-committee/issues/160)) * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) ===================================== rts/Disassembler.c ===================================== @@ -123,10 +123,6 @@ disInstr ( StgBCO *bco, int pc ) debugBelch("PUSH_G " ); printPtr( ptrs[instrs[pc]] ); debugBelch("\n" ); pc += 1; break; - case bci_PUSH_ALTS: - debugBelch("PUSH_ALTS " ); printPtr( ptrs[instrs[pc]] ); - debugBelch("\n"); - pc += 1; break; case bci_PUSH_ALTS_P: debugBelch("PUSH_ALTS_P " ); printPtr( ptrs[instrs[pc]] ); debugBelch("\n"); @@ -408,9 +404,6 @@ disInstr ( StgBCO *bco, int pc ) debugBelch("ENTER\n"); break; - case bci_RETURN: - debugBelch("RETURN\n" ); - break; case bci_RETURN_P: debugBelch("RETURN_P\n" ); break; ===================================== rts/Interpreter.c ===================================== @@ -283,6 +283,14 @@ StgClosure * copyPAP (Capability *cap, StgPAP *oldpap) #endif +// Compute the pointer tag for the constructor and tag the pointer; +// see Note [Data constructor dynamic tags] in GHC.StgToCmm.Closure. +// +// Note: we need to update this if we change the tagging strategy. +STATIC_INLINE StgClosure *tagConstr(StgClosure *con) { + return TAG_CLOSURE(stg_min(TAG_MASK, 1 + GET_TAG(con)), con); +} + static StgWord app_ptrs_itbl[] = { (W_)&stg_ap_p_info, (W_)&stg_ap_pp_info, @@ -363,11 +371,22 @@ interpretBCO (Capability* cap) // ------------------------------------------------------------------------ // Case 3: // - // We have an unlifted value to return. See comment before - // do_return_lifted, below. + // We have a pointer to return. See comment before + // do_return_pointer, below. + // + else if (SpW(0) == (W_)&stg_ret_p_info) { + tagged_obj = (StgClosure *)SpW(1); + Sp_addW(2); + goto do_return_pointer; + } + + // ------------------------------------------------------------------------ + // Case 4: + // + // We have a nonpointer to return. // else { - goto do_return_unlifted; + goto do_return_nonpointer; } // Evaluate the object on top of the stack. @@ -412,6 +431,11 @@ eval_obj: 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: @@ -533,16 +557,16 @@ eval_obj: } // ------------------------------------------------------------------------ - // We now have an evaluated object (tagged_obj). The next thing to + // We now have a pointer to return (tagged_obj). The next thing to // do is return it to the stack frame on top of the stack. -do_return: +do_return_pointer: obj = UNTAG_CLOSURE(tagged_obj); - ASSERT(closure_HNF(obj)); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(obj)); IF_DEBUG(interpreter, debugBelch( "\n---------------------------------------------------------------\n"); - debugBelch("Returning: "); printObj(obj); + debugBelch("Returning closure: "); printObj(obj); debugBelch("Sp = %p\n", Sp); #if defined(PROFILING) fprintCCS(stderr, cap->r.rCCCS); @@ -567,7 +591,7 @@ do_return: info == (StgInfoTable *)&stg_restore_cccs_eval_info) { cap->r.rCCCS = (CostCentreStack*)SpW(1); Sp_addW(2); - goto do_return; + goto do_return_pointer; } if (info == (StgInfoTable *)&stg_ap_v_info) { @@ -621,7 +645,7 @@ do_return: updateThunk(cap, cap->r.rCurrentTSO, ((StgUpdateFrame *)Sp)->updatee, tagged_obj); Sp_addW(sizeofW(StgUpdateFrame)); - goto do_return; + goto do_return_pointer; case RET_BCO: // Returning to an interpreted continuation: put the object on @@ -631,7 +655,7 @@ do_return: SpW(0) = (W_)tagged_obj; obj = (StgClosure*)SpW(2); ASSERT(get_itbl(obj)->type == BCO); - goto run_BCO_return; + goto run_BCO_return_pointer; default: do_return_unrecognised: @@ -644,7 +668,7 @@ do_return: ); Sp_subW(2); SpW(1) = (W_)tagged_obj; - SpW(0) = (W_)&stg_enter_info; + SpW(0) = (W_)&stg_ret_p_info; RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding); } } @@ -672,12 +696,11 @@ do_return: // We're only interested in the case when the real return address // is a BCO; otherwise we'll return to the scheduler. -do_return_unlifted: +do_return_nonpointer: { int offset; ASSERT( SpW(0) == (W_)&stg_ret_v_info - || SpW(0) == (W_)&stg_ret_p_info || SpW(0) == (W_)&stg_ret_n_info || SpW(0) == (W_)&stg_ret_f_info || SpW(0) == (W_)&stg_ret_d_info @@ -688,7 +711,7 @@ do_return_unlifted: IF_DEBUG(interpreter, debugBelch( "\n---------------------------------------------------------------\n"); - debugBelch("Returning unlifted\n"); + debugBelch("Returning nonpointer\n"); debugBelch("Sp = %p\n", Sp); #if defined(PROFILING) fprintCCS(stderr, cap->r.rCCCS); @@ -705,12 +728,13 @@ do_return_unlifted: switch (get_itbl((StgClosure*)(Sp_plusW(offset)))->type) { case RET_BCO: - // Returning to an interpreted continuation: put the object on - // the stack, and start executing the BCO. + // Returning to an interpreted continuation: pop the return frame + // so the returned value is at the top of the stack, and start + // executing the BCO. INTERP_TICK(it_retto_BCO); obj = (StgClosure*)SpW(offset+1); ASSERT(get_itbl(obj)->type == BCO); - goto run_BCO_return_unlifted; + goto run_BCO_return_nonpointer; default: { @@ -815,7 +839,7 @@ do_apply: SET_HDR(new_pap,&stg_PAP_info,cap->r.rCCCS); tagged_obj = (StgClosure *)new_pap; Sp_addW(m); - goto do_return; + goto do_return_pointer; } } @@ -858,7 +882,7 @@ do_apply: SET_HDR(pap, &stg_PAP_info,cap->r.rCCCS); tagged_obj = (StgClosure *)pap; Sp_addW(m); - goto do_return; + goto do_return_pointer; } } @@ -917,10 +941,10 @@ do_apply: // to do: -run_BCO_return: +run_BCO_return_pointer: // Heap check if (doYouWantToGC(cap)) { - Sp_subW(1); SpW(0) = (W_)&stg_enter_info; + Sp_subW(1); SpW(0) = (W_)&stg_ret_p_info; RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow); } // Stack checks aren't necessary at return points, the stack use @@ -928,7 +952,7 @@ run_BCO_return: goto run_BCO; -run_BCO_return_unlifted: +run_BCO_return_nonpointer: // Heap check if (doYouWantToGC(cap)) { RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow); @@ -973,6 +997,9 @@ run_BCO_return_unlifted: } #endif + if (SpW(0) != (W_)&stg_ret_t_info) { + Sp_addW(1); + } goto run_BCO; run_BCO_fun: @@ -1274,7 +1301,7 @@ run_BCO: goto nextInsn; } - case bci_PUSH_ALTS: { + case bci_PUSH_ALTS_P: { int o_bco = BCO_GET_LARGE_ARG; Sp_subW(2); SpW(1) = BCO_PTR(o_bco); @@ -1287,19 +1314,6 @@ run_BCO: goto nextInsn; } - case bci_PUSH_ALTS_P: { - int o_bco = BCO_GET_LARGE_ARG; - SpW(-2) = (W_)&stg_ctoi_R1unpt_info; - SpW(-1) = BCO_PTR(o_bco); - Sp_subW(2); -#if defined(PROFILING) - Sp_subW(2); - SpW(1) = (W_)cap->r.rCCCS; - SpW(0) = (W_)&stg_restore_cccs_info; -#endif - goto nextInsn; - } - case bci_PUSH_ALTS_N: { int o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_R1n_info; @@ -1678,19 +1692,7 @@ run_BCO: StgInfoTable *con_itbl = (StgInfoTable*) BCO_LIT(o_itbl); SET_HDR(con, con_itbl, cap->r.rCCCS); - // Note [Data constructor dynamic tags] - // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - // compute the pointer tag for the constructor and tag the pointer - // - // - 1..(TAG_MASK-1): for first TAG_MASK-1 constructors - // - TAG_MASK: look in info table - // - // Note: we need to update this if we change the tagging strategy - // - // For full details of the invariants on tagging, see - // https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/haskell-execution/pointer-tagging - - StgClosure* tagged_con = TAG_CLOSURE(stg_min(TAG_MASK, 1 + GET_TAG(con)), con); + StgClosure* tagged_con = tagConstr(con); SpW(0) = (W_)tagged_con; IF_DEBUG(interpreter, @@ -1721,60 +1723,54 @@ run_BCO: } case bci_TESTLT_I: { - // There should be an Int at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - I_ stackInt = (I_)SpW(1); + I_ stackInt = (I_)SpW(0); if (stackInt >= (I_)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_I64: { - // There should be an Int64 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt64 stackInt = (*(StgInt64*)Sp_plusW(1)); + StgInt64 stackInt = (*(StgInt64*)Sp); if (stackInt >= BCO_LITI64(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_I32: { - // There should be an Int32 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt32 stackInt = (*(StgInt32*)Sp_plusW(1)); + StgInt32 stackInt = (*(StgInt32*)Sp); if (stackInt >= (StgInt32)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_I16: { - // There should be an Int16 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt16 stackInt = (*(StgInt16*)Sp_plusW(1)); + StgInt16 stackInt = (*(StgInt16*)Sp); if (stackInt >= (StgInt16)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_I8: { - // There should be an Int8 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt8 stackInt = (*(StgInt8*)Sp_plusW(1)); + StgInt8 stackInt = (*(StgInt8*)Sp); if (stackInt >= (StgInt8)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTEQ_I: { - // There should be an Int at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - I_ stackInt = (I_)SpW(1); + I_ stackInt = (I_)SpW(0); if (stackInt != (I_)BCO_LIT(discr)) { bciPtr = failto; } @@ -1782,10 +1778,9 @@ run_BCO: } case bci_TESTEQ_I64: { - // There should be an Int64 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt64 stackInt = (*(StgInt64*)Sp_plusW(1)); + StgInt64 stackInt = (*(StgInt64*)Sp); if (stackInt != BCO_LITI64(discr)) { bciPtr = failto; } @@ -1793,10 +1788,9 @@ run_BCO: } case bci_TESTEQ_I32: { - // There should be an Int32 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt32 stackInt = (*(StgInt32*)Sp_plusW(1)); + StgInt32 stackInt = (*(StgInt32*)Sp); if (stackInt != (StgInt32)BCO_LIT(discr)) { bciPtr = failto; } @@ -1804,10 +1798,9 @@ run_BCO: } case bci_TESTEQ_I16: { - // There should be an Int16 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt16 stackInt = (*(StgInt16*)Sp_plusW(1)); + StgInt16 stackInt = (*(StgInt16*)Sp); if (stackInt != (StgInt16)BCO_LIT(discr)) { bciPtr = failto; } @@ -1815,10 +1808,9 @@ run_BCO: } case bci_TESTEQ_I8: { - // There should be an Int8 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgInt8 stackInt = (*(StgInt8*)Sp_plusW(1)); + StgInt8 stackInt = (*(StgInt8*)Sp); if (stackInt != (StgInt8)BCO_LIT(discr)) { bciPtr = failto; } @@ -1826,60 +1818,54 @@ run_BCO: } case bci_TESTLT_W: { - // There should be a Word at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - W_ stackWord = (W_)SpW(1); + W_ stackWord = (W_)SpW(0); if (stackWord >= (W_)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_W64: { - // There should be a Word64 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord64 stackWord = (*(StgWord64*)Sp_plusW(1)); + StgWord64 stackWord = (*(StgWord64*)Sp); if (stackWord >= BCO_LITW64(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_W32: { - // There should be a Word32 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord32 stackWord = (*(StgWord32*)Sp_plusW(1)); + StgWord32 stackWord = (*(StgWord32*)Sp); if (stackWord >= (StgWord32)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_W16: { - // There should be a Word16 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord16 stackWord = (*(StgWord16*)Sp_plusW(1)); + StgWord16 stackWord = (*(StgWord16*)Sp); if (stackWord >= (StgWord16)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTLT_W8: { - // There should be a Word8 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord8 stackWord = (*(StgWord8*)Sp_plusW(1)); + StgWord8 stackWord = (*(StgWord8*)Sp); if (stackWord >= (StgWord8)BCO_LIT(discr)) bciPtr = failto; goto nextInsn; } case bci_TESTEQ_W: { - // There should be a Word at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - W_ stackWord = (W_)SpW(1); + W_ stackWord = (W_)SpW(0); if (stackWord != (W_)BCO_LIT(discr)) { bciPtr = failto; } @@ -1887,10 +1873,9 @@ run_BCO: } case bci_TESTEQ_W64: { - // There should be a Word64 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord64 stackWord = (*(StgWord64*)Sp_plusW(1)); + StgWord64 stackWord = (*(StgWord64*)Sp); if (stackWord != BCO_LITW64(discr)) { bciPtr = failto; } @@ -1898,10 +1883,9 @@ run_BCO: } case bci_TESTEQ_W32: { - // There should be a Word32 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord32 stackWord = (*(StgWord32*)Sp_plusW(1)); + StgWord32 stackWord = (*(StgWord32*)Sp); if (stackWord != (StgWord32)BCO_LIT(discr)) { bciPtr = failto; } @@ -1909,10 +1893,9 @@ run_BCO: } case bci_TESTEQ_W16: { - // There should be a Word16 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord16 stackWord = (*(StgWord16*)Sp_plusW(1)); + StgWord16 stackWord = (*(StgWord16*)Sp); if (stackWord != (StgWord16)BCO_LIT(discr)) { bciPtr = failto; } @@ -1920,10 +1903,9 @@ run_BCO: } case bci_TESTEQ_W8: { - // There should be a Word8 at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; - StgWord8 stackWord = (*(StgWord8*)Sp_plusW(1)); + StgWord8 stackWord = (*(StgWord8*)Sp); if (stackWord != (StgWord8)BCO_LIT(discr)) { bciPtr = failto; } @@ -1931,11 +1913,10 @@ run_BCO: } case bci_TESTLT_D: { - // There should be a Double at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgDouble stackDbl, discrDbl; - stackDbl = PK_DBL( & SpW(1) ); + stackDbl = PK_DBL( & SpW(0) ); discrDbl = PK_DBL( & BCO_LIT(discr) ); if (stackDbl >= discrDbl) { bciPtr = failto; @@ -1944,11 +1925,10 @@ run_BCO: } case bci_TESTEQ_D: { - // There should be a Double at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgDouble stackDbl, discrDbl; - stackDbl = PK_DBL( & SpW(1) ); + stackDbl = PK_DBL( & SpW(0) ); discrDbl = PK_DBL( & BCO_LIT(discr) ); if (stackDbl != discrDbl) { bciPtr = failto; @@ -1957,11 +1937,10 @@ run_BCO: } case bci_TESTLT_F: { - // There should be a Float at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgFloat stackFlt, discrFlt; - stackFlt = PK_FLT( & SpW(1) ); + stackFlt = PK_FLT( & SpW(0) ); discrFlt = PK_FLT( & BCO_LIT(discr) ); if (stackFlt >= discrFlt) { bciPtr = failto; @@ -1970,11 +1949,10 @@ run_BCO: } case bci_TESTEQ_F: { - // There should be a Float at SpW(1), and an info table at SpW(0). int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgFloat stackFlt, discrFlt; - stackFlt = PK_FLT( & SpW(1) ); + stackFlt = PK_FLT( & SpW(0) ); discrFlt = PK_FLT( & BCO_LIT(discr) ); if (stackFlt != discrFlt) { bciPtr = failto; @@ -1995,40 +1973,36 @@ run_BCO: } goto eval; - case bci_RETURN: + case bci_RETURN_P: tagged_obj = (StgClosure *)SpW(0); Sp_addW(1); - goto do_return; + goto do_return_pointer; - case bci_RETURN_P: - Sp_subW(1); - SpW(0) = (W_)&stg_ret_p_info; - goto do_return_unlifted; case bci_RETURN_N: Sp_subW(1); SpW(0) = (W_)&stg_ret_n_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_F: Sp_subW(1); SpW(0) = (W_)&stg_ret_f_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_D: Sp_subW(1); SpW(0) = (W_)&stg_ret_d_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_L: Sp_subW(1); SpW(0) = (W_)&stg_ret_l_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_V: Sp_subW(1); SpW(0) = (W_)&stg_ret_v_info; - goto do_return_unlifted; + goto do_return_nonpointer; case bci_RETURN_T: { /* tuple_info and tuple_bco must already be on the stack */ Sp_subW(1); SpW(0) = (W_)&stg_ret_t_info; - goto do_return_unlifted; + goto do_return_nonpointer; } case bci_SWIZZLE: { ===================================== rts/Printer.c ===================================== @@ -652,8 +652,6 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) if (c == (StgWord)&stg_ctoi_R1p_info) { debugBelch("stg_ctoi_R1p_info" ); - } else if (c == (StgWord)&stg_ctoi_R1unpt_info) { - debugBelch("stg_ctoi_R1unpt_info" ); } else if (c == (StgWord)&stg_ctoi_R1n_info) { debugBelch("stg_ctoi_R1n_info" ); } else if (c == (StgWord)&stg_ctoi_F1_info) { ===================================== rts/StgMiscClosures.cmm ===================================== @@ -147,18 +147,6 @@ stg_interp_constr7_entry (P_ ret) { return (ret + 7); } INFO_TABLE_RET( stg_ctoi_R1p, RET_BCO) /* explicit stack */ -{ - Sp_adj(-2); - Sp(1) = R1; - Sp(0) = stg_enter_info; - jump stg_yield_to_interpreter []; -} - -/* - * When the returned value is a pointer, but unlifted, in R1 ... - */ -INFO_TABLE_RET( stg_ctoi_R1unpt, RET_BCO ) - /* explicit stack */ { Sp_adj(-2); Sp(1) = R1; ===================================== rts/include/rts/Bytecodes.h ===================================== @@ -34,7 +34,6 @@ #define bci_PUSH16_W 9 #define bci_PUSH32_W 10 #define bci_PUSH_G 11 -#define bci_PUSH_ALTS 12 #define bci_PUSH_ALTS_P 13 #define bci_PUSH_ALTS_N 14 #define bci_PUSH_ALTS_F 15 @@ -81,7 +80,6 @@ #define bci_CCALL 56 #define bci_SWIZZLE 57 #define bci_ENTER 58 -#define bci_RETURN 59 #define bci_RETURN_P 60 #define bci_RETURN_N 61 #define bci_RETURN_F 62 ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -82,7 +82,6 @@ RTS_RET(stg_prompt_frame); /* Magic glue code for when compiled code returns a value in R1/F1/D1 or a VoidRep to the interpreter. */ RTS_RET(stg_ctoi_R1p); -RTS_RET(stg_ctoi_R1unpt); RTS_RET(stg_ctoi_R1n); RTS_RET(stg_ctoi_F1); RTS_RET(stg_ctoi_D1); ===================================== testsuite/tests/ghci/should_run/T22958a.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +import GHC.Exts +import GHC.IO + +unit :: () +unit = () + +i :: State# RealWorld -> (# State# RealWorld, () #) +i s = case seq# unit s of (# s', a #) -> (# s', a #) + +bad :: IO () +bad = IO i + +main :: IO () +main = bad >>= print ===================================== testsuite/tests/ghci/should_run/T22958a.stdout ===================================== @@ -0,0 +1 @@ +() ===================================== testsuite/tests/ghci/should_run/T22958b.hs ===================================== @@ -0,0 +1,25 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedDatatypes #-} +import GHC.Exts + +type D1 :: TYPE (BoxedRep Unlifted) +data D1 = MkD1 !Int + +showD1 :: D1 -> String +showD1 (MkD1 i) = "MkD1 " ++ show i + +type D2 :: TYPE (BoxedRep Lifted) +data D2 = MkD2 !Int deriving stock Show + +risky :: forall {r} (a :: TYPE (BoxedRep Unlifted)) (b :: TYPE r). a -> b +risky = unsafeCoerce# +{-# NOINLINE risky #-} + +main :: IO () +main = do + putStrLn (showD1 (unsafeCoerce# (MkD1 11))) -- foo11 + print (unsafeCoerce# (MkD1 12) :: D2) -- foo12 + putStrLn (showD1 (risky (MkD1 11))) -- bar11 + print (risky (MkD1 12) :: D2) -- bar12 ===================================== testsuite/tests/ghci/should_run/T22958b.stdout ===================================== @@ -0,0 +1,4 @@ +MkD1 11 +MkD2 12 +MkD1 11 +MkD2 12 ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -88,3 +88,5 @@ test('UnliftedDataType2', just_ghci, compile_and_run, ['']) test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], compile_and_run, ['']) test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script']) +test('T22958a', just_ghci, compile_and_run, ['']) +test('T22958b', just_ghci, compile_and_run, ['']) ===================================== testsuite/tests/simplCore/should_compile/T23307.hs ===================================== @@ -0,0 +1,5 @@ +module T23307 where + +data Stream a = Nil | Cons a !(Stream a) +data Unconsed a = Unconsed a !(Stream a) +data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) ===================================== testsuite/tests/simplCore/should_compile/T23307.stderr ===================================== @@ -0,0 +1,72 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 29, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307.$WYes [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> MUnconsed a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307.Yes @a unbx unbx1 + }}] +T23307.$WYes + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307.Yes @a unbx unbx1 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307.$WUnconsed [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> Stream a %1 -> Unconsed a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Unconsed @a conrep conrep2 + }}] +T23307.$WUnconsed + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Unconsed @a conrep conrep2 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307.$WCons [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> Stream a %1 -> Stream a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Cons @a conrep conrep2 + }}] +T23307.$WCons + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Cons @a conrep conrep2 + } + + + ===================================== testsuite/tests/simplCore/should_compile/T23307a.hs ===================================== @@ -0,0 +1,7 @@ +module T23307a where + +data List a = Nil | Cons {-# UNPACK #-} !(Unconsed a) + -- This UNPACK should work + +data Unconsed a = Unconsed a !(List a) +data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/T23307a.stderr ===================================== @@ -0,0 +1,68 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 28, types: 41, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307a.$WYes [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> MUnconsed a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Yes @a unbx unbx1 + }}] +T23307a.$WYes + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Yes @a unbx unbx1 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307a.$WUnconsed [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> List a %1 -> Unconsed a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: List a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307a.Unconsed @a conrep conrep2 + }}] +T23307a.$WUnconsed + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: List a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307a.Unconsed @a conrep conrep2 + } + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307a.$WCons [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> List a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Cons @a unbx unbx1 + }}] +T23307a.$WCons + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Cons @a unbx unbx1 + } + + + ===================================== testsuite/tests/simplCore/should_compile/T23307b.hs ===================================== @@ -0,0 +1,7 @@ +module Foo where + +-- It's easy to get an infinite loop +-- when deciding what to unbox here. + +data T = MkT !S Int +data S = MkS !T \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/T23307c.hs ===================================== @@ -0,0 +1,7 @@ +module Foo where + +newtype Identity x = MkId x +newtype Fix f = MkFix (f (Fix f)) + +-- This test just checks that the compiler itself doesn't loop +data Loop = LCon {-# UNPACK #-} !(Fix Identity) ===================================== testsuite/tests/simplCore/should_compile/T23307c.stderr ===================================== @@ -0,0 +1,5 @@ + +T23307c.hs:7:13: warning: [GHC-40091] + • Ignoring unusable UNPACK pragma on the first argument of ‘LCon’ + • In the definition of data constructor ‘LCon’ + In the data type declaration for ‘Loop’ ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -479,3 +479,8 @@ test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) test('T23362', normal, compile, ['-O']) +test('T23307', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T23307b', normal, compile, ['-O']) +test('T23307c', normal, compile, ['-O']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/639c12e0e9c565d99d210c4653a27ced2f92760a...f77a8c0295986c0e7d636741a5eeb61bb5e668df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/639c12e0e9c565d99d210c4653a27ced2f92760a...f77a8c0295986c0e7d636741a5eeb61bb5e668df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 17:20:21 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Sat, 13 May 2023 13:20:21 -0400 Subject: [Git][ghc/ghc][wip/amg/dcoercion] Directed coercions Message-ID: <645fc6d597af0_171ad91d17c7cc344151@gitlab.mail> sheaf pushed to branch wip/amg/dcoercion at Glasgow Haskell Compiler / GHC Commits: 6bb5d279 by Adam Gundry at 2023-05-13T18:43:16+02:00 Directed coercions This patch introduces a slimmer version of coercions, directed coercions, which store fewer types within them. This more compact representation considerably speeds up programs which involve many type family reductions, as the coercion size no longer grows quadratically in the number of reduction steps. ------------------------- Metric Decrease: LargeRecord T12227 T12545 T13386 T3064 T5030 T8095 T9872a T9872b T9872b_defer T9872c T9872d Metric Increase: CoOpt_Singletons T18223 T9872a T9872b T9872c T9872d ------------------------- - - - - - 9 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - + compiler/GHC/Core/FamInstEnv.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6bb5d279e5132e73ad1823d645b10c451264aa78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6bb5d279e5132e73ad1823d645b10c451264aa78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 18:58:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 13 May 2023 14:58:52 -0400 Subject: [Git][ghc/ghc][master] Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever Message-ID: <645fddec2e3a5_171ad92274fe243631a3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - 9 changed files: - compiler/GHC/Types/Id/Make.hs - + testsuite/tests/simplCore/should_compile/T23307.hs - + testsuite/tests/simplCore/should_compile/T23307.stderr - + testsuite/tests/simplCore/should_compile/T23307a.hs - + testsuite/tests/simplCore/should_compile/T23307a.stderr - + testsuite/tests/simplCore/should_compile/T23307b.hs - + testsuite/tests/simplCore/should_compile/T23307c.hs - + testsuite/tests/simplCore/should_compile/T23307c.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -1053,8 +1053,7 @@ dataConSrcToImplBang bang_opts fam_envs arg_ty arg_ty' = case mb_co of { Just redn -> scaledSet arg_ty (reductionReducedType redn) ; Nothing -> arg_ty } - , all (not . isNewTyCon . fst) (splitTyConApp_maybe $ scaledThing arg_ty') - , shouldUnpackTy bang_opts unpk_prag fam_envs arg_ty' + , shouldUnpackArgTy bang_opts unpk_prag fam_envs arg_ty' = if bang_opt_unbox_disable bang_opts then HsStrict True -- Not unpacking because of -O0 -- See Note [Detecting useless UNPACK pragmas] in GHC.Core.DataCon @@ -1329,69 +1328,95 @@ mkUbxSumAltTy :: [Type] -> Type mkUbxSumAltTy [ty] = ty mkUbxSumAltTy tys = mkTupleTy Unboxed tys -shouldUnpackTy :: BangOpts -> SrcUnpackedness -> FamInstEnvs -> Scaled Type -> Bool +shouldUnpackArgTy :: BangOpts -> SrcUnpackedness -> FamInstEnvs -> Scaled Type -> Bool -- True if we ought to unpack the UNPACK the argument type -- See Note [Recursive unboxing] -- We look "deeply" inside rather than relying on the DataCons -- we encounter on the way, because otherwise we might well -- end up relying on ourselves! -shouldUnpackTy bang_opts prag fam_envs ty - | Just data_cons <- unpackable_type_datacons (scaledThing ty) - = all (ok_con_args emptyNameSet) data_cons && should_unpack data_cons +shouldUnpackArgTy bang_opts prag fam_envs arg_ty + | Just data_cons <- unpackable_type_datacons (scaledThing arg_ty) + , all ok_con data_cons -- Returns True only if we can't get a + -- loop involving these data cons + , should_unpack prag arg_ty data_cons -- ...hence the call to dataConArgUnpack in + -- should_unpack won't loop + -- See Wrinkle (W1b) of Note [Recursive unboxing] for this loopy stuff + = True + | otherwise = False where - ok_con_args :: NameSet -> DataCon -> Bool - ok_con_args dcs con - | dc_name `elemNameSet` dcs - = False - | otherwise - = all (ok_arg dcs') - (dataConOrigArgTys con `zip` dataConSrcBangs con) - -- NB: dataConSrcBangs gives the *user* request; - -- We'd get a black hole if we used dataConImplBangs + ok_con :: DataCon -> Bool -- True <=> OK to unpack + ok_con top_con -- False <=> not safe + = ok_args emptyNameSet top_con where - dc_name = getName con - dcs' = dcs `extendNameSet` dc_name - - ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool - ok_arg dcs (Scaled _ ty, bang) - = not (attempt_unpack bang) || ok_ty dcs norm_ty - where - norm_ty = topNormaliseType fam_envs ty + top_con_name = getName top_con - ok_ty :: NameSet -> Type -> Bool - ok_ty dcs ty - | Just data_cons <- unpackable_type_datacons ty - = all (ok_con_args dcs) data_cons - | otherwise - = True -- NB True here, in contrast to False at top level - - attempt_unpack :: HsSrcBang -> Bool - attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict) - = bang_opt_strict_data bang_opts - attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict) - = True - attempt_unpack (HsSrcBang _ NoSrcUnpack SrcStrict) - = True -- Be conservative - attempt_unpack (HsSrcBang _ NoSrcUnpack NoSrcStrict) - = bang_opt_strict_data bang_opts -- Be conservative - attempt_unpack _ = False - - -- Determine whether we ought to unpack a field based on user annotations if present and heuristics if not. - should_unpack data_cons = + ok_args dcs con + = all (ok_arg dcs) $ + (dataConOrigArgTys con `zip` dataConSrcBangs con) + -- NB: dataConSrcBangs gives the *user* request; + -- We'd get a black hole if we used dataConImplBangs + + ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool + ok_arg dcs (Scaled _ ty, HsSrcBang _ unpack_prag str_prag) + | strict_field str_prag + , Just data_cons <- unpackable_type_datacons (topNormaliseType fam_envs ty) + , should_unpack_conservative unpack_prag data_cons -- Wrinkle (W3) + = all (ok_rec_con dcs) data_cons -- of Note [Recursive unboxing] + | otherwise + = True -- NB True here, in contrast to False at top level + + -- See Note [Recursive unboxing] + -- * Do not look at the HsImplBangs to `con`; see Wrinkle (W1a) + -- * For the "at the root" comments see Wrinkle (W2) + ok_rec_con dcs con + | dc_name == top_con_name = False -- Recursion at the root + | dc_name `elemNameSet` dcs = True -- Not at the root + | otherwise = ok_args (dcs `extendNameSet` dc_name) con + where + dc_name = getName con + + strict_field :: SrcStrictness -> Bool + -- True <=> strict field + strict_field NoSrcStrict = bang_opt_strict_data bang_opts + strict_field SrcStrict = True + strict_field SrcLazy = False + + -- Determine whether we ought to unpack a field, + -- based on user annotations if present. + -- A conservative version of should_unpack that doesn't look at how + -- many fields the field would unpack to... because that leads to a loop. + -- "Conservative" = err on the side of saying "yes". + should_unpack_conservative :: SrcUnpackedness -> [DataCon] -> Bool + should_unpack_conservative SrcNoUnpack _ = False -- {-# NOUNPACK #-} + should_unpack_conservative SrcUnpack _ = True -- {-# NOUNPACK #-} + should_unpack_conservative NoSrcUnpack dcs = not (is_sum dcs) + -- is_sum: we never unpack sums without a pragma; otherwise be conservative + + -- Determine whether we ought to unpack a field, + -- based on user annotations if present, and heuristics if not. + should_unpack :: SrcUnpackedness -> Scaled Type -> [DataCon] -> Bool + should_unpack prag arg_ty data_cons = case prag of SrcNoUnpack -> False -- {-# NOUNPACK #-} SrcUnpack -> True -- {-# UNPACK #-} NoSrcUnpack -- No explicit unpack pragma, so use heuristics - | (_:_:_) <- data_cons - -> False -- don't unpack sum types automatically, but they can be unpacked with an explicit source UNPACK. - | otherwise + | is_sum data_cons + -> False -- Don't unpack sum types automatically, but they can + -- be unpacked with an explicit source UNPACK. + | otherwise -- Wrinkle (W4) of Note [Recursive unboxing] -> bang_opt_unbox_strict bang_opts || (bang_opt_unbox_small bang_opts && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields] - where (rep_tys, _) = dataConArgUnpack ty + where + (rep_tys, _) = dataConArgUnpack arg_ty + is_sum :: [DataCon] -> Bool + -- We never unpack sum types automatically + -- (Product types, we do. Empty types are weeded out by unpackable_type_datacons.) + is_sum (_:_:_) = True + is_sum _ = False -- Given a type already assumed to have been normalized by topNormaliseType, -- unpackable_type_datacons ty = Just datacons @@ -1403,11 +1428,11 @@ shouldUnpackTy bang_opts prag fam_envs ty unpackable_type_datacons :: Type -> Maybe [DataCon] unpackable_type_datacons ty | Just (tc, _) <- splitTyConApp_maybe ty - , not (isNewTyCon tc) - -- Even though `ty` has been normalised, it could still - -- be a /recursive/ newtype, so we must check for that + , not (isNewTyCon tc) -- Even though `ty` has been normalised, it could still + -- be a /recursive/ newtype, so we must check for that , Just cons <- tyConDataCons_maybe tc - , not (null cons) + , not (null cons) -- Don't upack nullary sums; no need. + -- They already take zero bits , all (null . dataConExTyCoVars) cons = Just cons -- See Note [Unpacking GADTs and existentials] | otherwise @@ -1463,21 +1488,75 @@ But be careful not to try to unbox this! data T = MkT {-# UNPACK #-} !T Int Because then we'd get an infinite number of arguments. -Here is a more complicated case: - data S = MkS {-# UNPACK #-} !T Int - data T = MkT {-# UNPACK #-} !S Int -Each of S and T must decide independently whether to unpack -and they had better not both say yes. So they must both say no. - -Also behave conservatively when there is no UNPACK pragma - data T = MkS !T Int -with -funbox-strict-fields or -funbox-small-strict-fields -we need to behave as if there was an UNPACK pragma there. - -But it's the *argument* type that matters. This is fine: +Note that it's the *argument* type that matters. This is fine: data S = MkS S !Int because Int is non-recursive. +Wrinkles: + +(W1a) We have to be careful that the compiler doesn't go into a loop! + First, we must not look at the HsImplBang decisions of data constructors + in the same mutually recursive group. E.g. + data S = MkS {-# UNPACK #-} !T Int + data T = MkT {-# UNPACK #-} !S Int + Each of S and T must decide /independently/ whether to unpack + and they had better not both say yes. So they must both say no. + (We could detect when we leave the group, and /then/ we can rely on + HsImplBangs; but that requires more plumbing.) + +(W1b) Here is another way the compiler might go into a loop (test T23307b): + data data T = MkT !S Int + data S = MkS !T + Suppose we call `shouldUnpackArgTy` on the !S arg of `T`. In `should_unpack` + we ask if the number of fields that `MkS` unpacks to is small enough + (via rep_tys `lengthAtMost` 1). But how many field /does/ `MkS` unpack + to? Well it depends on the unpacking decision we make for `MkS`, which + in turn depends on `MkT`, which we are busy deciding. Black holes beckon. + + So we /first/ call `ok_con` on `MkS` (and `ok_con` is conservative; + see `should_unpack_conservative`), and only /then/ call `should_unpack`. + Tricky! + +(W2) As #23307 shows, we /do/ want to unpack the second arg of the Yes + data constructor in this example, despite the recursion in List: + data Stream a = Cons a !(Stream a) + data Unconsed a = Unconsed a !(Stream a) + data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) + When looking at + {-# UNPACK #-} (Unconsed a) + we can take Unconsed apart, but then get into a loop with Stream. + That's fine: we can still take Unconsed apart. It's only if we + have a loop /at the root/ that we must not unpack. + +(W3) Moreover (W2) can apply even if there is a recursive loop: + data List a = Nil | Cons {-# UNPACK #-} !(Unconsed a) + data Unconsed a = Unconsed a !(List a) + Here there is mutual recursion between `Unconsed` and `List`; and yet + we can unpack the field of `Cons` because we will not unpack the second + field of `Unconsed`: we never unpack a sum type without an explicit + pragma (see should_unpack). + +(W4) Consider + data T = MkT !Wombat + data Wombat = MkW {-# UNPACK #-} !S Int + data S = MkS {-# NOUNPACK #-} !Wombat Int + Suppose we are deciding whether to unpack the first field of MkT, by + calling (shouldUnpackArgTy Wombat). Then we'll try to unpack the !S field + of MkW, and be stopped by the {-# NOUNPACK #-}, and all is fine; we can + unpack MkT. + + If that NOUNPACK had been a UNPACK, though, we'd get a loop, and would + decide not to unpack the Wombat field of MkT. + + But what if there was no pragma in `data S`? Then we /still/ decide not + to unpack the Wombat field of MkT (at least when auto-unpacking is on), + because we don't know for sure which decision will be taken for the + Wombat field of MkS. + + TL;DR when there is no pragma, behave as if there was a UNPACK, at least + when auto-unpacking is on. See `should_unpack` in `shouldUnpackArgTy`. + + ************************************************************************ * * Wrapping and unwrapping newtypes and type families ===================================== testsuite/tests/simplCore/should_compile/T23307.hs ===================================== @@ -0,0 +1,5 @@ +module T23307 where + +data Stream a = Nil | Cons a !(Stream a) +data Unconsed a = Unconsed a !(Stream a) +data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) ===================================== testsuite/tests/simplCore/should_compile/T23307.stderr ===================================== @@ -0,0 +1,72 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 29, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307.$WYes [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> MUnconsed a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307.Yes @a unbx unbx1 + }}] +T23307.$WYes + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307.Yes @a unbx unbx1 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307.$WUnconsed [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> Stream a %1 -> Unconsed a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Unconsed @a conrep conrep2 + }}] +T23307.$WUnconsed + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Unconsed @a conrep conrep2 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307.$WCons [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> Stream a %1 -> Stream a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Cons @a conrep conrep2 + }}] +T23307.$WCons + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Cons @a conrep conrep2 + } + + + ===================================== testsuite/tests/simplCore/should_compile/T23307a.hs ===================================== @@ -0,0 +1,7 @@ +module T23307a where + +data List a = Nil | Cons {-# UNPACK #-} !(Unconsed a) + -- This UNPACK should work + +data Unconsed a = Unconsed a !(List a) +data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/T23307a.stderr ===================================== @@ -0,0 +1,68 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 28, types: 41, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307a.$WYes [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> MUnconsed a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Yes @a unbx unbx1 + }}] +T23307a.$WYes + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Yes @a unbx unbx1 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307a.$WUnconsed [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> List a %1 -> Unconsed a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: List a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307a.Unconsed @a conrep conrep2 + }}] +T23307a.$WUnconsed + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: List a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307a.Unconsed @a conrep conrep2 + } + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307a.$WCons [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> List a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Cons @a unbx unbx1 + }}] +T23307a.$WCons + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Cons @a unbx unbx1 + } + + + ===================================== testsuite/tests/simplCore/should_compile/T23307b.hs ===================================== @@ -0,0 +1,7 @@ +module Foo where + +-- It's easy to get an infinite loop +-- when deciding what to unbox here. + +data T = MkT !S Int +data S = MkS !T \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/T23307c.hs ===================================== @@ -0,0 +1,7 @@ +module Foo where + +newtype Identity x = MkId x +newtype Fix f = MkFix (f (Fix f)) + +-- This test just checks that the compiler itself doesn't loop +data Loop = LCon {-# UNPACK #-} !(Fix Identity) ===================================== testsuite/tests/simplCore/should_compile/T23307c.stderr ===================================== @@ -0,0 +1,5 @@ + +T23307c.hs:7:13: warning: [GHC-40091] + • Ignoring unusable UNPACK pragma on the first argument of ‘LCon’ + • In the definition of data constructor ‘LCon’ + In the data type declaration for ‘Loop’ ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -479,3 +479,8 @@ test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) test('T23362', normal, compile, ['-O']) +test('T23307', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T23307b', normal, compile, ['-O']) +test('T23307c', normal, compile, ['-O']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/902f0730b4c50f39b7767a346be324c98bf7a8a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/902f0730b4c50f39b7767a346be324c98bf7a8a6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 18:59:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 13 May 2023 14:59:31 -0400 Subject: [Git][ghc/ghc][master] Fix bad multiplicity role in tyConAppFunCo_maybe Message-ID: <645fde13db3df_171ad920f9a5a43681cb@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 3 changed files: - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/Type.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs-boot ===================================== @@ -36,6 +36,8 @@ mkSubCo :: HasDebugCallStack => Coercion -> Coercion mkProofIrrelCo :: Role -> Coercion -> Coercion -> Coercion -> Coercion mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion +funRole :: Role -> FunSel -> Role + isGReflCo :: Coercion -> Bool isReflCo :: Coercion -> Bool isReflexiveCo :: Coercion -> Bool ===================================== compiler/GHC/Core/TyCo/Rep.hs-boot ===================================== @@ -8,6 +8,7 @@ import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) data Type data Coercion +data FunSel data CoSel data UnivCoProvenance data TyLit ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -274,7 +274,7 @@ import {-# SOURCE #-} GHC.Core.Coercion , mkTyConAppCo, mkAppCo , mkForAllCo, mkFunCo2, mkAxiomInstCo, mkUnivCo , mkSymCo, mkTransCo, mkSelCo, mkLRCo, mkInstCo - , mkKindCo, mkSubCo, mkFunCo + , mkKindCo, mkSubCo, mkFunCo, funRole , decomposePiCos, coercionKind , coercionRKind, coercionType , isReflexiveCo, seqCo @@ -1331,9 +1331,12 @@ tyConAppFunCo_maybe :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Maybe Coercion -- ^ Return Just if this TyConAppCo should be represented as a FunCo tyConAppFunCo_maybe r tc cos - | Just (af, mult, arg, res) <- ty_con_app_fun_maybe (mkReflCo r manyDataConTy) tc cos - = Just (mkFunCo r af mult arg res) - | otherwise = Nothing + | Just (af, mult, arg, res) <- ty_con_app_fun_maybe mult_refl tc cos + = Just (mkFunCo r af mult arg res) + | otherwise + = Nothing + where + mult_refl = mkReflCo (funRole r SelMult) manyDataConTy ty_con_app_fun_maybe :: (HasDebugCallStack, Outputable a) => a -> TyCon -> [a] -> Maybe (FunTyFlag, a, a, a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5451438bcf3a912910e7c2a5d40dfedfa7d1a4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5451438bcf3a912910e7c2a5d40dfedfa7d1a4a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 23:21:09 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 13 May 2023 19:21:09 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] 28 commits: rts: Ensure non-moving gc is not running when pausing Message-ID: <64601b6573ec6_171ad92acc8de44194f6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 085e7dff by Simon Peyton Jones at 2023-05-14T00:21:01+01:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of GHC.Tc.Solver.Equality. I also added the new type IrredCt (akin to EqCt). Still to come: DictCt. - - - - - 59a3e961 by Simon Peyton Jones at 2023-05-14T00:21:01+01:00 Further refactoring In particular make the Irred pipeline one-stage (Just the Dict pipeline is left) - - - - - dfc7f0fd by Simon Peyton Jones at 2023-05-14T00:21:01+01:00 Wibbles - - - - - 977910bb by Simon Peyton Jones at 2023-05-14T00:21:01+01:00 Wibble2 - - - - - 7da35a17 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 Begin on the type-class pipeline - - - - - f1e190d6 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 Progress - - - - - 54fb6e43 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 Wibbles - - - - - 736400f7 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 Remove white space - - - - - b5aa4631 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 More progress - - - - - ba4b1aae by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 More - - - - - 33d50330 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 Add GHC.Tc.Solver.Solve - - - - - 3bd1588c by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 Fixes - - - - - a468972b by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 Wibbles - - - - - b5fefe72 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 Fixes - - - - - 70893d76 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 More wibbles - - - - - f2a4bc51 by Simon Peyton Jones at 2023-05-14T00:21:02+01:00 More fixes - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/278d5c57490b23439e71917919800f4a0fac9725...f2a4bc5126b726710e5cb625a5d6869a9f4229eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/278d5c57490b23439e71917919800f4a0fac9725...f2a4bc5126b726710e5cb625a5d6869a9f4229eb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 13 23:28:57 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 13 May 2023 19:28:57 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Add the SolverStage monad Message-ID: <64601d3924398_171ad92a9b9fe0419778@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: b235552b by Simon Peyton Jones at 2023-05-14T00:27:38+01:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of GHC.Tc.Solver.Equality. I also added the new types (akin to EqCt). IrredCt DictCt New module GHC.Tc.Solver.Solve Killed off: GHC.Tc.Solver.Canonical GHC.Tc.Solver.Interact Better commit message to come - - - - - 21 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b235552bb0385292102c6fd9212dcf86d5caf53f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b235552bb0385292102c6fd9212dcf86d5caf53f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 14 13:24:56 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Sun, 14 May 2023 09:24:56 -0400 Subject: [Git][ghc/ghc][wip/ghc-driver-dynflags] Split DynFlags structure into own module Message-ID: <6460e128d7801_171ad945e58108518532@gitlab.mail> Oleg Grenrus pushed to branch wip/ghc-driver-dynflags at Glasgow Haskell Compiler / GHC Commits: 44253891 by Oleg Grenrus at 2023-05-14T16:07:21+03:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 25 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/State.hs - compiler/ghc.cabal.in - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -26,7 +26,7 @@ import qualified Text.ParserCombinators.ReadP as P import GHC.Prelude import GHC.Utils.Outputable as Outputable -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.CostCentre import GHC.Types.CostCentre.State import GHC.Types.Name hiding (varName) ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Core.Opt.Monad ( import GHC.Prelude hiding ( read ) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv ) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Unit.Module.Env import GHC.Unit.Module.ModGuts( ModGuts(..) ) import GHC.Unit.Module.Deps( Dependencies(..) ) -import GHC.Driver.Session( DynFlags ) +import GHC.Driver.DynFlags( DynFlags ) import GHC.Driver.Ppr( showSDoc ) import GHC.Core -- All of it ===================================== compiler/GHC/Data/IOEnv.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Data.IOEnv ( import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Hooks import GHC.IO (catchException) import GHC.Utils.Exception ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Driver.Config.Diagnostic where import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Prelude import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Config/Logger.hs ===================================== @@ -5,7 +5,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Logger (LogFlags (..)) import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -0,0 +1,1520 @@ +{-# LANGUAGE LambdaCase #-} +module GHC.Driver.DynFlags ( + -- * Dynamic flags and associated configuration types + DumpFlag(..), + GeneralFlag(..), + WarningFlag(..), DiagnosticReason(..), + Language(..), + FatalMessager, FlushOut(..), + ProfAuto(..), + hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion, + dopt, dopt_set, dopt_unset, + gopt, gopt_set, gopt_unset, + wopt, wopt_set, wopt_unset, + wopt_fatal, wopt_set_fatal, wopt_unset_fatal, + wopt_set_all_custom, wopt_unset_all_custom, + wopt_set_all_fatal_custom, wopt_unset_all_fatal_custom, + wopt_set_custom, wopt_unset_custom, + wopt_set_fatal_custom, wopt_unset_fatal_custom, + wopt_any_custom, + xopt, xopt_set, xopt_unset, + xopt_set_unlessExplSpec, + xopt_DuplicateRecordFields, + xopt_FieldSelectors, + lang_set, + DynamicTooState(..), dynamicTooState, setDynamicNow, + OnOff(..), + DynFlags(..), + ParMakeCount(..), + ways, + HasDynFlags(..), ContainsDynFlags(..), + RtsOptsEnabled(..), + GhcMode(..), isOneShot, + GhcLink(..), isNoLink, + PackageFlag(..), PackageArg(..), ModRenaming(..), + packageFlagsChanged, + IgnorePackageFlag(..), TrustFlag(..), + PackageDBFlag(..), PkgDbRef(..), + Option(..), showOpt, + DynLibLoader(..), + positionIndependent, + optimisationFlags, + + -- ** Manipulating DynFlags + defaultDynFlags, -- Settings -> DynFlags + initDynFlags, -- DynFlags -> IO DynFlags + defaultFatalMessager, + defaultFlushOut, + optLevelFlags, + languageExtensions, + + TurnOnFlag, + turnOn, + turnOff, + + -- ** System tool settings and locations + programName, projectVersion, + ghcUsagePath, ghciUsagePath, topDir, toolDir, + versionedAppDir, versionedFilePath, + extraGccViaCFlags, globalPackageDatabasePath, + + -- * Linker/compiler information + LinkerInfo(..), + CompilerInfo(..), + + -- * Include specifications + IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes, + addImplicitQuoteInclude, + + -- * SDoc + initSDocContext, initDefaultSDocContext, + initPromotionTickContext, +) where + +import GHC.Prelude + +import GHC.Platform +import GHC.Platform.Ways + +import GHC.CmmToAsm.CFG.Weight +import GHC.Core.Unfold +import GHC.Data.Bool +import GHC.Data.EnumSet (EnumSet) +import GHC.Data.Maybe +import GHC.Builtin.Names ( mAIN_NAME ) +import GHC.Driver.Backend +import GHC.Driver.Flags +import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.Plugins.External +import GHC.Settings +import GHC.Settings.Constants +import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) +import GHC.Types.Error (DiagnosticReason(..)) +import GHC.Types.ProfAuto +import GHC.Types.SafeHaskell +import GHC.Types.SrcLoc +import GHC.Unit.Module +import GHC.Unit.Module.Warnings +import GHC.Utils.CliOption +import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) +import GHC.UniqueSubdir (uniqueSubdir) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.TmpFs + +import qualified GHC.Types.FieldLabel as FieldLabel +import qualified GHC.Utils.Ppr.Colour as Col +import qualified GHC.Data.EnumSet as EnumSet + +import {-# SOURCE #-} GHC.Core.Opt.CallerCC + +import Control.Monad (msum, (<=<)) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.Writer (WriterT) +import Data.IORef +import System.IO +import System.IO.Error (catchIOError) +import System.Environment (lookupEnv) +import System.FilePath (normalise, ()) +import System.Directory +import GHC.Foreign (withCString, peekCString) + +import qualified Data.Set as Set + +import qualified GHC.LanguageExtensions as LangExt + +-- ----------------------------------------------------------------------------- +-- DynFlags + +-- | Contains not only a collection of 'GeneralFlag's but also a plethora of +-- information relating to the compilation of a single file or GHC session +data DynFlags = DynFlags { + ghcMode :: GhcMode, + ghcLink :: GhcLink, + backend :: !Backend, + -- ^ The backend to use (if any). + -- + -- Whenever you change the backend, also make sure to set 'ghcLink' to + -- something sensible. + -- + -- 'NoBackend' can be used to avoid generating any output, however, note that: + -- + -- * If a program uses Template Haskell the typechecker may need to run code + -- from an imported module. To facilitate this, code generation is enabled + -- for modules imported by modules that use template haskell, using the + -- default backend for the platform. + -- See Note [-fno-code mode]. + + + -- formerly Settings + ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, + fileSettings :: {-# UNPACK #-} !FileSettings, + targetPlatform :: Platform, -- Filled in by SysTools + toolSettings :: {-# UNPACK #-} !ToolSettings, + platformMisc :: {-# UNPACK #-} !PlatformMisc, + rawSettings :: [(String, String)], + tmpDir :: TempDir, + + llvmOptLevel :: Int, -- ^ LLVM optimisation level + verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] + debugLevel :: Int, -- ^ How much debug information to produce + simplPhases :: Int, -- ^ Number of simplifier phases + maxSimplIterations :: Int, -- ^ Max simplifier iterations + ruleCheck :: Maybe String, + strictnessBefore :: [Int], -- ^ Additional demand analysis + + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. + + enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? + ghcHeapSize :: Maybe Int, -- ^ The heap size to set. + + maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt + -- to show in type error messages + maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show + -- in typed hole error messages + maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole + -- fits to show in typed hole error + -- messages + refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for + -- refinement hole fits in typed hole + -- error messages + maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show + -- in non-exhaustiveness warnings + maxPmCheckModels :: Int, -- ^ Soft limit on the number of models + -- the pattern match checker checks + -- a pattern against. A safe guard + -- against exponential blow-up. + simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks + dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an + -- Unboxed demand on returned products with at most + -- this number of fields + specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr + specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function + specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types + -- Not optional; otherwise ForceSpecConstr can diverge. + binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above + -- this threshold will be dumped in a binary file + -- by the assembler code generator. 0 and Nothing disables + -- this feature. See 'GHC.StgToCmm.Config'. + liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase + floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating + -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' + + liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- recursive function. + liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- non-recursive function. + liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call + -- into an unknown call. + + cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. + + historySize :: Int, -- ^ Simplification history size + + importPaths :: [FilePath], + mainModuleNameIs :: ModuleName, + mainFunIs :: Maybe String, + reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth + solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver + -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + homeUnitId_ :: UnitId, -- ^ Target home unit-id + homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate + homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations + + -- Note [Filepaths and Multiple Home Units] + workingDirectory :: Maybe FilePath, + thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units + hiddenModules :: Set.Set ModuleName, + reexportedModules :: Set.Set ModuleName, + + -- ways + targetWays_ :: Ways, -- ^ Target way flags from the command line + + -- For object splitting + splitInfo :: Maybe (String,Int), + + -- paths etc. + objectDir :: Maybe String, + dylibInstallName :: Maybe String, + hiDir :: Maybe String, + hieDir :: Maybe String, + stubDir :: Maybe String, + dumpDir :: Maybe String, + + objectSuf_ :: String, + hcSuf :: String, + hiSuf_ :: String, + hieSuf :: String, + + dynObjectSuf_ :: String, + dynHiSuf_ :: String, + + outputFile_ :: Maybe String, + dynOutputFile_ :: Maybe String, + outputHi :: Maybe String, + dynOutputHi :: Maybe String, + dynLibLoader :: DynLibLoader, + + dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output + -- because of -dynamic-too. This predicate is + -- used to query the appropriate fields + -- (outputFile/dynOutputFile, ways, etc.) + + -- | This defaults to 'non-module'. It can be set by + -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on + -- where its output is going. + dumpPrefix :: FilePath, + + -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' + -- or 'ghc.GHCi.UI.runStmt'. + -- Set by @-ddump-file-prefix@ + dumpPrefixForce :: Maybe FilePath, + + ldInputs :: [Option], + + includePaths :: IncludeSpecs, + libraryPaths :: [String], + frameworkPaths :: [String], -- used on darwin only + cmdlineFrameworks :: [String], -- ditto + + rtsOpts :: Maybe String, + rtsOptsEnabled :: RtsOptsEnabled, + rtsOptsSuggestions :: Bool, + + hpcDir :: String, -- ^ Path to store the .mix files + + -- Plugins + pluginModNames :: [ModuleName], + -- ^ the @-fplugin@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + pluginModNameOpts :: [(ModuleName,String)], + frontendPluginOpts :: [String], + -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + + externalPluginSpecs :: [ExternalPluginSpec], + -- ^ External plugins loaded from shared libraries + + -- For ghc -M + depMakefile :: FilePath, + depIncludePkgDeps :: Bool, + depIncludeCppDeps :: Bool, + depExcludeMods :: [ModuleName], + depSuffixes :: [String], + + -- Package flags + packageDBFlags :: [PackageDBFlag], + -- ^ The @-package-db@ flags given on the command line, In + -- *reverse* order that they're specified on the command line. + -- This is intended to be applied with the list of "initial" + -- package databases derived from @GHC_PACKAGE_PATH@; see + -- 'getUnitDbRefs'. + + ignorePackageFlags :: [IgnorePackageFlag], + -- ^ The @-ignore-package@ flags from the command line. + -- In *reverse* order that they're specified on the command line. + packageFlags :: [PackageFlag], + -- ^ The @-package@ and @-hide-package@ flags from the command-line. + -- In *reverse* order that they're specified on the command line. + pluginPackageFlags :: [PackageFlag], + -- ^ The @-plugin-package-id@ flags from command line. + -- In *reverse* order that they're specified on the command line. + trustFlags :: [TrustFlag], + -- ^ The @-trust@ and @-distrust@ flags. + -- In *reverse* order that they're specified on the command line. + packageEnv :: Maybe FilePath, + -- ^ Filepath to the package environment file (if overriding default) + + + -- hsc dynamic flags + dumpFlags :: EnumSet DumpFlag, + generalFlags :: EnumSet GeneralFlag, + warningFlags :: EnumSet WarningFlag, + fatalWarningFlags :: EnumSet WarningFlag, + customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] + fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings + -- Don't change this without updating extensionFlags: + language :: Maybe Language, + -- | Safe Haskell mode + safeHaskell :: SafeHaskellMode, + safeInfer :: Bool, + safeInferred :: Bool, + -- We store the location of where some extension and flags were turned on so + -- we can produce accurate error messages when Safe Haskell fails due to + -- them. + thOnLoc :: SrcSpan, + newDerivOnLoc :: SrcSpan, + deriveViaOnLoc :: SrcSpan, + overlapInstLoc :: SrcSpan, + incoherentOnLoc :: SrcSpan, + pkgTrustOnLoc :: SrcSpan, + warnSafeOnLoc :: SrcSpan, + warnUnsafeOnLoc :: SrcSpan, + trustworthyOnLoc :: SrcSpan, + -- Don't change this without updating extensionFlags: + -- Here we collect the settings of the language extensions + -- from the command line, the ghci config file and + -- from interactive :set / :seti commands. + extensions :: [OnOff LangExt.Extension], + -- extensionFlags should always be equal to + -- flattenExtensionFlags language extensions + -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used + -- by template-haskell + extensionFlags :: EnumSet LangExt.Extension, + + -- | Unfolding control + -- See Note [Discounts and thresholds] in GHC.Core.Unfold + unfoldingOpts :: !UnfoldingOpts, + + maxWorkerArgs :: Int, + + ghciHistSize :: Int, + + flushOut :: FlushOut, + + ghcVersionFile :: Maybe FilePath, + haddockOptions :: Maybe String, + + -- | GHCi scripts specified by -ghci-script, in reverse order + ghciScripts :: [String], + + -- Output style options + pprUserLength :: Int, + pprCols :: Int, + + useUnicode :: Bool, + useColor :: OverridingBool, + canUseColor :: Bool, + colScheme :: Col.Scheme, + + -- | what kind of {-# SCC #-} to add automatically + profAuto :: ProfAuto, + callerCcFilters :: [CallerCcFilter], + + interactivePrint :: Maybe String, + + -- | Machine dependent flags (-m\ stuff) + sseVersion :: Maybe SseVersion, + bmiVersion :: Maybe BmiVersion, + avx :: Bool, + avx2 :: Bool, + avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. + avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. + avx512f :: Bool, -- Enable AVX-512 instructions. + avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. + fma :: Bool, -- ^ Enable FMA instructions. + + -- | Run-time linker information (what options we need, etc.) + rtldInfo :: IORef (Maybe LinkerInfo), + + -- | Run-time C compiler information + rtccInfo :: IORef (Maybe CompilerInfo), + + -- | Run-time assembler information + rtasmInfo :: IORef (Maybe CompilerInfo), + + -- Constants used to control the amount of optimization done. + + -- | Max size, in bytes, of inline array allocations. + maxInlineAllocSize :: Int, + + -- | Only inline memcpy if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemcpyInsns :: Int, + + -- | Only inline memset if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemsetInsns :: Int, + + -- | Reverse the order of error messages in GHC/GHCi + reverseErrors :: Bool, + + -- | Limit the maximum number of errors to show + maxErrors :: Maybe Int, + + -- | Unique supply configuration for testing build determinism + initialUnique :: Word, + uniqueIncrement :: Int, + -- 'Int' because it can be used to test uniques in decreasing order. + + -- | Temporary: CFG Edge weights for fast iterations + cfgWeights :: Weights +} + +class HasDynFlags m where + getDynFlags :: m DynFlags + +{- It would be desirable to have the more generalised + + instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where + getDynFlags = lift getDynFlags + +instance definition. However, that definition would overlap with the +`HasDynFlags (GhcT m)` instance. Instead we define instances for a +couple of common Monad transformers explicitly. -} + +instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where + getDynFlags = lift getDynFlags + +class ContainsDynFlags t where + extractDynFlags :: t -> DynFlags + +----------------------------------------------------------------------------- + +-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value +initDynFlags :: DynFlags -> IO DynFlags +initDynFlags dflags = do + let + refRtldInfo <- newIORef Nothing + refRtccInfo <- newIORef Nothing + refRtasmInfo <- newIORef Nothing + canUseUnicode <- do let enc = localeEncoding + str = "‘’" + (withCString enc str $ \cstr -> + do str' <- peekCString enc cstr + return (str == str')) + `catchIOError` \_ -> return False + ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" + let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode + maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" + maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" + let adjustCols (Just env) = Col.parseScheme env + adjustCols Nothing = id + let (useColor', colScheme') = + (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) + (useColor dflags, colScheme dflags) + tmp_dir <- normalise <$> getTemporaryDirectory + return dflags{ + useUnicode = useUnicode', + useColor = useColor', + canUseColor = stderrSupportsAnsiColors, + colScheme = colScheme', + rtldInfo = refRtldInfo, + rtccInfo = refRtccInfo, + rtasmInfo = refRtasmInfo, + tmpDir = TempDir tmp_dir + } + +-- | The normal 'DynFlags'. Note that they are not suitable for use in this form +-- and must be fully initialized by 'GHC.runGhc' first. +defaultDynFlags :: Settings -> DynFlags +defaultDynFlags mySettings = +-- See Note [Updating flag description in the User's Guide] + DynFlags { + ghcMode = CompManager, + ghcLink = LinkBinary, + backend = platformDefaultBackend (sTargetPlatform mySettings), + verbosity = 0, + debugLevel = 0, + simplPhases = 2, + maxSimplIterations = 4, + ruleCheck = Nothing, + binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) + maxRelevantBinds = Just 6, + maxValidHoleFits = Just 6, + maxRefHoleFits = Just 6, + refLevelHoleFits = Nothing, + maxUncoveredPatterns = 4, + maxPmCheckModels = 30, + simplTickFactor = 100, + dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple + specConstrThreshold = Just 2000, + specConstrCount = Just 3, + specConstrRecursive = 3, + liberateCaseThreshold = Just 2000, + floatLamArgs = Just 0, -- Default: float only if no fvs + liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsKnown = False, -- Default: don't turn known calls into unknown ones + cmmProcAlignment = Nothing, + + historySize = 20, + strictnessBefore = [], + + parMakeCount = Nothing, + + enableTimeStats = False, + ghcHeapSize = Nothing, + + importPaths = ["."], + mainModuleNameIs = mAIN_NAME, + mainFunIs = Nothing, + reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, + solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, + + homeUnitId_ = mainUnitId, + homeUnitInstanceOf_ = Nothing, + homeUnitInstantiations_ = [], + + workingDirectory = Nothing, + thisPackageName = Nothing, + hiddenModules = Set.empty, + reexportedModules = Set.empty, + + objectDir = Nothing, + dylibInstallName = Nothing, + hiDir = Nothing, + hieDir = Nothing, + stubDir = Nothing, + dumpDir = Nothing, + + objectSuf_ = phaseInputExt StopLn, + hcSuf = phaseInputExt HCc, + hiSuf_ = "hi", + hieSuf = "hie", + + dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, + dynHiSuf_ = "dyn_hi", + dynamicNow = False, + + pluginModNames = [], + pluginModNameOpts = [], + frontendPluginOpts = [], + + externalPluginSpecs = [], + + outputFile_ = Nothing, + dynOutputFile_ = Nothing, + outputHi = Nothing, + dynOutputHi = Nothing, + dynLibLoader = SystemDependent, + dumpPrefix = "non-module.", + dumpPrefixForce = Nothing, + ldInputs = [], + includePaths = IncludeSpecs [] [] [], + libraryPaths = [], + frameworkPaths = [], + cmdlineFrameworks = [], + rtsOpts = Nothing, + rtsOptsEnabled = RtsOptsSafeOnly, + rtsOptsSuggestions = True, + + hpcDir = ".hpc", + + packageDBFlags = [], + packageFlags = [], + pluginPackageFlags = [], + ignorePackageFlags = [], + trustFlags = [], + packageEnv = Nothing, + targetWays_ = Set.empty, + splitInfo = Nothing, + + ghcNameVersion = sGhcNameVersion mySettings, + fileSettings = sFileSettings mySettings, + toolSettings = sToolSettings mySettings, + targetPlatform = sTargetPlatform mySettings, + platformMisc = sPlatformMisc mySettings, + rawSettings = sRawSettings mySettings, + + tmpDir = panic "defaultDynFlags: uninitialized tmpDir", + + llvmOptLevel = 0, + + -- ghc -M values + depMakefile = "Makefile", + depIncludePkgDeps = False, + depIncludeCppDeps = False, + depExcludeMods = [], + depSuffixes = [], + -- end of ghc -M values + ghcVersionFile = Nothing, + haddockOptions = Nothing, + dumpFlags = EnumSet.empty, + generalFlags = EnumSet.fromList (defaultFlags mySettings), + warningFlags = EnumSet.fromList standardWarnings, + fatalWarningFlags = EnumSet.empty, + customWarningCategories = completeWarningCategorySet, + fatalCustomWarningCategories = emptyWarningCategorySet, + ghciScripts = [], + language = Nothing, + safeHaskell = Sf_None, + safeInfer = True, + safeInferred = True, + thOnLoc = noSrcSpan, + newDerivOnLoc = noSrcSpan, + deriveViaOnLoc = noSrcSpan, + overlapInstLoc = noSrcSpan, + incoherentOnLoc = noSrcSpan, + pkgTrustOnLoc = noSrcSpan, + warnSafeOnLoc = noSrcSpan, + warnUnsafeOnLoc = noSrcSpan, + trustworthyOnLoc = noSrcSpan, + extensions = [], + extensionFlags = flattenExtensionFlags Nothing [], + + unfoldingOpts = defaultUnfoldingOpts, + maxWorkerArgs = 10, + + ghciHistSize = 50, -- keep a log of length 50 by default + + flushOut = defaultFlushOut, + pprUserLength = 5, + pprCols = 100, + useUnicode = False, + useColor = Auto, + canUseColor = False, + colScheme = Col.defaultScheme, + profAuto = NoProfAuto, + callerCcFilters = [], + interactivePrint = Nothing, + sseVersion = Nothing, + bmiVersion = Nothing, + avx = False, + avx2 = False, + avx512cd = False, + avx512er = False, + avx512f = False, + avx512pf = False, + fma = False, + rtldInfo = panic "defaultDynFlags: no rtldInfo", + rtccInfo = panic "defaultDynFlags: no rtccInfo", + rtasmInfo = panic "defaultDynFlags: no rtasmInfo", + + maxInlineAllocSize = 128, + maxInlineMemcpyInsns = 32, + maxInlineMemsetInsns = 32, + + initialUnique = 0, + uniqueIncrement = 1, + + reverseErrors = False, + maxErrors = Nothing, + cfgWeights = defaultWeights + } + +type FatalMessager = String -> IO () + +defaultFatalMessager :: FatalMessager +defaultFatalMessager = hPutStrLn stderr + + +newtype FlushOut = FlushOut (IO ()) + +defaultFlushOut :: FlushOut +defaultFlushOut = FlushOut $ hFlush stdout + + + +data OnOff a = On a + | Off a + deriving (Eq, Show) + +instance Outputable a => Outputable (OnOff a) where + ppr (On x) = text "On" <+> ppr x + ppr (Off x) = text "Off" <+> ppr x + +-- OnOffs accumulate in reverse order, so we use foldr in order to +-- process them in the right order +flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension +flattenExtensionFlags ml = foldr g defaultExtensionFlags + where g (On f) flags = EnumSet.insert f flags + g (Off f) flags = EnumSet.delete f flags + defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) + +-- ----------------------------------------------------------------------------- +-- -jN + +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + -- | Use this many processors (@-j@ flag). + = ParMakeThisMany Int + -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). + | ParMakeNumProcessors + -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). + | ParMakeSemaphore FilePath + +-- ----------------------------------------------------------------------------- +-- Linker/compiler information + +-- LinkerInfo contains any extra options needed by the system linker. +data LinkerInfo + = GnuLD [Option] + | Mold [Option] + | GnuGold [Option] + | LlvmLLD [Option] + | DarwinLD [Option] + | SolarisLD [Option] + | AixLD [Option] + | UnknownLD + deriving Eq + +-- CompilerInfo tells us which C compiler we're using +data CompilerInfo + = GCC + | Clang + | AppleClang + | AppleClang51 + | Emscripten + | UnknownCC + deriving Eq + +-- | The 'GhcMode' tells us whether we're doing multi-module +-- compilation (controlled via the "GHC" API) or one-shot +-- (single-module) compilation. This makes a difference primarily to +-- the "GHC.Unit.Finder": in one-shot mode we look for interface files for +-- imported modules, but in multi-module mode we look for source files +-- in order to check whether they need to be recompiled. +data GhcMode + = CompManager -- ^ @\-\-make@, GHCi, etc. + | OneShot -- ^ @ghc -c Foo.hs@ + | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this + deriving Eq + +instance Outputable GhcMode where + ppr CompManager = text "CompManager" + ppr OneShot = text "OneShot" + ppr MkDepend = text "MkDepend" + +isOneShot :: GhcMode -> Bool +isOneShot OneShot = True +isOneShot _other = False + +-- | What to do in the link step, if there is one. +data GhcLink + = NoLink -- ^ Don't link at all + | LinkBinary -- ^ Link object code into a binary + | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both + -- bytecode and object code). + | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) + | LinkStaticLib -- ^ Link objects into a static lib + | LinkMergedObj -- ^ Link objects into a merged "GHCi object" + deriving (Eq, Show) + +isNoLink :: GhcLink -> Bool +isNoLink NoLink = True +isNoLink _ = False + +-- | We accept flags which make packages visible, but how they select +-- the package varies; this data type reflects what selection criterion +-- is used. +data PackageArg = + PackageArg String -- ^ @-package@, by 'PackageName' + | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' + deriving (Eq, Show) + +instance Outputable PackageArg where + ppr (PackageArg pn) = text "package" <+> text pn + ppr (UnitIdArg uid) = text "unit" <+> ppr uid + +-- | Represents the renaming that may be associated with an exposed +-- package, e.g. the @rns@ part of @-package "foo (rns)"@. +-- +-- Here are some example parsings of the package flags (where +-- a string literal is punned to be a 'ModuleName': +-- +-- * @-package foo@ is @ModRenaming True []@ +-- * @-package foo ()@ is @ModRenaming False []@ +-- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ +-- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ +-- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ +data ModRenaming = ModRenaming { + modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? + modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope + -- under name @n at . + } deriving (Eq) +instance Outputable ModRenaming where + ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) + +-- | Flags for manipulating the set of non-broken packages. +newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ + deriving (Eq) + +-- | Flags for manipulating package trust. +data TrustFlag + = TrustPackage String -- ^ @-trust@ + | DistrustPackage String -- ^ @-distrust@ + deriving (Eq) + +-- | Flags for manipulating packages visibility. +data PackageFlag + = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ + | HidePackage String -- ^ @-hide-package@ + deriving (Eq) -- NB: equality instance is used by packageFlagsChanged + +data PackageDBFlag + = PackageDB PkgDbRef + | NoUserPackageDB + | NoGlobalPackageDB + | ClearPackageDBs + deriving (Eq) + +packageFlagsChanged :: DynFlags -> DynFlags -> Bool +packageFlagsChanged idflags1 idflags0 = + packageFlags idflags1 /= packageFlags idflags0 || + ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || + pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || + trustFlags idflags1 /= trustFlags idflags0 || + packageDBFlags idflags1 /= packageDBFlags idflags0 || + packageGFlags idflags1 /= packageGFlags idflags0 + where + packageGFlags dflags = map (`gopt` dflags) + [ Opt_HideAllPackages + , Opt_HideAllPluginPackages + , Opt_AutoLinkPackages ] + +instance Outputable PackageFlag where + ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) + ppr (HidePackage str) = text "-hide-package" <+> text str + +data DynLibLoader + = Deployable + | SystemDependent + deriving Eq + +data RtsOptsEnabled + = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly + | RtsOptsAll + deriving (Show) + +-- | Are we building with @-fPIE@ or @-fPIC@ enabled? +positionIndependent :: DynFlags -> Bool +positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags + +-- Note [-dynamic-too business] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- With -dynamic-too flag, we try to build both the non-dynamic and dynamic +-- objects in a single run of the compiler: the pipeline is the same down to +-- Core optimisation, then the backend (from Core to object code) is executed +-- twice. +-- +-- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic +-- and dynamic loaded interfaces (#9176). +-- +-- To make matters worse, we automatically enable -dynamic-too when some modules +-- need Template-Haskell and GHC is dynamically linked (cf +-- GHC.Driver.Pipeline.compileOne'). +-- +-- We used to try and fall back from a dynamic-too failure but this feature +-- didn't work as expected (#20446) so it was removed to simplify the +-- implementation and not obscure latent bugs. + +data DynamicTooState + = DT_Dont -- ^ Don't try to build dynamic objects too + | DT_OK -- ^ Will still try to generate dynamic objects + | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) + deriving (Eq,Show,Ord) + +dynamicTooState :: DynFlags -> DynamicTooState +dynamicTooState dflags + | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont + | dynamicNow dflags = DT_Dyn + | otherwise = DT_OK + +setDynamicNow :: DynFlags -> DynFlags +setDynamicNow dflags0 = + dflags0 + { dynamicNow = True + } + +data PkgDbRef + = GlobalPkgDb + | UserPkgDb + | PkgDbPath FilePath + deriving Eq + +-- | Used to differentiate the scope an include needs to apply to. +-- We have to split the include paths to avoid accidentally forcing recursive +-- includes since -I overrides the system search paths. See #14312. +data IncludeSpecs + = IncludeSpecs { includePathsQuote :: [String] + , includePathsGlobal :: [String] + -- | See Note [Implicit include paths] + , includePathsQuoteImplicit :: [String] + } + deriving Show + +-- | Append to the list of includes a path that shall be included using `-I` +-- when the C compiler is called. These paths override system search paths. +addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addGlobalInclude spec paths = let f = includePathsGlobal spec + in spec { includePathsGlobal = f ++ paths } + +-- | Append to the list of includes a path that shall be included using +-- `-iquote` when the C compiler is called. These paths only apply when quoted +-- includes are used. e.g. #include "foo.h" +addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addQuoteInclude spec paths = let f = includePathsQuote spec + in spec { includePathsQuote = f ++ paths } + +-- | These includes are not considered while fingerprinting the flags for iface +-- | See Note [Implicit include paths] +addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec + in spec { includePathsQuoteImplicit = f ++ paths } + + +-- | Concatenate and flatten the list of global and quoted includes returning +-- just a flat list of paths. +flattenIncludes :: IncludeSpecs -> [String] +flattenIncludes specs = + includePathsQuote specs ++ + includePathsQuoteImplicit specs ++ + includePathsGlobal specs + +{- Note [Implicit include paths] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The compile driver adds the path to the folder containing the source file being + compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' + that are used later to compute the interface file. Because of this, + the flags fingerprint derived from these 'DynFlags' and recorded in the + interface file will end up containing the absolute path to the source folder. + + Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) + store the build artifacts produced by a build BA for reuse in subsequent builds. + + Embedding source paths in interface fingerprints will thwart these attempts and + lead to unnecessary recompilations when the source paths in BA differ from the + source paths in subsequent builds. + -} + +hasPprDebug :: DynFlags -> Bool +hasPprDebug = dopt Opt_D_ppr_debug + +hasNoDebugOutput :: DynFlags -> Bool +hasNoDebugOutput = dopt Opt_D_no_debug_output + +hasNoStateHack :: DynFlags -> Bool +hasNoStateHack = gopt Opt_G_NoStateHack + +hasNoOptCoercion :: DynFlags -> Bool +hasNoOptCoercion = gopt Opt_G_NoOptCoercion + +-- | Test whether a 'DumpFlag' is set +dopt :: DumpFlag -> DynFlags -> Bool +dopt = getDumpFlagFrom verbosity dumpFlags + +-- | Set a 'DumpFlag' +dopt_set :: DynFlags -> DumpFlag -> DynFlags +dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } + +-- | Unset a 'DumpFlag' +dopt_unset :: DynFlags -> DumpFlag -> DynFlags +dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } + +-- | Test whether a 'GeneralFlag' is set +-- +-- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) +-- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables +-- Opt_SplitSections. +-- +gopt :: GeneralFlag -> DynFlags -> Bool +gopt Opt_PIC dflags + | dynamicNow dflags = True +gopt Opt_ExternalDynamicRefs dflags + | dynamicNow dflags = True +gopt Opt_SplitSections dflags + | dynamicNow dflags = False +gopt f dflags = f `EnumSet.member` generalFlags dflags + +-- | Set a 'GeneralFlag' +gopt_set :: DynFlags -> GeneralFlag -> DynFlags +gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } + +-- | Unset a 'GeneralFlag' +gopt_unset :: DynFlags -> GeneralFlag -> DynFlags +gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } + +-- | Test whether a 'WarningFlag' is set +wopt :: WarningFlag -> DynFlags -> Bool +wopt f dflags = f `EnumSet.member` warningFlags dflags + +-- | Set a 'WarningFlag' +wopt_set :: DynFlags -> WarningFlag -> DynFlags +wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } + +-- | Unset a 'WarningFlag' +wopt_unset :: DynFlags -> WarningFlag -> DynFlags +wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } + +-- | Test whether a 'WarningFlag' is set as fatal +wopt_fatal :: WarningFlag -> DynFlags -> Bool +wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags + +-- | Mark a 'WarningFlag' as fatal (do not set the flag) +wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_set_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } + +-- | Mark a 'WarningFlag' as not fatal +wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_unset_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } + + +-- | Enable all custom warning categories. +wopt_set_all_custom :: DynFlags -> DynFlags +wopt_set_all_custom dfs + = dfs{ customWarningCategories = completeWarningCategorySet } + +-- | Disable all custom warning categories. +wopt_unset_all_custom :: DynFlags -> DynFlags +wopt_unset_all_custom dfs + = dfs{ customWarningCategories = emptyWarningCategorySet } + +-- | Mark all custom warning categories as fatal (do not set the flags). +wopt_set_all_fatal_custom :: DynFlags -> DynFlags +wopt_set_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = completeWarningCategorySet } + +-- | Mark all custom warning categories as non-fatal. +wopt_unset_all_fatal_custom :: DynFlags -> DynFlags +wopt_unset_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } + +-- | Set a custom 'WarningCategory' +wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } + +-- | Unset a custom 'WarningCategory' +wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as fatal (do not set the flag) +wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as not fatal +wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Are there any custom warning categories enabled? +wopt_any_custom :: DynFlags -> Bool +wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) + + +-- | Test whether a 'LangExt.Extension' is set +xopt :: LangExt.Extension -> DynFlags -> Bool +xopt f dflags = f `EnumSet.member` extensionFlags dflags + +-- | Set a 'LangExt.Extension' +xopt_set :: DynFlags -> LangExt.Extension -> DynFlags +xopt_set dfs f + = let onoffs = On f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Unset a 'LangExt.Extension' +xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags +xopt_unset dfs f + = let onoffs = Off f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Set or unset a 'LangExt.Extension', unless it has been explicitly +-- set or unset before. +xopt_set_unlessExplSpec + :: LangExt.Extension + -> (DynFlags -> LangExt.Extension -> DynFlags) + -> DynFlags -> DynFlags +xopt_set_unlessExplSpec ext setUnset dflags = + let referedExts = stripOnOff <$> extensions dflags + stripOnOff (On x) = x + stripOnOff (Off x) = x + in + if ext `elem` referedExts then dflags else setUnset dflags ext + +xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields +xopt_DuplicateRecordFields dfs + | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields + | otherwise = FieldLabel.NoDuplicateRecordFields + +xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors +xopt_FieldSelectors dfs + | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors + | otherwise = FieldLabel.NoFieldSelectors + +lang_set :: DynFlags -> Maybe Language -> DynFlags +lang_set dflags lang = + dflags { + language = lang, + extensionFlags = flattenExtensionFlags lang (extensions dflags) + } + +defaultFlags :: Settings -> [GeneralFlag] +defaultFlags settings +-- See Note [Updating flag description in the User's Guide] + = [ Opt_AutoLinkPackages, + Opt_DiagnosticsShowCaret, + Opt_EmbedManifest, + Opt_FamAppCache, + Opt_GenManifest, + Opt_GhciHistory, + Opt_GhciSandbox, + Opt_HelpfulErrors, + Opt_KeepHiFiles, + Opt_KeepOFiles, + Opt_OmitYields, + Opt_PrintBindContents, + Opt_ProfCountEntries, + Opt_SharedImplib, + Opt_SimplPreInlining, + Opt_VersionMacros, + Opt_RPath, + Opt_DumpWithWays, + Opt_CompactUnwind, + Opt_ShowErrorContext, + Opt_SuppressStgReps, + Opt_UnoptimizedCoreForInterpreter + ] + + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + + -- Default floating flags (see Note [RHS Floating]) + ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] + + + ++ default_PIC platform + + ++ validHoleFitDefaults + + + where platform = sTargetPlatform settings + +-- | These are the default settings for the display and sorting of valid hole +-- fits in typed-hole error messages. See Note [Valid hole fits include ...] + -- in the "GHC.Tc.Errors.Hole" module. +validHoleFitDefaults :: [GeneralFlag] +validHoleFitDefaults + = [ Opt_ShowTypeAppOfHoleFits + , Opt_ShowTypeOfHoleFits + , Opt_ShowProvOfHoleFits + , Opt_ShowMatchesOfHoleFits + , Opt_ShowValidHoleFits + , Opt_SortValidHoleFits + , Opt_SortBySizeHoleFits + , Opt_ShowHoleConstraints ] + + +-- +-- Note [Documenting optimisation flags] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- If you change the list of flags enabled for particular optimisation levels +-- please remember to update the User's Guide. The relevant file is: +-- +-- docs/users_guide/using-optimisation.rst +-- +-- Make sure to note whether a flag is implied by -O0, -O or -O2. + +optLevelFlags :: [([Int], GeneralFlag)] +-- Default settings of flags, before any command-line overrides +optLevelFlags -- see Note [Documenting optimisation flags] + = [ ([0,1,2], Opt_DoLambdaEtaExpansion) + , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] + , ([0,1,2], Opt_LlvmTBAA) + , ([0,1,2], Opt_ProfManualCcs ) + , ([2], Opt_DictsStrict) + + , ([0], Opt_IgnoreInterfacePragmas) + , ([0], Opt_OmitInterfacePragmas) + + , ([1,2], Opt_CoreConstantFolding) + + , ([1,2], Opt_CallArity) + , ([1,2], Opt_Exitification) + , ([1,2], Opt_CaseMerge) + , ([1,2], Opt_CaseFolding) + , ([1,2], Opt_CmmElimCommonBlocks) + , ([2], Opt_AsmShortcutting) + , ([1,2], Opt_CmmSink) + , ([1,2], Opt_CmmStaticPred) + , ([1,2], Opt_CSE) + , ([1,2], Opt_StgCSE) + , ([2], Opt_StgLiftLams) + , ([1,2], Opt_CmmControlFlow) + + , ([1,2], Opt_EnableRewriteRules) + -- Off for -O0. Otherwise we desugar list literals + -- to 'build' but don't run the simplifier passes that + -- would rewrite them back to cons cells! This seems + -- silly, and matters for the GHCi debugger. + + , ([1,2], Opt_FloatIn) + , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_IgnoreAsserts) + , ([1,2], Opt_Loopification) + , ([1,2], Opt_CfgBlocklayout) -- Experimental + + , ([1,2], Opt_Specialise) + , ([1,2], Opt_CrossModuleSpecialise) + , ([1,2], Opt_InlineGenerics) + , ([1,2], Opt_Strictness) + , ([1,2], Opt_UnboxSmallStrictFields) + , ([1,2], Opt_CprAnal) + , ([1,2], Opt_WorkerWrapper) + , ([1,2], Opt_SolveConstantDicts) + , ([1,2], Opt_NumConstantFolding) + + , ([2], Opt_LiberateCase) + , ([2], Opt_SpecConstr) + , ([2], Opt_FastPAPCalls) +-- , ([2], Opt_RegsGraph) +-- RegsGraph suffers performance regression. See #7679 +-- , ([2], Opt_StaticArgumentTransformation) +-- Static Argument Transformation needs investigation. See #9374 + ] + +type TurnOnFlag = Bool -- True <=> we are turning the flag on + -- False <=> we are turning the flag off +turnOn :: TurnOnFlag; turnOn = True +turnOff :: TurnOnFlag; turnOff = False + +default_PIC :: Platform -> [GeneralFlag] +default_PIC platform = + case (platformOS platform, platformArch platform) of + -- Darwin always requires PIC. Especially on more recent macOS releases + -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses + -- while we could work around this on x86_64 (like WINE does), we won't be + -- able on aarch64, where this is enforced. + (OSDarwin, ArchX86_64) -> [Opt_PIC] + -- For AArch64, we need to always have PIC enabled. The relocation model + -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't + -- control much how far apart symbols are in memory for our in-memory static + -- linker; and thus need to ensure we get sufficiently capable relocations. + -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top + -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to + -- be built with -fPIC. + (OSDarwin, ArchAArch64) -> [Opt_PIC] + (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in + -- OpenBSD since 5.3 release + -- (1 May 2013) we need to + -- always generate PIC. See + -- #10597 for more + -- information. + _ -> [] + +-- | The language extensions implied by the various language variants. +-- When updating this be sure to update the flag documentation in +-- @docs/users_guide/exts at . +languageExtensions :: Maybe Language -> [LangExt.Extension] + +-- Nothing: the default case +languageExtensions Nothing = languageExtensions (Just GHC2021) + +languageExtensions (Just Haskell98) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.NPlusKPatterns, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.FieldSelectors, + LangExt.NondecreasingIndentation, + -- strictly speaking non-standard, but we always had this + -- on implicitly before the option was added in 7.1, and + -- turning it off breaks code, so we're keeping it on for + -- backwards compatibility. Cabal uses -XHaskell98 by + -- default unless you specify another language. + LangExt.DeepSubsumption + -- Non-standard but enabled for backwards compatability (see GHC proposal #511) + ] + +languageExtensions (Just Haskell2010) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + LangExt.DeepSubsumption ] + +languageExtensions (Just GHC2021) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.MonomorphismRestriction, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + -- Now the new extensions (not in Haskell2010) + LangExt.BangPatterns, + LangExt.BinaryLiterals, + LangExt.ConstrainedClassMethods, + LangExt.ConstraintKinds, + LangExt.DeriveDataTypeable, + LangExt.DeriveFoldable, + LangExt.DeriveFunctor, + LangExt.DeriveGeneric, + LangExt.DeriveLift, + LangExt.DeriveTraversable, + LangExt.EmptyCase, + LangExt.EmptyDataDeriving, + LangExt.ExistentialQuantification, + LangExt.ExplicitForAll, + LangExt.FlexibleContexts, + LangExt.FlexibleInstances, + LangExt.GADTSyntax, + LangExt.GeneralizedNewtypeDeriving, + LangExt.HexFloatLiterals, + LangExt.ImportQualifiedPost, + LangExt.InstanceSigs, + LangExt.KindSignatures, + LangExt.MultiParamTypeClasses, + LangExt.NamedFieldPuns, + LangExt.NamedWildCards, + LangExt.NumericUnderscores, + LangExt.PolyKinds, + LangExt.PostfixOperators, + LangExt.RankNTypes, + LangExt.ScopedTypeVariables, + LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.StandaloneDeriving, + LangExt.StandaloneKindSignatures, + LangExt.TupleSections, + LangExt.TypeApplications, + LangExt.TypeOperators, + LangExt.TypeSynonymInstances] + + +ways :: DynFlags -> Ways +ways dflags + | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) + | otherwise = targetWays_ dflags +-- +-- System tool settings and locations + +programName :: DynFlags -> String +programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags +projectVersion :: DynFlags -> String +projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) +ghcUsagePath :: DynFlags -> FilePath +ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags +ghciUsagePath :: DynFlags -> FilePath +ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags +topDir :: DynFlags -> FilePath +topDir dflags = fileSettings_topDir $ fileSettings dflags +toolDir :: DynFlags -> Maybe FilePath +toolDir dflags = fileSettings_toolDir $ fileSettings dflags +extraGccViaCFlags :: DynFlags -> [String] +extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags +globalPackageDatabasePath :: DynFlags -> FilePath +globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags + +-- | The directory for this version of ghc in the user's app directory +-- The appdir used to be in ~/.ghc but to respect the XDG specification +-- we want to move it under $XDG_DATA_HOME/ +-- However, old tooling (like cabal) might still write package environments +-- to the old directory, so we prefer that if a subdirectory of ~/.ghc +-- with the correct target and GHC version suffix exists. +-- +-- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that +-- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR +-- +-- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version +versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath +versionedAppDir appname platform = do + -- Make sure we handle the case the HOME isn't set (see #11678) + -- We need to fallback to the old scheme if the subdirectory exists. + msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) + [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ + , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ + ] + where + checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case + True -> pure dir + False -> MaybeT (pure Nothing) + +versionedFilePath :: ArchOS -> FilePath +versionedFilePath platform = uniqueSubdir platform + +-- SDoc +------------------------------------------- + +-- | Initialize the pretty-printing options +initSDocContext :: DynFlags -> PprStyle -> SDocContext +initSDocContext dflags style = SDC + { sdocStyle = style + , sdocColScheme = colScheme dflags + , sdocLastColour = Col.colReset + , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) + , sdocDefaultDepth = pprUserLength dflags + , sdocLineLength = pprCols dflags + , sdocCanUseUnicode = useUnicode dflags + , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags + , sdocPprDebug = dopt Opt_D_ppr_debug dflags + , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags + , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags + , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags + , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags + , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags + , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags + , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags + , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags + , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags + , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags + , sdocSuppressTicks = gopt Opt_SuppressTicks dflags + , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags + , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags + , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags + , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags + , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags + , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags + , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags + , sdocSuppressUniques = gopt Opt_SuppressUniques dflags + , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags + , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags + , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags + , sdocErrorSpans = gopt Opt_ErrorSpans dflags + , sdocStarIsType = xopt LangExt.StarIsType dflags + , sdocLinearTypes = xopt LangExt.LinearTypes dflags + , sdocListTuplePuns = True + , sdocPrintTypeAbbreviations = True + , sdocUnitIdForUser = ftext + } + +-- | Initialize the pretty-printing options using the default user style +initDefaultSDocContext :: DynFlags -> SDocContext +initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle + +initPromotionTickContext :: DynFlags -> PromotionTickContext +initPromotionTickContext dflags = + PromTickCtx { + ptcListTuplePuns = True, + ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags + } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -41,7 +41,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Errors ( printOrThrowDiagnostics ) import GHC.Driver.Errors.Types ( GhcMessage ) import GHC.Driver.Config.Logger (initLogFlags) ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -7,7 +7,7 @@ module GHC.Driver.Env.Types import GHC.Driver.Errors.Types ( GhcMessage ) import {-# SOURCE #-} GHC.Driver.Hooks -import GHC.Driver.Session ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) +import GHC.Driver.DynFlags ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Prelude ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Prelude import GHC.Driver.Errors.Types import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () import GHC.Types.Error ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Prelude import Data.Bifunctor import Data.Typeable -import GHC.Driver.Session (DynFlags, PackageArg, gopt) +import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt) import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage)) import GHC.Types.Error import GHC.Unit.Module @@ -384,4 +384,4 @@ checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage checkBuildingCabalPackage dflags = if gopt Opt_BuildingCabalPackage dflags then YesBuildingCabalPackage - else NoBuildingCabalPackage \ No newline at end of file + else NoBuildingCabalPackage ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -32,7 +32,7 @@ where import GHC.Prelude import GHC.Driver.Env -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Pipeline.Phases import GHC.Hs.Decls ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -11,7 +11,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.State import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -230,53 +230,40 @@ import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile -import GHC.UniqueSubdir (uniqueSubdir) import GHC.Unit.Types import GHC.Unit.Parser import GHC.Unit.Module import GHC.Unit.Module.Warnings -import GHC.Builtin.Names ( mAIN_NAME ) -import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.DynFlags import GHC.Driver.Flags import GHC.Driver.Backend import GHC.Driver.Plugins.External import GHC.Settings.Config -import GHC.Utils.CliOption import GHC.Core.Unfold import GHC.Driver.CmdLine -import GHC.Settings.Constants import GHC.Utils.Panic -import qualified GHC.Utils.Ppr.Colour as Col import GHC.Utils.Misc import GHC.Utils.Constants (debugIsOn) import GHC.Utils.GlobalVars import GHC.Data.Maybe import GHC.Data.Bool import GHC.Utils.Monad -import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.SrcLoc import GHC.Types.SafeHaskell -import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) -import GHC.Types.ProfAuto -import qualified GHC.Types.FieldLabel as FieldLabel +import GHC.Types.Basic ( treatZeroAsInf ) import GHC.Data.FastString import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable import GHC.Settings import GHC.CmmToAsm.CFG.Weight -import {-# SOURCE #-} GHC.Core.Opt.CallerCC +import GHC.Core.Opt.CallerCC -import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) import Data.IORef import Control.Arrow ((&&&)) import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.Writer -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Except import Control.Monad.Trans.State as State import Data.Functor.Identity @@ -287,17 +274,11 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set import System.FilePath -import System.Directory -import System.Environment (lookupEnv) -import System.IO -import System.IO.Error import Text.ParserCombinators.ReadP hiding (char) import Text.ParserCombinators.ReadP as R -import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet -import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -- Note [Updating flag description in the User's Guide] @@ -376,387 +357,6 @@ import qualified GHC.LanguageExtensions as LangExt -- ----------------------------------------------------------------------------- -- DynFlags --- | Used to differentiate the scope an include needs to apply to. --- We have to split the include paths to avoid accidentally forcing recursive --- includes since -I overrides the system search paths. See #14312. -data IncludeSpecs - = IncludeSpecs { includePathsQuote :: [String] - , includePathsGlobal :: [String] - -- | See Note [Implicit include paths] - , includePathsQuoteImplicit :: [String] - } - deriving Show - --- | Append to the list of includes a path that shall be included using `-I` --- when the C compiler is called. These paths override system search paths. -addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addGlobalInclude spec paths = let f = includePathsGlobal spec - in spec { includePathsGlobal = f ++ paths } - --- | Append to the list of includes a path that shall be included using --- `-iquote` when the C compiler is called. These paths only apply when quoted --- includes are used. e.g. #include "foo.h" -addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addQuoteInclude spec paths = let f = includePathsQuote spec - in spec { includePathsQuote = f ++ paths } - --- | These includes are not considered while fingerprinting the flags for iface --- | See Note [Implicit include paths] -addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec - in spec { includePathsQuoteImplicit = f ++ paths } - - --- | Concatenate and flatten the list of global and quoted includes returning --- just a flat list of paths. -flattenIncludes :: IncludeSpecs -> [String] -flattenIncludes specs = - includePathsQuote specs ++ - includePathsQuoteImplicit specs ++ - includePathsGlobal specs - -{- Note [Implicit include paths] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - The compile driver adds the path to the folder containing the source file being - compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' - that are used later to compute the interface file. Because of this, - the flags fingerprint derived from these 'DynFlags' and recorded in the - interface file will end up containing the absolute path to the source folder. - - Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) - store the build artifacts produced by a build BA for reuse in subsequent builds. - - Embedding source paths in interface fingerprints will thwart these attempts and - lead to unnecessary recompilations when the source paths in BA differ from the - source paths in subsequent builds. - -} - - --- | Contains not only a collection of 'GeneralFlag's but also a plethora of --- information relating to the compilation of a single file or GHC session -data DynFlags = DynFlags { - ghcMode :: GhcMode, - ghcLink :: GhcLink, - backend :: !Backend, - -- ^ The backend to use (if any). - -- - -- Whenever you change the backend, also make sure to set 'ghcLink' to - -- something sensible. - -- - -- 'NoBackend' can be used to avoid generating any output, however, note that: - -- - -- * If a program uses Template Haskell the typechecker may need to run code - -- from an imported module. To facilitate this, code generation is enabled - -- for modules imported by modules that use template haskell, using the - -- default backend for the platform. - -- See Note [-fno-code mode]. - - - -- formerly Settings - ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, - fileSettings :: {-# UNPACK #-} !FileSettings, - targetPlatform :: Platform, -- Filled in by SysTools - toolSettings :: {-# UNPACK #-} !ToolSettings, - platformMisc :: {-# UNPACK #-} !PlatformMisc, - rawSettings :: [(String, String)], - tmpDir :: TempDir, - - llvmOptLevel :: Int, -- ^ LLVM optimisation level - verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] - debugLevel :: Int, -- ^ How much debug information to produce - simplPhases :: Int, -- ^ Number of simplifier phases - maxSimplIterations :: Int, -- ^ Max simplifier iterations - ruleCheck :: Maybe String, - strictnessBefore :: [Int], -- ^ Additional demand analysis - - parMakeCount :: Maybe ParMakeCount, - -- ^ The number of modules to compile in parallel - -- If unspecified, compile with a single job. - - enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? - ghcHeapSize :: Maybe Int, -- ^ The heap size to set. - - maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt - -- to show in type error messages - maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show - -- in typed hole error messages - maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole - -- fits to show in typed hole error - -- messages - refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for - -- refinement hole fits in typed hole - -- error messages - maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show - -- in non-exhaustiveness warnings - maxPmCheckModels :: Int, -- ^ Soft limit on the number of models - -- the pattern match checker checks - -- a pattern against. A safe guard - -- against exponential blow-up. - simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks - dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an - -- Unboxed demand on returned products with at most - -- this number of fields - specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr - specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function - specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types - -- Not optional; otherwise ForceSpecConstr can diverge. - binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above - -- this threshold will be dumped in a binary file - -- by the assembler code generator. 0 and Nothing disables - -- this feature. See 'GHC.StgToCmm.Config'. - liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase - floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating - -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' - - liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- recursive function. - liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- non-recursive function. - liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call - -- into an unknown call. - - cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. - - historySize :: Int, -- ^ Simplification history size - - importPaths :: [FilePath], - mainModuleNameIs :: ModuleName, - mainFunIs :: Maybe String, - reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth - solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver - -- Typically only 1 is needed - givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens - -- Should be < solverIterations - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - homeUnitId_ :: UnitId, -- ^ Target home unit-id - homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate - homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations - - -- Note [Filepaths and Multiple Home Units] - workingDirectory :: Maybe FilePath, - thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units - hiddenModules :: Set.Set ModuleName, - reexportedModules :: Set.Set ModuleName, - - -- ways - targetWays_ :: Ways, -- ^ Target way flags from the command line - - -- For object splitting - splitInfo :: Maybe (String,Int), - - -- paths etc. - objectDir :: Maybe String, - dylibInstallName :: Maybe String, - hiDir :: Maybe String, - hieDir :: Maybe String, - stubDir :: Maybe String, - dumpDir :: Maybe String, - - objectSuf_ :: String, - hcSuf :: String, - hiSuf_ :: String, - hieSuf :: String, - - dynObjectSuf_ :: String, - dynHiSuf_ :: String, - - outputFile_ :: Maybe String, - dynOutputFile_ :: Maybe String, - outputHi :: Maybe String, - dynOutputHi :: Maybe String, - dynLibLoader :: DynLibLoader, - - dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output - -- because of -dynamic-too. This predicate is - -- used to query the appropriate fields - -- (outputFile/dynOutputFile, ways, etc.) - - -- | This defaults to 'non-module'. It can be set by - -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on - -- where its output is going. - dumpPrefix :: FilePath, - - -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' - -- or 'ghc.GHCi.UI.runStmt'. - -- Set by @-ddump-file-prefix@ - dumpPrefixForce :: Maybe FilePath, - - ldInputs :: [Option], - - includePaths :: IncludeSpecs, - libraryPaths :: [String], - frameworkPaths :: [String], -- used on darwin only - cmdlineFrameworks :: [String], -- ditto - - rtsOpts :: Maybe String, - rtsOptsEnabled :: RtsOptsEnabled, - rtsOptsSuggestions :: Bool, - - hpcDir :: String, -- ^ Path to store the .mix files - - -- Plugins - pluginModNames :: [ModuleName], - -- ^ the @-fplugin@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - pluginModNameOpts :: [(ModuleName,String)], - frontendPluginOpts :: [String], - -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - - externalPluginSpecs :: [ExternalPluginSpec], - -- ^ External plugins loaded from shared libraries - - -- For ghc -M - depMakefile :: FilePath, - depIncludePkgDeps :: Bool, - depIncludeCppDeps :: Bool, - depExcludeMods :: [ModuleName], - depSuffixes :: [String], - - -- Package flags - packageDBFlags :: [PackageDBFlag], - -- ^ The @-package-db@ flags given on the command line, In - -- *reverse* order that they're specified on the command line. - -- This is intended to be applied with the list of "initial" - -- package databases derived from @GHC_PACKAGE_PATH@; see - -- 'getUnitDbRefs'. - - ignorePackageFlags :: [IgnorePackageFlag], - -- ^ The @-ignore-package@ flags from the command line. - -- In *reverse* order that they're specified on the command line. - packageFlags :: [PackageFlag], - -- ^ The @-package@ and @-hide-package@ flags from the command-line. - -- In *reverse* order that they're specified on the command line. - pluginPackageFlags :: [PackageFlag], - -- ^ The @-plugin-package-id@ flags from command line. - -- In *reverse* order that they're specified on the command line. - trustFlags :: [TrustFlag], - -- ^ The @-trust@ and @-distrust@ flags. - -- In *reverse* order that they're specified on the command line. - packageEnv :: Maybe FilePath, - -- ^ Filepath to the package environment file (if overriding default) - - - -- hsc dynamic flags - dumpFlags :: EnumSet DumpFlag, - generalFlags :: EnumSet GeneralFlag, - warningFlags :: EnumSet WarningFlag, - fatalWarningFlags :: EnumSet WarningFlag, - customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] - fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings - -- Don't change this without updating extensionFlags: - language :: Maybe Language, - -- | Safe Haskell mode - safeHaskell :: SafeHaskellMode, - safeInfer :: Bool, - safeInferred :: Bool, - -- We store the location of where some extension and flags were turned on so - -- we can produce accurate error messages when Safe Haskell fails due to - -- them. - thOnLoc :: SrcSpan, - newDerivOnLoc :: SrcSpan, - deriveViaOnLoc :: SrcSpan, - overlapInstLoc :: SrcSpan, - incoherentOnLoc :: SrcSpan, - pkgTrustOnLoc :: SrcSpan, - warnSafeOnLoc :: SrcSpan, - warnUnsafeOnLoc :: SrcSpan, - trustworthyOnLoc :: SrcSpan, - -- Don't change this without updating extensionFlags: - -- Here we collect the settings of the language extensions - -- from the command line, the ghci config file and - -- from interactive :set / :seti commands. - extensions :: [OnOff LangExt.Extension], - -- extensionFlags should always be equal to - -- flattenExtensionFlags language extensions - -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used - -- by template-haskell - extensionFlags :: EnumSet LangExt.Extension, - - -- | Unfolding control - -- See Note [Discounts and thresholds] in GHC.Core.Unfold - unfoldingOpts :: !UnfoldingOpts, - - maxWorkerArgs :: Int, - - ghciHistSize :: Int, - - flushOut :: FlushOut, - - ghcVersionFile :: Maybe FilePath, - haddockOptions :: Maybe String, - - -- | GHCi scripts specified by -ghci-script, in reverse order - ghciScripts :: [String], - - -- Output style options - pprUserLength :: Int, - pprCols :: Int, - - useUnicode :: Bool, - useColor :: OverridingBool, - canUseColor :: Bool, - colScheme :: Col.Scheme, - - -- | what kind of {-# SCC #-} to add automatically - profAuto :: ProfAuto, - callerCcFilters :: [CallerCcFilter], - - interactivePrint :: Maybe String, - - -- | Machine dependent flags (-m\ stuff) - sseVersion :: Maybe SseVersion, - bmiVersion :: Maybe BmiVersion, - avx :: Bool, - avx2 :: Bool, - avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. - avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. - avx512f :: Bool, -- Enable AVX-512 instructions. - avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. - fma :: Bool, -- ^ Enable FMA instructions. - - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - - -- Constants used to control the amount of optimization done. - - -- | Max size, in bytes, of inline array allocations. - maxInlineAllocSize :: Int, - - -- | Only inline memcpy if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemcpyInsns :: Int, - - -- | Only inline memset if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemsetInsns :: Int, - - -- | Reverse the order of error messages in GHC/GHCi - reverseErrors :: Bool, - - -- | Limit the maximum number of errors to show - maxErrors :: Maybe Int, - - -- | Unique supply configuration for testing build determinism - initialUnique :: Word, - uniqueIncrement :: Int, - -- 'Int' because it can be used to test uniques in decreasing order. - - -- | Temporary: CFG Edge weights for fast iterations - cfgWeights :: Weights -} {- Note [RHS Floating] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -767,43 +367,6 @@ data DynFlags = DynFlags { allows for experimentation. -} -class HasDynFlags m where - getDynFlags :: m DynFlags - -{- It would be desirable to have the more generalised - - instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where - getDynFlags = lift getDynFlags - -instance definition. However, that definition would overlap with the -`HasDynFlags (GhcT m)` instance. Instead we define instances for a -couple of common Monad transformers explicitly. -} - -instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where - getDynFlags = lift getDynFlags - -class ContainsDynFlags t where - extractDynFlags :: t -> DynFlags - --- | The type for the -jN argument, specifying that -j on its own represents --- using the number of machine processors. -data ParMakeCount - -- | Use this many processors (@-j@ flag). - = ParMakeThisMany Int - -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). - | ParMakeNumProcessors - -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). - | ParMakeSemaphore FilePath - ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -820,22 +383,6 @@ settings dflags = Settings , sRawSettings = rawSettings dflags } -programName :: DynFlags -> String -programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags -projectVersion :: DynFlags -> String -projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) -ghcUsagePath :: DynFlags -> FilePath -ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags -ghciUsagePath :: DynFlags -> FilePath -ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags -toolDir :: DynFlags -> Maybe FilePath -toolDir dflags = fileSettings_toolDir $ fileSettings dflags -topDir :: DynFlags -> FilePath -topDir dflags = fileSettings_topDir $ fileSettings dflags -extraGccViaCFlags :: DynFlags -> [String] -extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags -globalPackageDatabasePath :: DynFlags -> FilePath -globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags pgm_L :: DynFlags -> String pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags pgm_P :: DynFlags -> (String,[Option]) @@ -909,430 +456,8 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags opt_i :: DynFlags -> [String] opt_i dflags= toolSettings_opt_i $ toolSettings dflags --- | The directory for this version of ghc in the user's app directory --- The appdir used to be in ~/.ghc but to respect the XDG specification --- we want to move it under $XDG_DATA_HOME/ --- However, old tooling (like cabal) might still write package environments --- to the old directory, so we prefer that if a subdirectory of ~/.ghc --- with the correct target and GHC version suffix exists. --- --- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that --- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR --- --- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version -versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath -versionedAppDir appname platform = do - -- Make sure we handle the case the HOME isn't set (see #11678) - -- We need to fallback to the old scheme if the subdirectory exists. - msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) - [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ - , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ - ] - where - checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case - True -> pure dir - False -> MaybeT (pure Nothing) - -versionedFilePath :: ArchOS -> FilePath -versionedFilePath platform = uniqueSubdir platform - --- | The 'GhcMode' tells us whether we're doing multi-module --- compilation (controlled via the "GHC" API) or one-shot --- (single-module) compilation. This makes a difference primarily to --- the "GHC.Unit.Finder": in one-shot mode we look for interface files for --- imported modules, but in multi-module mode we look for source files --- in order to check whether they need to be recompiled. -data GhcMode - = CompManager -- ^ @\-\-make@, GHCi, etc. - | OneShot -- ^ @ghc -c Foo.hs@ - | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this - deriving Eq - -instance Outputable GhcMode where - ppr CompManager = text "CompManager" - ppr OneShot = text "OneShot" - ppr MkDepend = text "MkDepend" - -isOneShot :: GhcMode -> Bool -isOneShot OneShot = True -isOneShot _other = False - --- | What to do in the link step, if there is one. -data GhcLink - = NoLink -- ^ Don't link at all - | LinkBinary -- ^ Link object code into a binary - | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both - -- bytecode and object code). - | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) - | LinkStaticLib -- ^ Link objects into a static lib - | LinkMergedObj -- ^ Link objects into a merged "GHCi object" - deriving (Eq, Show) - -isNoLink :: GhcLink -> Bool -isNoLink NoLink = True -isNoLink _ = False - --- | We accept flags which make packages visible, but how they select --- the package varies; this data type reflects what selection criterion --- is used. -data PackageArg = - PackageArg String -- ^ @-package@, by 'PackageName' - | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' - deriving (Eq, Show) - -instance Outputable PackageArg where - ppr (PackageArg pn) = text "package" <+> text pn - ppr (UnitIdArg uid) = text "unit" <+> ppr uid - --- | Represents the renaming that may be associated with an exposed --- package, e.g. the @rns@ part of @-package "foo (rns)"@. --- --- Here are some example parsings of the package flags (where --- a string literal is punned to be a 'ModuleName': --- --- * @-package foo@ is @ModRenaming True []@ --- * @-package foo ()@ is @ModRenaming False []@ --- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ --- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ --- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ -data ModRenaming = ModRenaming { - modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? - modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope - -- under name @n at . - } deriving (Eq) -instance Outputable ModRenaming where - ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) - --- | Flags for manipulating the set of non-broken packages. -newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ - deriving (Eq) - --- | Flags for manipulating package trust. -data TrustFlag - = TrustPackage String -- ^ @-trust@ - | DistrustPackage String -- ^ @-distrust@ - deriving (Eq) - --- | Flags for manipulating packages visibility. -data PackageFlag - = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ - | HidePackage String -- ^ @-hide-package@ - deriving (Eq) -- NB: equality instance is used by packageFlagsChanged - -data PackageDBFlag - = PackageDB PkgDbRef - | NoUserPackageDB - | NoGlobalPackageDB - | ClearPackageDBs - deriving (Eq) - -packageFlagsChanged :: DynFlags -> DynFlags -> Bool -packageFlagsChanged idflags1 idflags0 = - packageFlags idflags1 /= packageFlags idflags0 || - ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || - pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || - trustFlags idflags1 /= trustFlags idflags0 || - packageDBFlags idflags1 /= packageDBFlags idflags0 || - packageGFlags idflags1 /= packageGFlags idflags0 - where - packageGFlags dflags = map (`gopt` dflags) - [ Opt_HideAllPackages - , Opt_HideAllPluginPackages - , Opt_AutoLinkPackages ] - -instance Outputable PackageFlag where - ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) - ppr (HidePackage str) = text "-hide-package" <+> text str - -data DynLibLoader - = Deployable - | SystemDependent - deriving Eq - -data RtsOptsEnabled - = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly - | RtsOptsAll - deriving (Show) - --- | Are we building with @-fPIE@ or @-fPIC@ enabled? -positionIndependent :: DynFlags -> Bool -positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags - --- Note [-dynamic-too business] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- With -dynamic-too flag, we try to build both the non-dynamic and dynamic --- objects in a single run of the compiler: the pipeline is the same down to --- Core optimisation, then the backend (from Core to object code) is executed --- twice. --- --- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic --- and dynamic loaded interfaces (#9176). --- --- To make matters worse, we automatically enable -dynamic-too when some modules --- need Template-Haskell and GHC is dynamically linked (cf --- GHC.Driver.Pipeline.compileOne'). --- --- We used to try and fall back from a dynamic-too failure but this feature --- didn't work as expected (#20446) so it was removed to simplify the --- implementation and not obscure latent bugs. - -data DynamicTooState - = DT_Dont -- ^ Don't try to build dynamic objects too - | DT_OK -- ^ Will still try to generate dynamic objects - | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) - deriving (Eq,Show,Ord) - -dynamicTooState :: DynFlags -> DynamicTooState -dynamicTooState dflags - | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont - | dynamicNow dflags = DT_Dyn - | otherwise = DT_OK - -setDynamicNow :: DynFlags -> DynFlags -setDynamicNow dflags0 = - dflags0 - { dynamicNow = True - } - ----------------------------------------------------------------------------- --- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value -initDynFlags :: DynFlags -> IO DynFlags -initDynFlags dflags = do - let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing - canUseUnicode <- do let enc = localeEncoding - str = "‘’" - (withCString enc str $ \cstr -> - do str' <- peekCString enc cstr - return (str == str')) - `catchIOError` \_ -> return False - ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" - let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode - maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" - maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" - let adjustCols (Just env) = Col.parseScheme env - adjustCols Nothing = id - let (useColor', colScheme') = - (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) - (useColor dflags, colScheme dflags) - tmp_dir <- normalise <$> getTemporaryDirectory - return dflags{ - useUnicode = useUnicode', - useColor = useColor', - canUseColor = stderrSupportsAnsiColors, - colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, - tmpDir = TempDir tmp_dir - } - --- | The normal 'DynFlags'. Note that they are not suitable for use in this form --- and must be fully initialized by 'GHC.runGhc' first. -defaultDynFlags :: Settings -> DynFlags -defaultDynFlags mySettings = --- See Note [Updating flag description in the User's Guide] - DynFlags { - ghcMode = CompManager, - ghcLink = LinkBinary, - backend = platformDefaultBackend (sTargetPlatform mySettings), - verbosity = 0, - debugLevel = 0, - simplPhases = 2, - maxSimplIterations = 4, - ruleCheck = Nothing, - binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) - maxRelevantBinds = Just 6, - maxValidHoleFits = Just 6, - maxRefHoleFits = Just 6, - refLevelHoleFits = Nothing, - maxUncoveredPatterns = 4, - maxPmCheckModels = 30, - simplTickFactor = 100, - dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple - specConstrThreshold = Just 2000, - specConstrCount = Just 3, - specConstrRecursive = 3, - liberateCaseThreshold = Just 2000, - floatLamArgs = Just 0, -- Default: float only if no fvs - liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsKnown = False, -- Default: don't turn known calls into unknown ones - cmmProcAlignment = Nothing, - - historySize = 20, - strictnessBefore = [], - - parMakeCount = Nothing, - - enableTimeStats = False, - ghcHeapSize = Nothing, - - importPaths = ["."], - mainModuleNameIs = mAIN_NAME, - mainFunIs = Nothing, - reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, - solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, - givensFuel = mAX_GIVENS_FUEL, - wantedsFuel = mAX_WANTEDS_FUEL, - qcsFuel = mAX_QC_FUEL, - - homeUnitId_ = mainUnitId, - homeUnitInstanceOf_ = Nothing, - homeUnitInstantiations_ = [], - - workingDirectory = Nothing, - thisPackageName = Nothing, - hiddenModules = Set.empty, - reexportedModules = Set.empty, - - objectDir = Nothing, - dylibInstallName = Nothing, - hiDir = Nothing, - hieDir = Nothing, - stubDir = Nothing, - dumpDir = Nothing, - - objectSuf_ = phaseInputExt StopLn, - hcSuf = phaseInputExt HCc, - hiSuf_ = "hi", - hieSuf = "hie", - - dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, - dynHiSuf_ = "dyn_hi", - dynamicNow = False, - - pluginModNames = [], - pluginModNameOpts = [], - frontendPluginOpts = [], - - externalPluginSpecs = [], - - outputFile_ = Nothing, - dynOutputFile_ = Nothing, - outputHi = Nothing, - dynOutputHi = Nothing, - dynLibLoader = SystemDependent, - dumpPrefix = "non-module.", - dumpPrefixForce = Nothing, - ldInputs = [], - includePaths = IncludeSpecs [] [] [], - libraryPaths = [], - frameworkPaths = [], - cmdlineFrameworks = [], - rtsOpts = Nothing, - rtsOptsEnabled = RtsOptsSafeOnly, - rtsOptsSuggestions = True, - - hpcDir = ".hpc", - - packageDBFlags = [], - packageFlags = [], - pluginPackageFlags = [], - ignorePackageFlags = [], - trustFlags = [], - packageEnv = Nothing, - targetWays_ = Set.empty, - splitInfo = Nothing, - - ghcNameVersion = sGhcNameVersion mySettings, - fileSettings = sFileSettings mySettings, - toolSettings = sToolSettings mySettings, - targetPlatform = sTargetPlatform mySettings, - platformMisc = sPlatformMisc mySettings, - rawSettings = sRawSettings mySettings, - - tmpDir = panic "defaultDynFlags: uninitialized tmpDir", - - llvmOptLevel = 0, - - -- ghc -M values - depMakefile = "Makefile", - depIncludePkgDeps = False, - depIncludeCppDeps = False, - depExcludeMods = [], - depSuffixes = [], - -- end of ghc -M values - ghcVersionFile = Nothing, - haddockOptions = Nothing, - dumpFlags = EnumSet.empty, - generalFlags = EnumSet.fromList (defaultFlags mySettings), - warningFlags = EnumSet.fromList standardWarnings, - fatalWarningFlags = EnumSet.empty, - customWarningCategories = completeWarningCategorySet, - fatalCustomWarningCategories = emptyWarningCategorySet, - ghciScripts = [], - language = Nothing, - safeHaskell = Sf_None, - safeInfer = True, - safeInferred = True, - thOnLoc = noSrcSpan, - newDerivOnLoc = noSrcSpan, - deriveViaOnLoc = noSrcSpan, - overlapInstLoc = noSrcSpan, - incoherentOnLoc = noSrcSpan, - pkgTrustOnLoc = noSrcSpan, - warnSafeOnLoc = noSrcSpan, - warnUnsafeOnLoc = noSrcSpan, - trustworthyOnLoc = noSrcSpan, - extensions = [], - extensionFlags = flattenExtensionFlags Nothing [], - - unfoldingOpts = defaultUnfoldingOpts, - maxWorkerArgs = 10, - - ghciHistSize = 50, -- keep a log of length 50 by default - - flushOut = defaultFlushOut, - pprUserLength = 5, - pprCols = 100, - useUnicode = False, - useColor = Auto, - canUseColor = False, - colScheme = Col.defaultScheme, - profAuto = NoProfAuto, - callerCcFilters = [], - interactivePrint = Nothing, - sseVersion = Nothing, - bmiVersion = Nothing, - avx = False, - avx2 = False, - avx512cd = False, - avx512er = False, - avx512f = False, - avx512pf = False, - fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", - - maxInlineAllocSize = 128, - maxInlineMemcpyInsns = 32, - maxInlineMemsetInsns = 32, - - initialUnique = 0, - uniqueIncrement = 1, - - reverseErrors = False, - maxErrors = Nothing, - cfgWeights = defaultWeights - } - -type FatalMessager = String -> IO () - -defaultFatalMessager :: FatalMessager -defaultFatalMessager = hPutStrLn stderr - - -newtype FlushOut = FlushOut (IO ()) - -defaultFlushOut :: FlushOut -defaultFlushOut = FlushOut $ hFlush stdout - {- Note [Verbosity levels] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -1344,283 +469,6 @@ Note [Verbosity levels] 5 | "ghc -v -ddump-all" -} -data OnOff a = On a - | Off a - deriving (Eq, Show) - -instance Outputable a => Outputable (OnOff a) where - ppr (On x) = text "On" <+> ppr x - ppr (Off x) = text "Off" <+> ppr x - --- OnOffs accumulate in reverse order, so we use foldr in order to --- process them in the right order -flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension -flattenExtensionFlags ml = foldr f defaultExtensionFlags - where f (On f) flags = EnumSet.insert f flags - f (Off f) flags = EnumSet.delete f flags - defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) - --- | The language extensions implied by the various language variants. --- When updating this be sure to update the flag documentation in --- @docs/users_guide/exts at . -languageExtensions :: Maybe Language -> [LangExt.Extension] - --- Nothing: the default case -languageExtensions Nothing = languageExtensions (Just GHC2021) - -languageExtensions (Just Haskell98) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.NPlusKPatterns, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.FieldSelectors, - LangExt.NondecreasingIndentation, - -- strictly speaking non-standard, but we always had this - -- on implicitly before the option was added in 7.1, and - -- turning it off breaks code, so we're keeping it on for - -- backwards compatibility. Cabal uses -XHaskell98 by - -- default unless you specify another language. - LangExt.DeepSubsumption - -- Non-standard but enabled for backwards compatability (see GHC proposal #511) - ] - -languageExtensions (Just Haskell2010) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - LangExt.DeepSubsumption ] - -languageExtensions (Just GHC2021) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.MonomorphismRestriction, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - -- Now the new extensions (not in Haskell2010) - LangExt.BangPatterns, - LangExt.BinaryLiterals, - LangExt.ConstrainedClassMethods, - LangExt.ConstraintKinds, - LangExt.DeriveDataTypeable, - LangExt.DeriveFoldable, - LangExt.DeriveFunctor, - LangExt.DeriveGeneric, - LangExt.DeriveLift, - LangExt.DeriveTraversable, - LangExt.EmptyCase, - LangExt.EmptyDataDeriving, - LangExt.ExistentialQuantification, - LangExt.ExplicitForAll, - LangExt.FlexibleContexts, - LangExt.FlexibleInstances, - LangExt.GADTSyntax, - LangExt.GeneralizedNewtypeDeriving, - LangExt.HexFloatLiterals, - LangExt.ImportQualifiedPost, - LangExt.InstanceSigs, - LangExt.KindSignatures, - LangExt.MultiParamTypeClasses, - LangExt.NamedFieldPuns, - LangExt.NamedWildCards, - LangExt.NumericUnderscores, - LangExt.PolyKinds, - LangExt.PostfixOperators, - LangExt.RankNTypes, - LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" - LangExt.StandaloneDeriving, - LangExt.StandaloneKindSignatures, - LangExt.TupleSections, - LangExt.TypeApplications, - LangExt.TypeOperators, - LangExt.TypeSynonymInstances] - -hasPprDebug :: DynFlags -> Bool -hasPprDebug = dopt Opt_D_ppr_debug - -hasNoDebugOutput :: DynFlags -> Bool -hasNoDebugOutput = dopt Opt_D_no_debug_output - -hasNoStateHack :: DynFlags -> Bool -hasNoStateHack = gopt Opt_G_NoStateHack - -hasNoOptCoercion :: DynFlags -> Bool -hasNoOptCoercion = gopt Opt_G_NoOptCoercion - - --- | Test whether a 'DumpFlag' is set -dopt :: DumpFlag -> DynFlags -> Bool -dopt = getDumpFlagFrom verbosity dumpFlags - --- | Set a 'DumpFlag' -dopt_set :: DynFlags -> DumpFlag -> DynFlags -dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } - --- | Unset a 'DumpFlag' -dopt_unset :: DynFlags -> DumpFlag -> DynFlags -dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } - --- | Test whether a 'GeneralFlag' is set --- --- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) --- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables --- Opt_SplitSections. --- -gopt :: GeneralFlag -> DynFlags -> Bool -gopt Opt_PIC dflags - | dynamicNow dflags = True -gopt Opt_ExternalDynamicRefs dflags - | dynamicNow dflags = True -gopt Opt_SplitSections dflags - | dynamicNow dflags = False -gopt f dflags = f `EnumSet.member` generalFlags dflags - --- | Set a 'GeneralFlag' -gopt_set :: DynFlags -> GeneralFlag -> DynFlags -gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } - --- | Unset a 'GeneralFlag' -gopt_unset :: DynFlags -> GeneralFlag -> DynFlags -gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } - --- | Test whether a 'WarningFlag' is set -wopt :: WarningFlag -> DynFlags -> Bool -wopt f dflags = f `EnumSet.member` warningFlags dflags - --- | Set a 'WarningFlag' -wopt_set :: DynFlags -> WarningFlag -> DynFlags -wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } - --- | Unset a 'WarningFlag' -wopt_unset :: DynFlags -> WarningFlag -> DynFlags -wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } - --- | Test whether a 'WarningFlag' is set as fatal -wopt_fatal :: WarningFlag -> DynFlags -> Bool -wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags - --- | Mark a 'WarningFlag' as fatal (do not set the flag) -wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_set_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } - --- | Mark a 'WarningFlag' as not fatal -wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_unset_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } - - --- | Enable all custom warning categories. -wopt_set_all_custom :: DynFlags -> DynFlags -wopt_set_all_custom dfs - = dfs{ customWarningCategories = completeWarningCategorySet } - --- | Disable all custom warning categories. -wopt_unset_all_custom :: DynFlags -> DynFlags -wopt_unset_all_custom dfs - = dfs{ customWarningCategories = emptyWarningCategorySet } - --- | Mark all custom warning categories as fatal (do not set the flags). -wopt_set_all_fatal_custom :: DynFlags -> DynFlags -wopt_set_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = completeWarningCategorySet } - --- | Mark all custom warning categories as non-fatal. -wopt_unset_all_fatal_custom :: DynFlags -> DynFlags -wopt_unset_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } - --- | Set a custom 'WarningCategory' -wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } - --- | Unset a custom 'WarningCategory' -wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as fatal (do not set the flag) -wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as not fatal -wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Are there any custom warning categories enabled? -wopt_any_custom :: DynFlags -> Bool -wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) - - --- | Test whether a 'LangExt.Extension' is set -xopt :: LangExt.Extension -> DynFlags -> Bool -xopt f dflags = f `EnumSet.member` extensionFlags dflags - --- | Set a 'LangExt.Extension' -xopt_set :: DynFlags -> LangExt.Extension -> DynFlags -xopt_set dfs f - = let onoffs = On f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Unset a 'LangExt.Extension' -xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags -xopt_unset dfs f - = let onoffs = Off f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Set or unset a 'LangExt.Extension', unless it has been explicitly --- set or unset before. -xopt_set_unlessExplSpec - :: LangExt.Extension - -> (DynFlags -> LangExt.Extension -> DynFlags) - -> DynFlags -> DynFlags -xopt_set_unlessExplSpec ext setUnset dflags = - let referedExts = stripOnOff <$> extensions dflags - stripOnOff (On x) = x - stripOnOff (Off x) = x - in - if ext `elem` referedExts then dflags else setUnset dflags ext - -xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields -xopt_DuplicateRecordFields dfs - | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields - | otherwise = FieldLabel.NoDuplicateRecordFields - -xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors -xopt_FieldSelectors dfs - | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors - | otherwise = FieldLabel.NoFieldSelectors - -lang_set :: DynFlags -> Maybe Language -> DynFlags -lang_set dflags lang = - dflags { - language = lang, - extensionFlags = flattenExtensionFlags lang (extensions dflags) - } - -- | Set the Haskell language standard to use setLanguage :: Language -> DynP () setLanguage l = upd (`lang_set` Just l) @@ -3119,11 +1967,6 @@ flagsForCompletion isInteractive modeFilter OnlyGhc = not isInteractive modeFilter HiddenFlag = False -type TurnOnFlag = Bool -- True <=> we are turning the flag on - -- False <=> we are turning the flag off -turnOn :: TurnOnFlag; turnOn = True -turnOff :: TurnOnFlag; turnOff = False - data FlagSpec flag = FlagSpec { flagSpecName :: String -- ^ Flag in string form @@ -3874,62 +2717,6 @@ xFlagsDeps = [ flagSpec "ViewPatterns" LangExt.ViewPatterns ] -defaultFlags :: Settings -> [GeneralFlag] -defaultFlags settings --- See Note [Updating flag description in the User's Guide] - = [ Opt_AutoLinkPackages, - Opt_DiagnosticsShowCaret, - Opt_EmbedManifest, - Opt_FamAppCache, - Opt_GenManifest, - Opt_GhciHistory, - Opt_GhciSandbox, - Opt_HelpfulErrors, - Opt_KeepHiFiles, - Opt_KeepOFiles, - Opt_OmitYields, - Opt_PrintBindContents, - Opt_ProfCountEntries, - Opt_SharedImplib, - Opt_SimplPreInlining, - Opt_VersionMacros, - Opt_RPath, - Opt_DumpWithWays, - Opt_CompactUnwind, - Opt_ShowErrorContext, - Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter - ] - - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - - -- Default floating flags (see Note [RHS Floating]) - ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] - - - ++ default_PIC platform - - ++ validHoleFitDefaults - - - where platform = sTargetPlatform settings - --- | These are the default settings for the display and sorting of valid hole --- fits in typed-hole error messages. See Note [Valid hole fits include ...] - -- in the "GHC.Tc.Errors.Hole" module. -validHoleFitDefaults :: [GeneralFlag] -validHoleFitDefaults - = [ Opt_ShowTypeAppOfHoleFits - , Opt_ShowTypeOfHoleFits - , Opt_ShowProvOfHoleFits - , Opt_ShowMatchesOfHoleFits - , Opt_ShowValidHoleFits - , Opt_SortValidHoleFits - , Opt_SortBySizeHoleFits - , Opt_ShowHoleConstraints ] - - validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] validHoleFitsImpliedGFlags = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) @@ -3938,32 +2725,6 @@ validHoleFitsImpliedGFlags , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ] -default_PIC :: Platform -> [GeneralFlag] -default_PIC platform = - case (platformOS platform, platformArch platform) of - -- Darwin always requires PIC. Especially on more recent macOS releases - -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses - -- while we could work around this on x86_64 (like WINE does), we won't be - -- able on aarch64, where this is enforced. - (OSDarwin, ArchX86_64) -> [Opt_PIC] - -- For AArch64, we need to always have PIC enabled. The relocation model - -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't - -- control much how far apart symbols are in memory for our in-memory static - -- linker; and thus need to ensure we get sufficiently capable relocations. - -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top - -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to - -- be built with -fPIC. - (OSDarwin, ArchAArch64) -> [Opt_PIC] - (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in - -- OpenBSD since 5.3 release - -- (1 May 2013) we need to - -- always generate PIC. See - -- #10597 for more - -- information. - _ -> [] - -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] @@ -4053,85 +2814,6 @@ impliedXFlags , (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures) ] --- Note [When is StarIsType enabled] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- The StarIsType extension determines whether to treat '*' as a regular type --- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType --- programs expect '*' to be synonymous with 'Type', so by default StarIsType is --- enabled. --- --- Programs that use TypeOperators might expect to repurpose '*' for --- multiplication or another binary operation, but making TypeOperators imply --- NoStarIsType caused too much breakage on Hackage. --- - --- Note [Documenting optimisation flags] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- If you change the list of flags enabled for particular optimisation levels --- please remember to update the User's Guide. The relevant file is: --- --- docs/users_guide/using-optimisation.rst --- --- Make sure to note whether a flag is implied by -O0, -O or -O2. - -optLevelFlags :: [([Int], GeneralFlag)] --- Default settings of flags, before any command-line overrides -optLevelFlags -- see Note [Documenting optimisation flags] - = [ ([0,1,2], Opt_DoLambdaEtaExpansion) - , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] - , ([0,1,2], Opt_LlvmTBAA) - , ([0,1,2], Opt_ProfManualCcs ) - , ([2], Opt_DictsStrict) - - , ([0], Opt_IgnoreInterfacePragmas) - , ([0], Opt_OmitInterfacePragmas) - - , ([1,2], Opt_CoreConstantFolding) - - , ([1,2], Opt_CallArity) - , ([1,2], Opt_Exitification) - , ([1,2], Opt_CaseMerge) - , ([1,2], Opt_CaseFolding) - , ([1,2], Opt_CmmElimCommonBlocks) - , ([2], Opt_AsmShortcutting) - , ([1,2], Opt_CmmSink) - , ([1,2], Opt_CmmStaticPred) - , ([1,2], Opt_CSE) - , ([1,2], Opt_StgCSE) - , ([2], Opt_StgLiftLams) - , ([1,2], Opt_CmmControlFlow) - - , ([1,2], Opt_EnableRewriteRules) - -- Off for -O0. Otherwise we desugar list literals - -- to 'build' but don't run the simplifier passes that - -- would rewrite them back to cons cells! This seems - -- silly, and matters for the GHCi debugger. - - , ([1,2], Opt_FloatIn) - , ([1,2], Opt_FullLaziness) - , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_Loopification) - , ([1,2], Opt_CfgBlocklayout) -- Experimental - - , ([1,2], Opt_Specialise) - , ([1,2], Opt_CrossModuleSpecialise) - , ([1,2], Opt_InlineGenerics) - , ([1,2], Opt_Strictness) - , ([1,2], Opt_UnboxSmallStrictFields) - , ([1,2], Opt_CprAnal) - , ([1,2], Opt_WorkerWrapper) - , ([1,2], Opt_SolveConstantDicts) - , ([1,2], Opt_NumConstantFolding) - - , ([2], Opt_LiberateCase) - , ([2], Opt_SpecConstr) - , ([2], Opt_FastPAPCalls) --- , ([2], Opt_RegsGraph) --- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) --- Static Argument Transformation needs investigation. See #9374 - ] -- | Things you get with `-dlint`. @@ -4439,12 +3121,6 @@ setDebugLevel mb_n = | n > 2 = setGeneralFlag' Opt_ExposeInternalSymbols | otherwise = id -data PkgDbRef - = GlobalPkgDb - | UserPkgDb - | PkgDbPath FilePath - deriving Eq - addPkgDbRef :: PkgDbRef -> DynP () addPkgDbRef p = upd $ \s -> s { packageDBFlags = PackageDB p : packageDBFlags s } @@ -5070,29 +3746,6 @@ needSourceNotes dflags = debugLevel dflags > 0 -- ----------------------------------------------------------------------------- -- Linker/compiler information --- LinkerInfo contains any extra options needed by the system linker. -data LinkerInfo - = GnuLD [Option] - | Mold [Option] - | GnuGold [Option] - | LlvmLLD [Option] - | DarwinLD [Option] - | SolarisLD [Option] - | AixLD [Option] - | UnknownLD - deriving Eq - --- CompilerInfo tells us which C compiler we're using -data CompilerInfo - = GCC - | Clang - | AppleClang - | AppleClang51 - | Emscripten - | UnknownCC - deriving Eq - - -- | Should we use `-XLinker -rpath` when linking or not? -- See Note [-fno-use-rpaths] useXLinkerRPath :: DynFlags -> OS -> Bool @@ -5144,60 +3797,6 @@ decodeSize str foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO () foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO () - --- | Initialize the pretty-printing options -initSDocContext :: DynFlags -> PprStyle -> SDocContext -initSDocContext dflags style = SDC - { sdocStyle = style - , sdocColScheme = colScheme dflags - , sdocLastColour = Col.colReset - , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) - , sdocDefaultDepth = pprUserLength dflags - , sdocLineLength = pprCols dflags - , sdocCanUseUnicode = useUnicode dflags - , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags - , sdocPprDebug = dopt Opt_D_ppr_debug dflags - , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags - , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags - , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags - , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags - , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags - , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags - , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags - , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags - , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags - , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags - , sdocSuppressTicks = gopt Opt_SuppressTicks dflags - , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags - , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags - , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags - , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags - , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags - , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags - , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags - , sdocSuppressUniques = gopt Opt_SuppressUniques dflags - , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags - , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags - , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags - , sdocErrorSpans = gopt Opt_ErrorSpans dflags - , sdocStarIsType = xopt LangExt.StarIsType dflags - , sdocLinearTypes = xopt LangExt.LinearTypes dflags - , sdocListTuplePuns = True - , sdocPrintTypeAbbreviations = True - , sdocUnitIdForUser = ftext - } - --- | Initialize the pretty-printing options using the default user style -initDefaultSDocContext :: DynFlags -> SDocContext -initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle - -initPromotionTickContext :: DynFlags -> PromotionTickContext -initPromotionTickContext dflags = - PromTickCtx { - ptcListTuplePuns = True, - ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags - } - outputFile :: DynFlags -> Maybe String outputFile dflags | dynamicNow dflags = dynOutputFile_ dflags @@ -5208,11 +3807,6 @@ objectSuf dflags | dynamicNow dflags = dynObjectSuf_ dflags | otherwise = objectSuf_ dflags -ways :: DynFlags -> Ways -ways dflags - | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) - | otherwise = targetWays_ dflags - -- | Pretty-print the difference between 2 DynFlags. -- -- For now only their general flags but it could be extended. ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -82,7 +82,7 @@ import GHC.Types.SrcLoc import GHC.Data.Bag -- collect ev vars from pats import GHC.Data.Maybe import GHC.Types.Name (Name, dataName) -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import qualified GHC.LanguageExtensions as LangExt import Data.Data ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude import GHC.Core (CoreRule, CoreExpr, RuleName) import GHC.Core.DataCon import GHC.Core.Type -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import GHC.Driver.Flags (WarningFlag) import GHC.Hs import GHC.HsToCore.Pmc.Solver.Types ===================================== compiler/GHC/Runtime/Context.hs ===================================== @@ -19,7 +19,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Plugins import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume ) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -119,7 +119,7 @@ import GHC.Core import GHC.Core.TyCo.Ppr import GHC.Utils.FV import GHC.Types.Var.Set -import GHC.Driver.Session (DynFlags(reductionDepth)) +import GHC.Driver.DynFlags (DynFlags(reductionDepth)) import GHC.Builtin.Names import GHC.Types.Basic import GHC.Types.Unique.Set ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -232,7 +232,7 @@ import {-# SOURCE #-} GHC.Tc.Types.Origin , FixedRuntimeRepOrigin, FixedRuntimeRepContext ) -- others: -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.Name as Name -- We use this to make dictionaries for type literals. -- Perhaps there's a better way to do this? ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -78,7 +78,7 @@ import GHC.Utils.Panic.Plain import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import GHC.Utils.Misc (HasDebugCallStack) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) import GHC.Unit.Module.ModIface ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -51,7 +51,7 @@ import GHC.Data.Maybe import GHC.Data.Graph.Directed import GHC.Driver.Backend -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.SourceFile ( hscSourceString ) ===================================== compiler/GHC/Unit/Module/ModSummary.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.Types import GHC.Unit.Module ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -75,7 +75,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Platform import GHC.Platform.Ways ===================================== compiler/ghc.cabal.in ===================================== @@ -434,6 +434,7 @@ Library GHC.Driver.Config.StgToCmm GHC.Driver.Config.Tidy GHC.Driver.Config.StgToJS + GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -1,21 +1,24 @@ ref compiler/GHC/Core/Coercion/Axiom.hs:463:2: Note [RoughMap and rm_empty] ref compiler/GHC/Core/Opt/OccurAnal.hs:983:7: Note [Loop breaking] ref compiler/GHC/Core/Opt/SetLevels.hs:1574:30: Note [Top level scope] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2825:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4009:8: Note [Lambda-bound unfoldings] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2826:13: Note [Case binder next] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4018:8: Note [Lambda-bound unfoldings] ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] -ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] -ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Core/Opt/Specialise.hs:1765:29: Note [Arity decrease] +ref compiler/GHC/Core/TyCo/Rep.hs:1565:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Driver/DynFlags.hs:1234:49: Note [Eta-reduction in -O0] +ref compiler/GHC/Driver/DynFlags.hs:1329:14: Note [When is StarIsType enabled] +ref compiler/GHC/Driver/DynFlags.hs:1349:14: Note [When is StarIsType enabled] +ref compiler/GHC/Driver/DynFlags.hs:1365:14: Note [When is StarIsType enabled] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] -ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice] -ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices] +ref compiler/GHC/Hs/Expr.hs:1738:87: Note [Lifecycle of a splice] +ref compiler/GHC/Hs/Expr.hs:1774:7: Note [Pending Splices] ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constraints] ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations] +ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -32,12 +35,12 @@ ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested sp ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] +ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] -ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics] -ref compiler/GHC/Types/Demand.hs:306:25: Note [Preserving Boxity of results is rarely a win] +ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] +ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:410:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:200:31: Note [fun_id in Match] @@ -46,7 +49,7 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:272:10: Note [WayFlags] +ref testsuite/config/ghc:276:10: Note [WayFlags] ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/442538914ac4d4feb5c96e898530db88f140d602 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/442538914ac4d4feb5c96e898530db88f140d602 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 14 13:46:54 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 14 May 2023 09:46:54 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Two fast paths Message-ID: <6460e64e7da44_171ad94729948c5229d2@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 41d532da by Simon Peyton Jones at 2023-05-14T14:46:31+01:00 Two fast paths * Naturally coherent constraints * Hole-fits - - - - - 2 changed files: - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Solver/Dict.hs Changes: ===================================== compiler/GHC/Tc/Errors/Hole.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ExistentialQuantification #-} module GHC.Tc.Errors.Hole @@ -40,7 +41,10 @@ import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence import GHC.Tc.Utils.TcType import GHC.Core.Type +import GHC.Core.TyCon( TyCon, isGenerativeTyCon ) +import GHC.Core.TyCo.Rep( Type(..) ) import GHC.Core.DataCon +import GHC.Core.Predicate( Pred(..), classifyPredType, eqRelRole ) import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Builtin.Names ( gHC_ERR ) @@ -981,28 +985,33 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $ tcSubTypeSigma orig (ExprSigCtxt NoRRC) ty hole_ty ; traceTc "Checking hole fit {" empty ; traceTc "wanteds are: " $ ppr wanted - ; if isEmptyWC wanted && isEmptyBag th_relevant_cts - then do { traceTc "}" empty - ; return (True, wrap) } - else do { fresh_binds <- newTcEvBinds - -- The relevant constraints may contain HoleDests, so we must - -- take care to clone them as well (to avoid #15370). - ; cloned_relevants <- mapBagM cloneWantedCtEv th_relevant_cts - -- We wrap the WC in the nested implications, for details, see - -- Note [Checking hole fits] - ; let wrapInImpls cts = foldl (flip (setWCAndBinds fresh_binds)) cts th_implics - final_wc = wrapInImpls $ addSimples wanted $ - mapBag mkNonCanonical cloned_relevants - -- We add the cloned relevants to the wanteds generated - -- by the call to tcSubType_NC, for details, see - -- Note [Relevant constraints]. There's no need to clone - -- the wanteds, because they are freshly generated by the - -- call to`tcSubtype_NC`. - ; traceTc "final_wc is: " $ ppr final_wc - -- See Note [Speeding up valid hole-fits] - ; (rem, _) <- tryTc $ runTcSEarlyAbort $ simplifyTopWanteds final_wc - ; traceTc "}" empty - ; return (any isSolvedWC rem, wrap) } } + ; if | isEmptyWC wanted, isEmptyBag th_relevant_cts + -> do { traceTc "}" empty + ; return (True, wrap) } + + | checkInsoluble wanted + -> return (False, wrap) + + | otherwise + -> do { fresh_binds <- newTcEvBinds + -- The relevant constraints may contain HoleDests, so we must + -- take care to clone them as well (to avoid #15370). + ; cloned_relevants <- mapBagM cloneWantedCtEv th_relevant_cts + -- We wrap the WC in the nested implications, for details, see + -- Note [Checking hole fits] + ; let wrapInImpls cts = foldl (flip (setWCAndBinds fresh_binds)) cts th_implics + final_wc = wrapInImpls $ addSimples wanted $ + mapBag mkNonCanonical cloned_relevants + -- We add the cloned relevants to the wanteds generated + -- by the call to tcSubType_NC, for details, see + -- Note [Relevant constraints]. There's no need to clone + -- the wanteds, because they are freshly generated by the + -- call to`tcSubtype_NC`. + ; traceTc "final_wc is: " $ ppr final_wc + -- See Note [Speeding up valid hole-fits] + ; (rem, _) <- tryTc $ runTcSEarlyAbort $ simplifyTopWanteds final_wc + ; traceTc "}" empty + ; return (any isSolvedWC rem, wrap) } } where orig = ExprHoleOrigin (hole_occ <$> th_hole) @@ -1012,3 +1021,31 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $ -> WantedConstraints -- The new constraints. setWCAndBinds binds imp wc = mkImplicWC $ unitBag $ imp { ic_wanted = wc , ic_binds = binds } + +checkInsoluble :: WantedConstraints -> Bool +checkInsoluble (WC { wc_simple = simples }) + = any is_insol simples + where + is_insol ct = case classifyPredType (ctPred ct) of + EqPred r t1 t2 -> definitelyNotEqual (eqRelRole r) t1 t2 + _ -> False + +definitelyNotEqual :: Role -> TcType -> TcType -> Bool +definitelyNotEqual r t1 t2 + = go t1 t2 + where + go t1 t2 + | Just t1' <- coreView t1 = go t1' t2 + | Just t2' <- coreView t2 = go t1 t2' + + go (TyConApp tc _) t2 | isGenerativeTyCon tc r = go_tc tc t2 + go t1 (TyConApp tc _) | isGenerativeTyCon tc r = go_tc tc t1 + go (FunTy {ft_af = af1}) (FunTy {ft_af = af2}) = af1 /= af2 + go _ _ = False + + go_tc :: TyCon -> TcType -> Bool + -- The TyCon is generative, and is not a saturated FunTy + go_tc tc1 (TyConApp tc2 _) | isGenerativeTyCon tc2 r = tc1 /= tc2 + go_tc _ (FunTy {}) = True + go_tc _ (ForAllTy {}) = True + go_tc _ _ = False \ No newline at end of file ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -69,7 +69,7 @@ solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage () -- NC: this comes from CNonCanonical or CIrredCan -- Precondition: already rewritten by inert set solveDictNC ev cls tys - = do { dict_ct <- simpleStage (canDictCt ev cls tys) + = do { dict_ct <- canDictCt ev cls tys ; solveDict dict_ct } solveDict :: DictCt -> SolverStage () @@ -100,18 +100,30 @@ updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev }) -- Add the new constraint to the inert set ; updInertCans (updDicts (addDict dict_ct)) } -canDictCt :: CtEvidence -> Class -> [Type] -> TcS DictCt +canDictCt :: CtEvidence -> Class -> [Type] -> SolverStage DictCt -- Once-only processing of Dict constraints: -- * expand superclasses -- * deal with CallStack canDictCt ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { dflags <- getDynFlags + = Stage $ + do { dflags <- getDynFlags ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys - -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] - ; emitWork (listToBag sc_cts) - ; return (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = doNotExpand }) } + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + + -- For "naturally coherent" classes, /replace/ the current constraint with its + -- superclasses, rather than /adding/ them. + -- See (NC1) in Note [Naturally coherent classes] + ; if naturallyCoherentClass cls + then case sc_cts of + [] -> stopWith ev "Naturally coherent" + ct:cts -> do { emitWork (listToBag cts) + ; startAgainWith ct } + else + + do { emitWork (listToBag sc_cts) + ; continueWith (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = doNotExpand }) } } -- doNotExpand: We have already expanded superclasses for /this/ dict -- so set the fuel to doNotExpand to avoid repeating expansion @@ -123,7 +135,8 @@ canDictCt ev cls tys -- of solving it directly from a given. -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types - = do { -- First we emit a new constraint that will capture the + = Stage $ + do { -- First we emit a new constraint that will capture the -- given CallStack. let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so @@ -139,18 +152,19 @@ canDictCt ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; return (DictCt { di_ev = new_ev, di_cls = cls - , di_tys = tys, di_pend_sc = doNotExpand }) } + ; continueWith (DictCt { di_ev = new_ev, di_cls = cls + , di_tys = tys, di_pend_sc = doNotExpand }) } -- doNotExpand: No superclasses for class CallStack -- See invariants in CDictCan.cc_pend_sc | otherwise - = do { dflags <- getDynFlags + = Stage $ + do { dflags <- getDynFlags ; let fuel | classHasSCs cls = wantedsFuel dflags | otherwise = doNotExpand -- See Invariants in `CCDictCan.cc_pend_sc` - ; return (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = fuel }) } + ; continueWith (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = fuel }) } where loc = ctEvLoc ev orig = ctLocOrigin loc @@ -790,7 +804,7 @@ matchClassInst dflags inerts clas tys loc -- whether top level, or local quantified constraints. -- See Note [Instance and Given overlap] | not (xopt LangExt.IncoherentInstances dflags) - , not (naturallyCoherentClass clas) + , not (naturallyCoherentClass clas) -- See (NC3) in Note [Naturally coherent classes] , not (noMatchableGivenDicts inerts loc clas tys) = do { traceTcS "Delaying instance application" $ vcat [ text "Work item=" <+> pprClassPred clas tys ] @@ -917,14 +931,41 @@ this: instance a ~# b => a ~~ b (See Note [The equality types story] in GHC.Builtin.Types.Prim.) -Faced with [W] t1 ~~ t2, it's always OK to reduce it to [W] t1 ~# t2, -without worrying about Note [Instance and Given overlap]. Why? Because -if we had [G] s1 ~~ s2, then we'd get the superclass [G] s1 ~# s2, and -so the reduction of the [W] constraint does not risk losing any solutions. +PS: the term "naturally coherent" doesn't really seem helpful. +Perhaps "invertible" or something? I left it for now though. -On the other hand, it can be fatal to /fail/ to reduce such -equalities, on the grounds of Note [Instance and Given overlap], -because many good things flow from [W] t1 ~# t2. +For naturally coherent classes: + +(NC1) For Givens, when expanding superclasses, we /replace/ the constraint + with its superclasses (which, remember, are equally powerful) rather than + /adding/ them. This can make a huge difference. Consider T17836, which + has a constraint like + forall b,c. a ~ (b,c) => + forall d,e. c ~ (d,e) => + ...etc... + If we just /add/ the superclasses of [G] g1:a ~ (b,c), we'll put + [G] g1:(a~(b,c)) in the inert set and emit [G] g2:a ~# (b,c). That will + kick out g1, and it'll be re-inserted as [G] g1':(b,c)~(b,c) which does + no good to anyone. When the implication is deeply nested, this has + quadratic cost, and no benefit. Just replace! + +(NC2) Because of this replacement, we don't need do the fancy footwork + of Note [Solving superclass constraints], so the computation of `sc_loc` + in `mk_strict_superclasses` can be simpler. + + For tuple predicates, this matters, because their size can be large, + and we don't want to add a big class to the size of the dictionaries + in the chain. When we get down to a base predicate, we'll include + its size. See #10335 + +(NC3) Faced with [W] t1 ~ t2, it's always OK to reduce it to [W] t1 ~# t2, + without worrying about Note [Instance and Given overlap]. Why? Because + if we had [G] s1 ~ s2, then we'd get the superclass [G] s1 ~# s2, and + so the reduction of the [W] constraint does not risk losing any solutions. + + On the other hand, it can be fatal to /fail/ to reduce such equalities + on the grounds of Note [Instance and Given overlap], fbecause many good + things flow from [W] t1 ~# t2. The same reasoning applies to @@ -947,9 +988,6 @@ And less obviously to: Examples: T5853, T10432, T5315, T9222, T2627b, T3028b -PS: the term "naturally coherent" doesn't really seem helpful. -Perhaps "invertible" or something? I left it for now though. - Note [Local instances and incoherence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -1934,18 +1972,8 @@ mk_strict_superclasses fuel rec_clss ev@(CtGiven { ctev_evar = evar, ctev_loc = `App` (evId evar `mkVarApps` (tvs ++ dict_ids)) `mkVarApps` sc_tvs - sc_loc | isCTupleClass cls - = loc -- For tuple predicates, just take them apart, without - -- adding their (large) size into the chain. When we - -- get down to a base predicate, we'll include its size. - -- #10335 - - | isEqPredClass cls || cls `hasKey` coercibleTyConKey - = loc -- The only superclasses of ~, ~~, and Coercible are primitive - -- equalities, and they don't use the GivenSCOrigin mechanism - -- detailed in Note [Solving superclass constraints] in - -- GHC.Tc.TyCl.Instance. Skip for a tiny performance win. - + sc_loc | naturallyCoherentClass cls + = loc -- See (NC2) in Note [Naturally coherence classes] | otherwise = loc { ctl_origin = mk_sc_origin (ctLocOrigin loc) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41d532da73d22f3b5f1d761592a3b99aafb6db20 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41d532da73d22f3b5f1d761592a3b99aafb6db20 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 14 14:49:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 14 May 2023 10:49:48 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 246 commits: Bump Win32 to 2.13.4.0 Message-ID: <6460f50cbf793_171ad9472994a0528297@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - e9b32833 by Ben Gamari at 2023-05-11T14:59:16-04:00 compiler/tc: Small optimisation of evCallStack Don't lookupIds unless we actually need them. - - - - - 2fea0c66 by Ben Gamari at 2023-05-11T14:59:16-04:00 compiler/tc: Use toException instead of SomeException - - - - - c167b8fb by Ben Gamari at 2023-05-11T14:59:17-04:00 compiler: Drop redundant import - - - - - 123760ca by Ben Gamari at 2023-05-11T14:59:17-04:00 base: Factor out errorBelch This was useful when debugging - - - - - 660c3770 by Ben Gamari at 2023-05-11T14:59:17-04:00 base: Clean up imports of GHC.ExecutionStack - - - - - 65cb774b by Ben Gamari at 2023-05-11T14:59:17-04:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - d632ebae by Ben Gamari at 2023-05-11T14:59:17-04:00 base: Move prettyCallStack to GHC.Stack - - - - - 7ffe271c by Ben Gamari at 2023-05-11T14:59:17-04:00 base: Move PrimMVar to GHC.MVar - - - - - 9c23d3aa by Ben Gamari at 2023-05-11T14:59:17-04:00 base: Use displayException in top-level exception handler Happily this also allows us to eliminate a special case for Deadlock exceptions. - - - - - d8db688d by Ben Gamari at 2023-05-11T15:00:19-04:00 base: Introduce exception context - - - - - 688446d6 by Ben Gamari at 2023-05-14T10:49:41-04:00 compiler: Default and warn ExceptionContext constraints - - - - - 14c7923f by Ben Gamari at 2023-05-14T10:49:41-04:00 base: Introduce WhileHandling annotations - - - - - 654a3320 by Ben Gamari at 2023-05-14T10:49:41-04:00 base: Don't collect backtraces in onException - - - - - 762ae30b by Ben Gamari at 2023-05-14T10:49:41-04:00 rts: Don't dump IPE entries on startup with DEBUG rts - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d9ea503c8d71d14325ce4e0b590d8dc136f5b10...762ae30b5f30df6a6c432305cb9d114c4fa6e4a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d9ea503c8d71d14325ce4e0b590d8dc136f5b10...762ae30b5f30df6a6c432305cb9d114c4fa6e4a4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 14 15:43:36 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Sun, 14 May 2023 11:43:36 -0400 Subject: [Git][ghc/ghc][wip/ghc-driver-dynflags] Split DynFlags structure into own module Message-ID: <646101a8e893e_171ad9470be310532846@gitlab.mail> Oleg Grenrus pushed to branch wip/ghc-driver-dynflags at Glasgow Haskell Compiler / GHC Commits: 2636861b by Oleg Grenrus at 2023-05-14T18:43:01+03:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 27 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/State.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -26,7 +26,7 @@ import qualified Text.ParserCombinators.ReadP as P import GHC.Prelude import GHC.Utils.Outputable as Outputable -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.CostCentre import GHC.Types.CostCentre.State import GHC.Types.Name hiding (varName) ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Core.Opt.Monad ( import GHC.Prelude hiding ( read ) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv ) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Unit.Module.Env import GHC.Unit.Module.ModGuts( ModGuts(..) ) import GHC.Unit.Module.Deps( Dependencies(..) ) -import GHC.Driver.Session( DynFlags ) +import GHC.Driver.DynFlags( DynFlags ) import GHC.Driver.Ppr( showSDoc ) import GHC.Core -- All of it ===================================== compiler/GHC/Data/IOEnv.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Data.IOEnv ( import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Hooks import GHC.IO (catchException) import GHC.Utils.Exception ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Driver.Config.Diagnostic where import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Prelude import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Config/Logger.hs ===================================== @@ -5,7 +5,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Logger (LogFlags (..)) import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -0,0 +1,1520 @@ +{-# LANGUAGE LambdaCase #-} +module GHC.Driver.DynFlags ( + -- * Dynamic flags and associated configuration types + DumpFlag(..), + GeneralFlag(..), + WarningFlag(..), DiagnosticReason(..), + Language(..), + FatalMessager, FlushOut(..), + ProfAuto(..), + hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion, + dopt, dopt_set, dopt_unset, + gopt, gopt_set, gopt_unset, + wopt, wopt_set, wopt_unset, + wopt_fatal, wopt_set_fatal, wopt_unset_fatal, + wopt_set_all_custom, wopt_unset_all_custom, + wopt_set_all_fatal_custom, wopt_unset_all_fatal_custom, + wopt_set_custom, wopt_unset_custom, + wopt_set_fatal_custom, wopt_unset_fatal_custom, + wopt_any_custom, + xopt, xopt_set, xopt_unset, + xopt_set_unlessExplSpec, + xopt_DuplicateRecordFields, + xopt_FieldSelectors, + lang_set, + DynamicTooState(..), dynamicTooState, setDynamicNow, + OnOff(..), + DynFlags(..), + ParMakeCount(..), + ways, + HasDynFlags(..), ContainsDynFlags(..), + RtsOptsEnabled(..), + GhcMode(..), isOneShot, + GhcLink(..), isNoLink, + PackageFlag(..), PackageArg(..), ModRenaming(..), + packageFlagsChanged, + IgnorePackageFlag(..), TrustFlag(..), + PackageDBFlag(..), PkgDbRef(..), + Option(..), showOpt, + DynLibLoader(..), + positionIndependent, + optimisationFlags, + + -- ** Manipulating DynFlags + defaultDynFlags, -- Settings -> DynFlags + initDynFlags, -- DynFlags -> IO DynFlags + defaultFatalMessager, + defaultFlushOut, + optLevelFlags, + languageExtensions, + + TurnOnFlag, + turnOn, + turnOff, + + -- ** System tool settings and locations + programName, projectVersion, + ghcUsagePath, ghciUsagePath, topDir, toolDir, + versionedAppDir, versionedFilePath, + extraGccViaCFlags, globalPackageDatabasePath, + + -- * Linker/compiler information + LinkerInfo(..), + CompilerInfo(..), + + -- * Include specifications + IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes, + addImplicitQuoteInclude, + + -- * SDoc + initSDocContext, initDefaultSDocContext, + initPromotionTickContext, +) where + +import GHC.Prelude + +import GHC.Platform +import GHC.Platform.Ways + +import GHC.CmmToAsm.CFG.Weight +import GHC.Core.Unfold +import GHC.Data.Bool +import GHC.Data.EnumSet (EnumSet) +import GHC.Data.Maybe +import GHC.Builtin.Names ( mAIN_NAME ) +import GHC.Driver.Backend +import GHC.Driver.Flags +import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.Plugins.External +import GHC.Settings +import GHC.Settings.Constants +import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) +import GHC.Types.Error (DiagnosticReason(..)) +import GHC.Types.ProfAuto +import GHC.Types.SafeHaskell +import GHC.Types.SrcLoc +import GHC.Unit.Module +import GHC.Unit.Module.Warnings +import GHC.Utils.CliOption +import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) +import GHC.UniqueSubdir (uniqueSubdir) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.TmpFs + +import qualified GHC.Types.FieldLabel as FieldLabel +import qualified GHC.Utils.Ppr.Colour as Col +import qualified GHC.Data.EnumSet as EnumSet + +import {-# SOURCE #-} GHC.Core.Opt.CallerCC + +import Control.Monad (msum, (<=<)) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.Writer (WriterT) +import Data.IORef +import System.IO +import System.IO.Error (catchIOError) +import System.Environment (lookupEnv) +import System.FilePath (normalise, ()) +import System.Directory +import GHC.Foreign (withCString, peekCString) + +import qualified Data.Set as Set + +import qualified GHC.LanguageExtensions as LangExt + +-- ----------------------------------------------------------------------------- +-- DynFlags + +-- | Contains not only a collection of 'GeneralFlag's but also a plethora of +-- information relating to the compilation of a single file or GHC session +data DynFlags = DynFlags { + ghcMode :: GhcMode, + ghcLink :: GhcLink, + backend :: !Backend, + -- ^ The backend to use (if any). + -- + -- Whenever you change the backend, also make sure to set 'ghcLink' to + -- something sensible. + -- + -- 'NoBackend' can be used to avoid generating any output, however, note that: + -- + -- * If a program uses Template Haskell the typechecker may need to run code + -- from an imported module. To facilitate this, code generation is enabled + -- for modules imported by modules that use template haskell, using the + -- default backend for the platform. + -- See Note [-fno-code mode]. + + + -- formerly Settings + ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, + fileSettings :: {-# UNPACK #-} !FileSettings, + targetPlatform :: Platform, -- Filled in by SysTools + toolSettings :: {-# UNPACK #-} !ToolSettings, + platformMisc :: {-# UNPACK #-} !PlatformMisc, + rawSettings :: [(String, String)], + tmpDir :: TempDir, + + llvmOptLevel :: Int, -- ^ LLVM optimisation level + verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] + debugLevel :: Int, -- ^ How much debug information to produce + simplPhases :: Int, -- ^ Number of simplifier phases + maxSimplIterations :: Int, -- ^ Max simplifier iterations + ruleCheck :: Maybe String, + strictnessBefore :: [Int], -- ^ Additional demand analysis + + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. + + enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? + ghcHeapSize :: Maybe Int, -- ^ The heap size to set. + + maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt + -- to show in type error messages + maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show + -- in typed hole error messages + maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole + -- fits to show in typed hole error + -- messages + refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for + -- refinement hole fits in typed hole + -- error messages + maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show + -- in non-exhaustiveness warnings + maxPmCheckModels :: Int, -- ^ Soft limit on the number of models + -- the pattern match checker checks + -- a pattern against. A safe guard + -- against exponential blow-up. + simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks + dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an + -- Unboxed demand on returned products with at most + -- this number of fields + specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr + specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function + specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types + -- Not optional; otherwise ForceSpecConstr can diverge. + binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above + -- this threshold will be dumped in a binary file + -- by the assembler code generator. 0 and Nothing disables + -- this feature. See 'GHC.StgToCmm.Config'. + liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase + floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating + -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' + + liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- recursive function. + liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- non-recursive function. + liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call + -- into an unknown call. + + cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. + + historySize :: Int, -- ^ Simplification history size + + importPaths :: [FilePath], + mainModuleNameIs :: ModuleName, + mainFunIs :: Maybe String, + reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth + solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver + -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + homeUnitId_ :: UnitId, -- ^ Target home unit-id + homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate + homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations + + -- Note [Filepaths and Multiple Home Units] + workingDirectory :: Maybe FilePath, + thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units + hiddenModules :: Set.Set ModuleName, + reexportedModules :: Set.Set ModuleName, + + -- ways + targetWays_ :: Ways, -- ^ Target way flags from the command line + + -- For object splitting + splitInfo :: Maybe (String,Int), + + -- paths etc. + objectDir :: Maybe String, + dylibInstallName :: Maybe String, + hiDir :: Maybe String, + hieDir :: Maybe String, + stubDir :: Maybe String, + dumpDir :: Maybe String, + + objectSuf_ :: String, + hcSuf :: String, + hiSuf_ :: String, + hieSuf :: String, + + dynObjectSuf_ :: String, + dynHiSuf_ :: String, + + outputFile_ :: Maybe String, + dynOutputFile_ :: Maybe String, + outputHi :: Maybe String, + dynOutputHi :: Maybe String, + dynLibLoader :: DynLibLoader, + + dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output + -- because of -dynamic-too. This predicate is + -- used to query the appropriate fields + -- (outputFile/dynOutputFile, ways, etc.) + + -- | This defaults to 'non-module'. It can be set by + -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on + -- where its output is going. + dumpPrefix :: FilePath, + + -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' + -- or 'ghc.GHCi.UI.runStmt'. + -- Set by @-ddump-file-prefix@ + dumpPrefixForce :: Maybe FilePath, + + ldInputs :: [Option], + + includePaths :: IncludeSpecs, + libraryPaths :: [String], + frameworkPaths :: [String], -- used on darwin only + cmdlineFrameworks :: [String], -- ditto + + rtsOpts :: Maybe String, + rtsOptsEnabled :: RtsOptsEnabled, + rtsOptsSuggestions :: Bool, + + hpcDir :: String, -- ^ Path to store the .mix files + + -- Plugins + pluginModNames :: [ModuleName], + -- ^ the @-fplugin@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + pluginModNameOpts :: [(ModuleName,String)], + frontendPluginOpts :: [String], + -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + + externalPluginSpecs :: [ExternalPluginSpec], + -- ^ External plugins loaded from shared libraries + + -- For ghc -M + depMakefile :: FilePath, + depIncludePkgDeps :: Bool, + depIncludeCppDeps :: Bool, + depExcludeMods :: [ModuleName], + depSuffixes :: [String], + + -- Package flags + packageDBFlags :: [PackageDBFlag], + -- ^ The @-package-db@ flags given on the command line, In + -- *reverse* order that they're specified on the command line. + -- This is intended to be applied with the list of "initial" + -- package databases derived from @GHC_PACKAGE_PATH@; see + -- 'getUnitDbRefs'. + + ignorePackageFlags :: [IgnorePackageFlag], + -- ^ The @-ignore-package@ flags from the command line. + -- In *reverse* order that they're specified on the command line. + packageFlags :: [PackageFlag], + -- ^ The @-package@ and @-hide-package@ flags from the command-line. + -- In *reverse* order that they're specified on the command line. + pluginPackageFlags :: [PackageFlag], + -- ^ The @-plugin-package-id@ flags from command line. + -- In *reverse* order that they're specified on the command line. + trustFlags :: [TrustFlag], + -- ^ The @-trust@ and @-distrust@ flags. + -- In *reverse* order that they're specified on the command line. + packageEnv :: Maybe FilePath, + -- ^ Filepath to the package environment file (if overriding default) + + + -- hsc dynamic flags + dumpFlags :: EnumSet DumpFlag, + generalFlags :: EnumSet GeneralFlag, + warningFlags :: EnumSet WarningFlag, + fatalWarningFlags :: EnumSet WarningFlag, + customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] + fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings + -- Don't change this without updating extensionFlags: + language :: Maybe Language, + -- | Safe Haskell mode + safeHaskell :: SafeHaskellMode, + safeInfer :: Bool, + safeInferred :: Bool, + -- We store the location of where some extension and flags were turned on so + -- we can produce accurate error messages when Safe Haskell fails due to + -- them. + thOnLoc :: SrcSpan, + newDerivOnLoc :: SrcSpan, + deriveViaOnLoc :: SrcSpan, + overlapInstLoc :: SrcSpan, + incoherentOnLoc :: SrcSpan, + pkgTrustOnLoc :: SrcSpan, + warnSafeOnLoc :: SrcSpan, + warnUnsafeOnLoc :: SrcSpan, + trustworthyOnLoc :: SrcSpan, + -- Don't change this without updating extensionFlags: + -- Here we collect the settings of the language extensions + -- from the command line, the ghci config file and + -- from interactive :set / :seti commands. + extensions :: [OnOff LangExt.Extension], + -- extensionFlags should always be equal to + -- flattenExtensionFlags language extensions + -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used + -- by template-haskell + extensionFlags :: EnumSet LangExt.Extension, + + -- | Unfolding control + -- See Note [Discounts and thresholds] in GHC.Core.Unfold + unfoldingOpts :: !UnfoldingOpts, + + maxWorkerArgs :: Int, + + ghciHistSize :: Int, + + flushOut :: FlushOut, + + ghcVersionFile :: Maybe FilePath, + haddockOptions :: Maybe String, + + -- | GHCi scripts specified by -ghci-script, in reverse order + ghciScripts :: [String], + + -- Output style options + pprUserLength :: Int, + pprCols :: Int, + + useUnicode :: Bool, + useColor :: OverridingBool, + canUseColor :: Bool, + colScheme :: Col.Scheme, + + -- | what kind of {-# SCC #-} to add automatically + profAuto :: ProfAuto, + callerCcFilters :: [CallerCcFilter], + + interactivePrint :: Maybe String, + + -- | Machine dependent flags (-m\ stuff) + sseVersion :: Maybe SseVersion, + bmiVersion :: Maybe BmiVersion, + avx :: Bool, + avx2 :: Bool, + avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. + avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. + avx512f :: Bool, -- Enable AVX-512 instructions. + avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. + fma :: Bool, -- ^ Enable FMA instructions. + + -- | Run-time linker information (what options we need, etc.) + rtldInfo :: IORef (Maybe LinkerInfo), + + -- | Run-time C compiler information + rtccInfo :: IORef (Maybe CompilerInfo), + + -- | Run-time assembler information + rtasmInfo :: IORef (Maybe CompilerInfo), + + -- Constants used to control the amount of optimization done. + + -- | Max size, in bytes, of inline array allocations. + maxInlineAllocSize :: Int, + + -- | Only inline memcpy if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemcpyInsns :: Int, + + -- | Only inline memset if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemsetInsns :: Int, + + -- | Reverse the order of error messages in GHC/GHCi + reverseErrors :: Bool, + + -- | Limit the maximum number of errors to show + maxErrors :: Maybe Int, + + -- | Unique supply configuration for testing build determinism + initialUnique :: Word, + uniqueIncrement :: Int, + -- 'Int' because it can be used to test uniques in decreasing order. + + -- | Temporary: CFG Edge weights for fast iterations + cfgWeights :: Weights +} + +class HasDynFlags m where + getDynFlags :: m DynFlags + +{- It would be desirable to have the more generalised + + instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where + getDynFlags = lift getDynFlags + +instance definition. However, that definition would overlap with the +`HasDynFlags (GhcT m)` instance. Instead we define instances for a +couple of common Monad transformers explicitly. -} + +instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where + getDynFlags = lift getDynFlags + +class ContainsDynFlags t where + extractDynFlags :: t -> DynFlags + +----------------------------------------------------------------------------- + +-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value +initDynFlags :: DynFlags -> IO DynFlags +initDynFlags dflags = do + let + refRtldInfo <- newIORef Nothing + refRtccInfo <- newIORef Nothing + refRtasmInfo <- newIORef Nothing + canUseUnicode <- do let enc = localeEncoding + str = "‘’" + (withCString enc str $ \cstr -> + do str' <- peekCString enc cstr + return (str == str')) + `catchIOError` \_ -> return False + ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" + let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode + maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" + maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" + let adjustCols (Just env) = Col.parseScheme env + adjustCols Nothing = id + let (useColor', colScheme') = + (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) + (useColor dflags, colScheme dflags) + tmp_dir <- normalise <$> getTemporaryDirectory + return dflags{ + useUnicode = useUnicode', + useColor = useColor', + canUseColor = stderrSupportsAnsiColors, + colScheme = colScheme', + rtldInfo = refRtldInfo, + rtccInfo = refRtccInfo, + rtasmInfo = refRtasmInfo, + tmpDir = TempDir tmp_dir + } + +-- | The normal 'DynFlags'. Note that they are not suitable for use in this form +-- and must be fully initialized by 'GHC.runGhc' first. +defaultDynFlags :: Settings -> DynFlags +defaultDynFlags mySettings = +-- See Note [Updating flag description in the User's Guide] + DynFlags { + ghcMode = CompManager, + ghcLink = LinkBinary, + backend = platformDefaultBackend (sTargetPlatform mySettings), + verbosity = 0, + debugLevel = 0, + simplPhases = 2, + maxSimplIterations = 4, + ruleCheck = Nothing, + binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) + maxRelevantBinds = Just 6, + maxValidHoleFits = Just 6, + maxRefHoleFits = Just 6, + refLevelHoleFits = Nothing, + maxUncoveredPatterns = 4, + maxPmCheckModels = 30, + simplTickFactor = 100, + dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple + specConstrThreshold = Just 2000, + specConstrCount = Just 3, + specConstrRecursive = 3, + liberateCaseThreshold = Just 2000, + floatLamArgs = Just 0, -- Default: float only if no fvs + liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsKnown = False, -- Default: don't turn known calls into unknown ones + cmmProcAlignment = Nothing, + + historySize = 20, + strictnessBefore = [], + + parMakeCount = Nothing, + + enableTimeStats = False, + ghcHeapSize = Nothing, + + importPaths = ["."], + mainModuleNameIs = mAIN_NAME, + mainFunIs = Nothing, + reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, + solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, + + homeUnitId_ = mainUnitId, + homeUnitInstanceOf_ = Nothing, + homeUnitInstantiations_ = [], + + workingDirectory = Nothing, + thisPackageName = Nothing, + hiddenModules = Set.empty, + reexportedModules = Set.empty, + + objectDir = Nothing, + dylibInstallName = Nothing, + hiDir = Nothing, + hieDir = Nothing, + stubDir = Nothing, + dumpDir = Nothing, + + objectSuf_ = phaseInputExt StopLn, + hcSuf = phaseInputExt HCc, + hiSuf_ = "hi", + hieSuf = "hie", + + dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, + dynHiSuf_ = "dyn_hi", + dynamicNow = False, + + pluginModNames = [], + pluginModNameOpts = [], + frontendPluginOpts = [], + + externalPluginSpecs = [], + + outputFile_ = Nothing, + dynOutputFile_ = Nothing, + outputHi = Nothing, + dynOutputHi = Nothing, + dynLibLoader = SystemDependent, + dumpPrefix = "non-module.", + dumpPrefixForce = Nothing, + ldInputs = [], + includePaths = IncludeSpecs [] [] [], + libraryPaths = [], + frameworkPaths = [], + cmdlineFrameworks = [], + rtsOpts = Nothing, + rtsOptsEnabled = RtsOptsSafeOnly, + rtsOptsSuggestions = True, + + hpcDir = ".hpc", + + packageDBFlags = [], + packageFlags = [], + pluginPackageFlags = [], + ignorePackageFlags = [], + trustFlags = [], + packageEnv = Nothing, + targetWays_ = Set.empty, + splitInfo = Nothing, + + ghcNameVersion = sGhcNameVersion mySettings, + fileSettings = sFileSettings mySettings, + toolSettings = sToolSettings mySettings, + targetPlatform = sTargetPlatform mySettings, + platformMisc = sPlatformMisc mySettings, + rawSettings = sRawSettings mySettings, + + tmpDir = panic "defaultDynFlags: uninitialized tmpDir", + + llvmOptLevel = 0, + + -- ghc -M values + depMakefile = "Makefile", + depIncludePkgDeps = False, + depIncludeCppDeps = False, + depExcludeMods = [], + depSuffixes = [], + -- end of ghc -M values + ghcVersionFile = Nothing, + haddockOptions = Nothing, + dumpFlags = EnumSet.empty, + generalFlags = EnumSet.fromList (defaultFlags mySettings), + warningFlags = EnumSet.fromList standardWarnings, + fatalWarningFlags = EnumSet.empty, + customWarningCategories = completeWarningCategorySet, + fatalCustomWarningCategories = emptyWarningCategorySet, + ghciScripts = [], + language = Nothing, + safeHaskell = Sf_None, + safeInfer = True, + safeInferred = True, + thOnLoc = noSrcSpan, + newDerivOnLoc = noSrcSpan, + deriveViaOnLoc = noSrcSpan, + overlapInstLoc = noSrcSpan, + incoherentOnLoc = noSrcSpan, + pkgTrustOnLoc = noSrcSpan, + warnSafeOnLoc = noSrcSpan, + warnUnsafeOnLoc = noSrcSpan, + trustworthyOnLoc = noSrcSpan, + extensions = [], + extensionFlags = flattenExtensionFlags Nothing [], + + unfoldingOpts = defaultUnfoldingOpts, + maxWorkerArgs = 10, + + ghciHistSize = 50, -- keep a log of length 50 by default + + flushOut = defaultFlushOut, + pprUserLength = 5, + pprCols = 100, + useUnicode = False, + useColor = Auto, + canUseColor = False, + colScheme = Col.defaultScheme, + profAuto = NoProfAuto, + callerCcFilters = [], + interactivePrint = Nothing, + sseVersion = Nothing, + bmiVersion = Nothing, + avx = False, + avx2 = False, + avx512cd = False, + avx512er = False, + avx512f = False, + avx512pf = False, + fma = False, + rtldInfo = panic "defaultDynFlags: no rtldInfo", + rtccInfo = panic "defaultDynFlags: no rtccInfo", + rtasmInfo = panic "defaultDynFlags: no rtasmInfo", + + maxInlineAllocSize = 128, + maxInlineMemcpyInsns = 32, + maxInlineMemsetInsns = 32, + + initialUnique = 0, + uniqueIncrement = 1, + + reverseErrors = False, + maxErrors = Nothing, + cfgWeights = defaultWeights + } + +type FatalMessager = String -> IO () + +defaultFatalMessager :: FatalMessager +defaultFatalMessager = hPutStrLn stderr + + +newtype FlushOut = FlushOut (IO ()) + +defaultFlushOut :: FlushOut +defaultFlushOut = FlushOut $ hFlush stdout + + + +data OnOff a = On a + | Off a + deriving (Eq, Show) + +instance Outputable a => Outputable (OnOff a) where + ppr (On x) = text "On" <+> ppr x + ppr (Off x) = text "Off" <+> ppr x + +-- OnOffs accumulate in reverse order, so we use foldr in order to +-- process them in the right order +flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension +flattenExtensionFlags ml = foldr g defaultExtensionFlags + where g (On f) flags = EnumSet.insert f flags + g (Off f) flags = EnumSet.delete f flags + defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) + +-- ----------------------------------------------------------------------------- +-- -jN + +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + -- | Use this many processors (@-j@ flag). + = ParMakeThisMany Int + -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). + | ParMakeNumProcessors + -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). + | ParMakeSemaphore FilePath + +-- ----------------------------------------------------------------------------- +-- Linker/compiler information + +-- LinkerInfo contains any extra options needed by the system linker. +data LinkerInfo + = GnuLD [Option] + | Mold [Option] + | GnuGold [Option] + | LlvmLLD [Option] + | DarwinLD [Option] + | SolarisLD [Option] + | AixLD [Option] + | UnknownLD + deriving Eq + +-- CompilerInfo tells us which C compiler we're using +data CompilerInfo + = GCC + | Clang + | AppleClang + | AppleClang51 + | Emscripten + | UnknownCC + deriving Eq + +-- | The 'GhcMode' tells us whether we're doing multi-module +-- compilation (controlled via the "GHC" API) or one-shot +-- (single-module) compilation. This makes a difference primarily to +-- the "GHC.Unit.Finder": in one-shot mode we look for interface files for +-- imported modules, but in multi-module mode we look for source files +-- in order to check whether they need to be recompiled. +data GhcMode + = CompManager -- ^ @\-\-make@, GHCi, etc. + | OneShot -- ^ @ghc -c Foo.hs@ + | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this + deriving Eq + +instance Outputable GhcMode where + ppr CompManager = text "CompManager" + ppr OneShot = text "OneShot" + ppr MkDepend = text "MkDepend" + +isOneShot :: GhcMode -> Bool +isOneShot OneShot = True +isOneShot _other = False + +-- | What to do in the link step, if there is one. +data GhcLink + = NoLink -- ^ Don't link at all + | LinkBinary -- ^ Link object code into a binary + | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both + -- bytecode and object code). + | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) + | LinkStaticLib -- ^ Link objects into a static lib + | LinkMergedObj -- ^ Link objects into a merged "GHCi object" + deriving (Eq, Show) + +isNoLink :: GhcLink -> Bool +isNoLink NoLink = True +isNoLink _ = False + +-- | We accept flags which make packages visible, but how they select +-- the package varies; this data type reflects what selection criterion +-- is used. +data PackageArg = + PackageArg String -- ^ @-package@, by 'PackageName' + | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' + deriving (Eq, Show) + +instance Outputable PackageArg where + ppr (PackageArg pn) = text "package" <+> text pn + ppr (UnitIdArg uid) = text "unit" <+> ppr uid + +-- | Represents the renaming that may be associated with an exposed +-- package, e.g. the @rns@ part of @-package "foo (rns)"@. +-- +-- Here are some example parsings of the package flags (where +-- a string literal is punned to be a 'ModuleName': +-- +-- * @-package foo@ is @ModRenaming True []@ +-- * @-package foo ()@ is @ModRenaming False []@ +-- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ +-- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ +-- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ +data ModRenaming = ModRenaming { + modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? + modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope + -- under name @n at . + } deriving (Eq) +instance Outputable ModRenaming where + ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) + +-- | Flags for manipulating the set of non-broken packages. +newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ + deriving (Eq) + +-- | Flags for manipulating package trust. +data TrustFlag + = TrustPackage String -- ^ @-trust@ + | DistrustPackage String -- ^ @-distrust@ + deriving (Eq) + +-- | Flags for manipulating packages visibility. +data PackageFlag + = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ + | HidePackage String -- ^ @-hide-package@ + deriving (Eq) -- NB: equality instance is used by packageFlagsChanged + +data PackageDBFlag + = PackageDB PkgDbRef + | NoUserPackageDB + | NoGlobalPackageDB + | ClearPackageDBs + deriving (Eq) + +packageFlagsChanged :: DynFlags -> DynFlags -> Bool +packageFlagsChanged idflags1 idflags0 = + packageFlags idflags1 /= packageFlags idflags0 || + ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || + pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || + trustFlags idflags1 /= trustFlags idflags0 || + packageDBFlags idflags1 /= packageDBFlags idflags0 || + packageGFlags idflags1 /= packageGFlags idflags0 + where + packageGFlags dflags = map (`gopt` dflags) + [ Opt_HideAllPackages + , Opt_HideAllPluginPackages + , Opt_AutoLinkPackages ] + +instance Outputable PackageFlag where + ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) + ppr (HidePackage str) = text "-hide-package" <+> text str + +data DynLibLoader + = Deployable + | SystemDependent + deriving Eq + +data RtsOptsEnabled + = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly + | RtsOptsAll + deriving (Show) + +-- | Are we building with @-fPIE@ or @-fPIC@ enabled? +positionIndependent :: DynFlags -> Bool +positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags + +-- Note [-dynamic-too business] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- With -dynamic-too flag, we try to build both the non-dynamic and dynamic +-- objects in a single run of the compiler: the pipeline is the same down to +-- Core optimisation, then the backend (from Core to object code) is executed +-- twice. +-- +-- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic +-- and dynamic loaded interfaces (#9176). +-- +-- To make matters worse, we automatically enable -dynamic-too when some modules +-- need Template-Haskell and GHC is dynamically linked (cf +-- GHC.Driver.Pipeline.compileOne'). +-- +-- We used to try and fall back from a dynamic-too failure but this feature +-- didn't work as expected (#20446) so it was removed to simplify the +-- implementation and not obscure latent bugs. + +data DynamicTooState + = DT_Dont -- ^ Don't try to build dynamic objects too + | DT_OK -- ^ Will still try to generate dynamic objects + | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) + deriving (Eq,Show,Ord) + +dynamicTooState :: DynFlags -> DynamicTooState +dynamicTooState dflags + | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont + | dynamicNow dflags = DT_Dyn + | otherwise = DT_OK + +setDynamicNow :: DynFlags -> DynFlags +setDynamicNow dflags0 = + dflags0 + { dynamicNow = True + } + +data PkgDbRef + = GlobalPkgDb + | UserPkgDb + | PkgDbPath FilePath + deriving Eq + +-- | Used to differentiate the scope an include needs to apply to. +-- We have to split the include paths to avoid accidentally forcing recursive +-- includes since -I overrides the system search paths. See #14312. +data IncludeSpecs + = IncludeSpecs { includePathsQuote :: [String] + , includePathsGlobal :: [String] + -- | See Note [Implicit include paths] + , includePathsQuoteImplicit :: [String] + } + deriving Show + +-- | Append to the list of includes a path that shall be included using `-I` +-- when the C compiler is called. These paths override system search paths. +addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addGlobalInclude spec paths = let f = includePathsGlobal spec + in spec { includePathsGlobal = f ++ paths } + +-- | Append to the list of includes a path that shall be included using +-- `-iquote` when the C compiler is called. These paths only apply when quoted +-- includes are used. e.g. #include "foo.h" +addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addQuoteInclude spec paths = let f = includePathsQuote spec + in spec { includePathsQuote = f ++ paths } + +-- | These includes are not considered while fingerprinting the flags for iface +-- | See Note [Implicit include paths] +addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec + in spec { includePathsQuoteImplicit = f ++ paths } + + +-- | Concatenate and flatten the list of global and quoted includes returning +-- just a flat list of paths. +flattenIncludes :: IncludeSpecs -> [String] +flattenIncludes specs = + includePathsQuote specs ++ + includePathsQuoteImplicit specs ++ + includePathsGlobal specs + +{- Note [Implicit include paths] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The compile driver adds the path to the folder containing the source file being + compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' + that are used later to compute the interface file. Because of this, + the flags fingerprint derived from these 'DynFlags' and recorded in the + interface file will end up containing the absolute path to the source folder. + + Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) + store the build artifacts produced by a build BA for reuse in subsequent builds. + + Embedding source paths in interface fingerprints will thwart these attempts and + lead to unnecessary recompilations when the source paths in BA differ from the + source paths in subsequent builds. + -} + +hasPprDebug :: DynFlags -> Bool +hasPprDebug = dopt Opt_D_ppr_debug + +hasNoDebugOutput :: DynFlags -> Bool +hasNoDebugOutput = dopt Opt_D_no_debug_output + +hasNoStateHack :: DynFlags -> Bool +hasNoStateHack = gopt Opt_G_NoStateHack + +hasNoOptCoercion :: DynFlags -> Bool +hasNoOptCoercion = gopt Opt_G_NoOptCoercion + +-- | Test whether a 'DumpFlag' is set +dopt :: DumpFlag -> DynFlags -> Bool +dopt = getDumpFlagFrom verbosity dumpFlags + +-- | Set a 'DumpFlag' +dopt_set :: DynFlags -> DumpFlag -> DynFlags +dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } + +-- | Unset a 'DumpFlag' +dopt_unset :: DynFlags -> DumpFlag -> DynFlags +dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } + +-- | Test whether a 'GeneralFlag' is set +-- +-- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) +-- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables +-- Opt_SplitSections. +-- +gopt :: GeneralFlag -> DynFlags -> Bool +gopt Opt_PIC dflags + | dynamicNow dflags = True +gopt Opt_ExternalDynamicRefs dflags + | dynamicNow dflags = True +gopt Opt_SplitSections dflags + | dynamicNow dflags = False +gopt f dflags = f `EnumSet.member` generalFlags dflags + +-- | Set a 'GeneralFlag' +gopt_set :: DynFlags -> GeneralFlag -> DynFlags +gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } + +-- | Unset a 'GeneralFlag' +gopt_unset :: DynFlags -> GeneralFlag -> DynFlags +gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } + +-- | Test whether a 'WarningFlag' is set +wopt :: WarningFlag -> DynFlags -> Bool +wopt f dflags = f `EnumSet.member` warningFlags dflags + +-- | Set a 'WarningFlag' +wopt_set :: DynFlags -> WarningFlag -> DynFlags +wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } + +-- | Unset a 'WarningFlag' +wopt_unset :: DynFlags -> WarningFlag -> DynFlags +wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } + +-- | Test whether a 'WarningFlag' is set as fatal +wopt_fatal :: WarningFlag -> DynFlags -> Bool +wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags + +-- | Mark a 'WarningFlag' as fatal (do not set the flag) +wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_set_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } + +-- | Mark a 'WarningFlag' as not fatal +wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_unset_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } + + +-- | Enable all custom warning categories. +wopt_set_all_custom :: DynFlags -> DynFlags +wopt_set_all_custom dfs + = dfs{ customWarningCategories = completeWarningCategorySet } + +-- | Disable all custom warning categories. +wopt_unset_all_custom :: DynFlags -> DynFlags +wopt_unset_all_custom dfs + = dfs{ customWarningCategories = emptyWarningCategorySet } + +-- | Mark all custom warning categories as fatal (do not set the flags). +wopt_set_all_fatal_custom :: DynFlags -> DynFlags +wopt_set_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = completeWarningCategorySet } + +-- | Mark all custom warning categories as non-fatal. +wopt_unset_all_fatal_custom :: DynFlags -> DynFlags +wopt_unset_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } + +-- | Set a custom 'WarningCategory' +wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } + +-- | Unset a custom 'WarningCategory' +wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as fatal (do not set the flag) +wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as not fatal +wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Are there any custom warning categories enabled? +wopt_any_custom :: DynFlags -> Bool +wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) + + +-- | Test whether a 'LangExt.Extension' is set +xopt :: LangExt.Extension -> DynFlags -> Bool +xopt f dflags = f `EnumSet.member` extensionFlags dflags + +-- | Set a 'LangExt.Extension' +xopt_set :: DynFlags -> LangExt.Extension -> DynFlags +xopt_set dfs f + = let onoffs = On f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Unset a 'LangExt.Extension' +xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags +xopt_unset dfs f + = let onoffs = Off f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Set or unset a 'LangExt.Extension', unless it has been explicitly +-- set or unset before. +xopt_set_unlessExplSpec + :: LangExt.Extension + -> (DynFlags -> LangExt.Extension -> DynFlags) + -> DynFlags -> DynFlags +xopt_set_unlessExplSpec ext setUnset dflags = + let referedExts = stripOnOff <$> extensions dflags + stripOnOff (On x) = x + stripOnOff (Off x) = x + in + if ext `elem` referedExts then dflags else setUnset dflags ext + +xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields +xopt_DuplicateRecordFields dfs + | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields + | otherwise = FieldLabel.NoDuplicateRecordFields + +xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors +xopt_FieldSelectors dfs + | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors + | otherwise = FieldLabel.NoFieldSelectors + +lang_set :: DynFlags -> Maybe Language -> DynFlags +lang_set dflags lang = + dflags { + language = lang, + extensionFlags = flattenExtensionFlags lang (extensions dflags) + } + +defaultFlags :: Settings -> [GeneralFlag] +defaultFlags settings +-- See Note [Updating flag description in the User's Guide] + = [ Opt_AutoLinkPackages, + Opt_DiagnosticsShowCaret, + Opt_EmbedManifest, + Opt_FamAppCache, + Opt_GenManifest, + Opt_GhciHistory, + Opt_GhciSandbox, + Opt_HelpfulErrors, + Opt_KeepHiFiles, + Opt_KeepOFiles, + Opt_OmitYields, + Opt_PrintBindContents, + Opt_ProfCountEntries, + Opt_SharedImplib, + Opt_SimplPreInlining, + Opt_VersionMacros, + Opt_RPath, + Opt_DumpWithWays, + Opt_CompactUnwind, + Opt_ShowErrorContext, + Opt_SuppressStgReps, + Opt_UnoptimizedCoreForInterpreter + ] + + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + + -- Default floating flags (see Note [RHS Floating]) + ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] + + + ++ default_PIC platform + + ++ validHoleFitDefaults + + + where platform = sTargetPlatform settings + +-- | These are the default settings for the display and sorting of valid hole +-- fits in typed-hole error messages. See Note [Valid hole fits include ...] + -- in the "GHC.Tc.Errors.Hole" module. +validHoleFitDefaults :: [GeneralFlag] +validHoleFitDefaults + = [ Opt_ShowTypeAppOfHoleFits + , Opt_ShowTypeOfHoleFits + , Opt_ShowProvOfHoleFits + , Opt_ShowMatchesOfHoleFits + , Opt_ShowValidHoleFits + , Opt_SortValidHoleFits + , Opt_SortBySizeHoleFits + , Opt_ShowHoleConstraints ] + + +-- +-- Note [Documenting optimisation flags] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- If you change the list of flags enabled for particular optimisation levels +-- please remember to update the User's Guide. The relevant file is: +-- +-- docs/users_guide/using-optimisation.rst +-- +-- Make sure to note whether a flag is implied by -O0, -O or -O2. + +optLevelFlags :: [([Int], GeneralFlag)] +-- Default settings of flags, before any command-line overrides +optLevelFlags -- see Note [Documenting optimisation flags] + = [ ([0,1,2], Opt_DoLambdaEtaExpansion) + , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] + , ([0,1,2], Opt_LlvmTBAA) + , ([0,1,2], Opt_ProfManualCcs ) + , ([2], Opt_DictsStrict) + + , ([0], Opt_IgnoreInterfacePragmas) + , ([0], Opt_OmitInterfacePragmas) + + , ([1,2], Opt_CoreConstantFolding) + + , ([1,2], Opt_CallArity) + , ([1,2], Opt_Exitification) + , ([1,2], Opt_CaseMerge) + , ([1,2], Opt_CaseFolding) + , ([1,2], Opt_CmmElimCommonBlocks) + , ([2], Opt_AsmShortcutting) + , ([1,2], Opt_CmmSink) + , ([1,2], Opt_CmmStaticPred) + , ([1,2], Opt_CSE) + , ([1,2], Opt_StgCSE) + , ([2], Opt_StgLiftLams) + , ([1,2], Opt_CmmControlFlow) + + , ([1,2], Opt_EnableRewriteRules) + -- Off for -O0. Otherwise we desugar list literals + -- to 'build' but don't run the simplifier passes that + -- would rewrite them back to cons cells! This seems + -- silly, and matters for the GHCi debugger. + + , ([1,2], Opt_FloatIn) + , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_IgnoreAsserts) + , ([1,2], Opt_Loopification) + , ([1,2], Opt_CfgBlocklayout) -- Experimental + + , ([1,2], Opt_Specialise) + , ([1,2], Opt_CrossModuleSpecialise) + , ([1,2], Opt_InlineGenerics) + , ([1,2], Opt_Strictness) + , ([1,2], Opt_UnboxSmallStrictFields) + , ([1,2], Opt_CprAnal) + , ([1,2], Opt_WorkerWrapper) + , ([1,2], Opt_SolveConstantDicts) + , ([1,2], Opt_NumConstantFolding) + + , ([2], Opt_LiberateCase) + , ([2], Opt_SpecConstr) + , ([2], Opt_FastPAPCalls) +-- , ([2], Opt_RegsGraph) +-- RegsGraph suffers performance regression. See #7679 +-- , ([2], Opt_StaticArgumentTransformation) +-- Static Argument Transformation needs investigation. See #9374 + ] + +type TurnOnFlag = Bool -- True <=> we are turning the flag on + -- False <=> we are turning the flag off +turnOn :: TurnOnFlag; turnOn = True +turnOff :: TurnOnFlag; turnOff = False + +default_PIC :: Platform -> [GeneralFlag] +default_PIC platform = + case (platformOS platform, platformArch platform) of + -- Darwin always requires PIC. Especially on more recent macOS releases + -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses + -- while we could work around this on x86_64 (like WINE does), we won't be + -- able on aarch64, where this is enforced. + (OSDarwin, ArchX86_64) -> [Opt_PIC] + -- For AArch64, we need to always have PIC enabled. The relocation model + -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't + -- control much how far apart symbols are in memory for our in-memory static + -- linker; and thus need to ensure we get sufficiently capable relocations. + -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top + -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to + -- be built with -fPIC. + (OSDarwin, ArchAArch64) -> [Opt_PIC] + (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in + -- OpenBSD since 5.3 release + -- (1 May 2013) we need to + -- always generate PIC. See + -- #10597 for more + -- information. + _ -> [] + +-- | The language extensions implied by the various language variants. +-- When updating this be sure to update the flag documentation in +-- @docs/users_guide/exts at . +languageExtensions :: Maybe Language -> [LangExt.Extension] + +-- Nothing: the default case +languageExtensions Nothing = languageExtensions (Just GHC2021) + +languageExtensions (Just Haskell98) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.NPlusKPatterns, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.FieldSelectors, + LangExt.NondecreasingIndentation, + -- strictly speaking non-standard, but we always had this + -- on implicitly before the option was added in 7.1, and + -- turning it off breaks code, so we're keeping it on for + -- backwards compatibility. Cabal uses -XHaskell98 by + -- default unless you specify another language. + LangExt.DeepSubsumption + -- Non-standard but enabled for backwards compatability (see GHC proposal #511) + ] + +languageExtensions (Just Haskell2010) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + LangExt.DeepSubsumption ] + +languageExtensions (Just GHC2021) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.MonomorphismRestriction, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + -- Now the new extensions (not in Haskell2010) + LangExt.BangPatterns, + LangExt.BinaryLiterals, + LangExt.ConstrainedClassMethods, + LangExt.ConstraintKinds, + LangExt.DeriveDataTypeable, + LangExt.DeriveFoldable, + LangExt.DeriveFunctor, + LangExt.DeriveGeneric, + LangExt.DeriveLift, + LangExt.DeriveTraversable, + LangExt.EmptyCase, + LangExt.EmptyDataDeriving, + LangExt.ExistentialQuantification, + LangExt.ExplicitForAll, + LangExt.FlexibleContexts, + LangExt.FlexibleInstances, + LangExt.GADTSyntax, + LangExt.GeneralizedNewtypeDeriving, + LangExt.HexFloatLiterals, + LangExt.ImportQualifiedPost, + LangExt.InstanceSigs, + LangExt.KindSignatures, + LangExt.MultiParamTypeClasses, + LangExt.NamedFieldPuns, + LangExt.NamedWildCards, + LangExt.NumericUnderscores, + LangExt.PolyKinds, + LangExt.PostfixOperators, + LangExt.RankNTypes, + LangExt.ScopedTypeVariables, + LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.StandaloneDeriving, + LangExt.StandaloneKindSignatures, + LangExt.TupleSections, + LangExt.TypeApplications, + LangExt.TypeOperators, + LangExt.TypeSynonymInstances] + + +ways :: DynFlags -> Ways +ways dflags + | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) + | otherwise = targetWays_ dflags +-- +-- System tool settings and locations + +programName :: DynFlags -> String +programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags +projectVersion :: DynFlags -> String +projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) +ghcUsagePath :: DynFlags -> FilePath +ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags +ghciUsagePath :: DynFlags -> FilePath +ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags +topDir :: DynFlags -> FilePath +topDir dflags = fileSettings_topDir $ fileSettings dflags +toolDir :: DynFlags -> Maybe FilePath +toolDir dflags = fileSettings_toolDir $ fileSettings dflags +extraGccViaCFlags :: DynFlags -> [String] +extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags +globalPackageDatabasePath :: DynFlags -> FilePath +globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags + +-- | The directory for this version of ghc in the user's app directory +-- The appdir used to be in ~/.ghc but to respect the XDG specification +-- we want to move it under $XDG_DATA_HOME/ +-- However, old tooling (like cabal) might still write package environments +-- to the old directory, so we prefer that if a subdirectory of ~/.ghc +-- with the correct target and GHC version suffix exists. +-- +-- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that +-- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR +-- +-- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version +versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath +versionedAppDir appname platform = do + -- Make sure we handle the case the HOME isn't set (see #11678) + -- We need to fallback to the old scheme if the subdirectory exists. + msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) + [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ + , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ + ] + where + checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case + True -> pure dir + False -> MaybeT (pure Nothing) + +versionedFilePath :: ArchOS -> FilePath +versionedFilePath platform = uniqueSubdir platform + +-- SDoc +------------------------------------------- + +-- | Initialize the pretty-printing options +initSDocContext :: DynFlags -> PprStyle -> SDocContext +initSDocContext dflags style = SDC + { sdocStyle = style + , sdocColScheme = colScheme dflags + , sdocLastColour = Col.colReset + , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) + , sdocDefaultDepth = pprUserLength dflags + , sdocLineLength = pprCols dflags + , sdocCanUseUnicode = useUnicode dflags + , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags + , sdocPprDebug = dopt Opt_D_ppr_debug dflags + , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags + , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags + , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags + , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags + , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags + , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags + , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags + , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags + , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags + , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags + , sdocSuppressTicks = gopt Opt_SuppressTicks dflags + , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags + , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags + , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags + , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags + , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags + , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags + , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags + , sdocSuppressUniques = gopt Opt_SuppressUniques dflags + , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags + , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags + , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags + , sdocErrorSpans = gopt Opt_ErrorSpans dflags + , sdocStarIsType = xopt LangExt.StarIsType dflags + , sdocLinearTypes = xopt LangExt.LinearTypes dflags + , sdocListTuplePuns = True + , sdocPrintTypeAbbreviations = True + , sdocUnitIdForUser = ftext + } + +-- | Initialize the pretty-printing options using the default user style +initDefaultSDocContext :: DynFlags -> SDocContext +initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle + +initPromotionTickContext :: DynFlags -> PromotionTickContext +initPromotionTickContext dflags = + PromTickCtx { + ptcListTuplePuns = True, + ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags + } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -41,7 +41,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Errors ( printOrThrowDiagnostics ) import GHC.Driver.Errors.Types ( GhcMessage ) import GHC.Driver.Config.Logger (initLogFlags) ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -7,7 +7,7 @@ module GHC.Driver.Env.Types import GHC.Driver.Errors.Types ( GhcMessage ) import {-# SOURCE #-} GHC.Driver.Hooks -import GHC.Driver.Session ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) +import GHC.Driver.DynFlags ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Prelude ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Prelude import GHC.Driver.Errors.Types import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () import GHC.Types.Error ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Prelude import Data.Bifunctor import Data.Typeable -import GHC.Driver.Session (DynFlags, PackageArg, gopt) +import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt) import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage)) import GHC.Types.Error import GHC.Unit.Module @@ -384,4 +384,4 @@ checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage checkBuildingCabalPackage dflags = if gopt Opt_BuildingCabalPackage dflags then YesBuildingCabalPackage - else NoBuildingCabalPackage \ No newline at end of file + else NoBuildingCabalPackage ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -32,7 +32,7 @@ where import GHC.Prelude import GHC.Driver.Env -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Pipeline.Phases import GHC.Hs.Decls ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -11,7 +11,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.State import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -230,53 +230,40 @@ import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile -import GHC.UniqueSubdir (uniqueSubdir) import GHC.Unit.Types import GHC.Unit.Parser import GHC.Unit.Module import GHC.Unit.Module.Warnings -import GHC.Builtin.Names ( mAIN_NAME ) -import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.DynFlags import GHC.Driver.Flags import GHC.Driver.Backend import GHC.Driver.Plugins.External import GHC.Settings.Config -import GHC.Utils.CliOption import GHC.Core.Unfold import GHC.Driver.CmdLine -import GHC.Settings.Constants import GHC.Utils.Panic -import qualified GHC.Utils.Ppr.Colour as Col import GHC.Utils.Misc import GHC.Utils.Constants (debugIsOn) import GHC.Utils.GlobalVars import GHC.Data.Maybe import GHC.Data.Bool import GHC.Utils.Monad -import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.SrcLoc import GHC.Types.SafeHaskell -import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) -import GHC.Types.ProfAuto -import qualified GHC.Types.FieldLabel as FieldLabel +import GHC.Types.Basic ( treatZeroAsInf ) import GHC.Data.FastString import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable import GHC.Settings import GHC.CmmToAsm.CFG.Weight -import {-# SOURCE #-} GHC.Core.Opt.CallerCC +import GHC.Core.Opt.CallerCC -import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) import Data.IORef import Control.Arrow ((&&&)) import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.Writer -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Except import Control.Monad.Trans.State as State import Data.Functor.Identity @@ -287,17 +274,11 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set import System.FilePath -import System.Directory -import System.Environment (lookupEnv) -import System.IO -import System.IO.Error import Text.ParserCombinators.ReadP hiding (char) import Text.ParserCombinators.ReadP as R -import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet -import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -- Note [Updating flag description in the User's Guide] @@ -376,387 +357,6 @@ import qualified GHC.LanguageExtensions as LangExt -- ----------------------------------------------------------------------------- -- DynFlags --- | Used to differentiate the scope an include needs to apply to. --- We have to split the include paths to avoid accidentally forcing recursive --- includes since -I overrides the system search paths. See #14312. -data IncludeSpecs - = IncludeSpecs { includePathsQuote :: [String] - , includePathsGlobal :: [String] - -- | See Note [Implicit include paths] - , includePathsQuoteImplicit :: [String] - } - deriving Show - --- | Append to the list of includes a path that shall be included using `-I` --- when the C compiler is called. These paths override system search paths. -addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addGlobalInclude spec paths = let f = includePathsGlobal spec - in spec { includePathsGlobal = f ++ paths } - --- | Append to the list of includes a path that shall be included using --- `-iquote` when the C compiler is called. These paths only apply when quoted --- includes are used. e.g. #include "foo.h" -addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addQuoteInclude spec paths = let f = includePathsQuote spec - in spec { includePathsQuote = f ++ paths } - --- | These includes are not considered while fingerprinting the flags for iface --- | See Note [Implicit include paths] -addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec - in spec { includePathsQuoteImplicit = f ++ paths } - - --- | Concatenate and flatten the list of global and quoted includes returning --- just a flat list of paths. -flattenIncludes :: IncludeSpecs -> [String] -flattenIncludes specs = - includePathsQuote specs ++ - includePathsQuoteImplicit specs ++ - includePathsGlobal specs - -{- Note [Implicit include paths] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - The compile driver adds the path to the folder containing the source file being - compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' - that are used later to compute the interface file. Because of this, - the flags fingerprint derived from these 'DynFlags' and recorded in the - interface file will end up containing the absolute path to the source folder. - - Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) - store the build artifacts produced by a build BA for reuse in subsequent builds. - - Embedding source paths in interface fingerprints will thwart these attempts and - lead to unnecessary recompilations when the source paths in BA differ from the - source paths in subsequent builds. - -} - - --- | Contains not only a collection of 'GeneralFlag's but also a plethora of --- information relating to the compilation of a single file or GHC session -data DynFlags = DynFlags { - ghcMode :: GhcMode, - ghcLink :: GhcLink, - backend :: !Backend, - -- ^ The backend to use (if any). - -- - -- Whenever you change the backend, also make sure to set 'ghcLink' to - -- something sensible. - -- - -- 'NoBackend' can be used to avoid generating any output, however, note that: - -- - -- * If a program uses Template Haskell the typechecker may need to run code - -- from an imported module. To facilitate this, code generation is enabled - -- for modules imported by modules that use template haskell, using the - -- default backend for the platform. - -- See Note [-fno-code mode]. - - - -- formerly Settings - ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, - fileSettings :: {-# UNPACK #-} !FileSettings, - targetPlatform :: Platform, -- Filled in by SysTools - toolSettings :: {-# UNPACK #-} !ToolSettings, - platformMisc :: {-# UNPACK #-} !PlatformMisc, - rawSettings :: [(String, String)], - tmpDir :: TempDir, - - llvmOptLevel :: Int, -- ^ LLVM optimisation level - verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] - debugLevel :: Int, -- ^ How much debug information to produce - simplPhases :: Int, -- ^ Number of simplifier phases - maxSimplIterations :: Int, -- ^ Max simplifier iterations - ruleCheck :: Maybe String, - strictnessBefore :: [Int], -- ^ Additional demand analysis - - parMakeCount :: Maybe ParMakeCount, - -- ^ The number of modules to compile in parallel - -- If unspecified, compile with a single job. - - enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? - ghcHeapSize :: Maybe Int, -- ^ The heap size to set. - - maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt - -- to show in type error messages - maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show - -- in typed hole error messages - maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole - -- fits to show in typed hole error - -- messages - refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for - -- refinement hole fits in typed hole - -- error messages - maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show - -- in non-exhaustiveness warnings - maxPmCheckModels :: Int, -- ^ Soft limit on the number of models - -- the pattern match checker checks - -- a pattern against. A safe guard - -- against exponential blow-up. - simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks - dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an - -- Unboxed demand on returned products with at most - -- this number of fields - specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr - specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function - specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types - -- Not optional; otherwise ForceSpecConstr can diverge. - binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above - -- this threshold will be dumped in a binary file - -- by the assembler code generator. 0 and Nothing disables - -- this feature. See 'GHC.StgToCmm.Config'. - liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase - floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating - -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' - - liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- recursive function. - liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- non-recursive function. - liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call - -- into an unknown call. - - cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. - - historySize :: Int, -- ^ Simplification history size - - importPaths :: [FilePath], - mainModuleNameIs :: ModuleName, - mainFunIs :: Maybe String, - reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth - solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver - -- Typically only 1 is needed - givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens - -- Should be < solverIterations - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - homeUnitId_ :: UnitId, -- ^ Target home unit-id - homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate - homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations - - -- Note [Filepaths and Multiple Home Units] - workingDirectory :: Maybe FilePath, - thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units - hiddenModules :: Set.Set ModuleName, - reexportedModules :: Set.Set ModuleName, - - -- ways - targetWays_ :: Ways, -- ^ Target way flags from the command line - - -- For object splitting - splitInfo :: Maybe (String,Int), - - -- paths etc. - objectDir :: Maybe String, - dylibInstallName :: Maybe String, - hiDir :: Maybe String, - hieDir :: Maybe String, - stubDir :: Maybe String, - dumpDir :: Maybe String, - - objectSuf_ :: String, - hcSuf :: String, - hiSuf_ :: String, - hieSuf :: String, - - dynObjectSuf_ :: String, - dynHiSuf_ :: String, - - outputFile_ :: Maybe String, - dynOutputFile_ :: Maybe String, - outputHi :: Maybe String, - dynOutputHi :: Maybe String, - dynLibLoader :: DynLibLoader, - - dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output - -- because of -dynamic-too. This predicate is - -- used to query the appropriate fields - -- (outputFile/dynOutputFile, ways, etc.) - - -- | This defaults to 'non-module'. It can be set by - -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on - -- where its output is going. - dumpPrefix :: FilePath, - - -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' - -- or 'ghc.GHCi.UI.runStmt'. - -- Set by @-ddump-file-prefix@ - dumpPrefixForce :: Maybe FilePath, - - ldInputs :: [Option], - - includePaths :: IncludeSpecs, - libraryPaths :: [String], - frameworkPaths :: [String], -- used on darwin only - cmdlineFrameworks :: [String], -- ditto - - rtsOpts :: Maybe String, - rtsOptsEnabled :: RtsOptsEnabled, - rtsOptsSuggestions :: Bool, - - hpcDir :: String, -- ^ Path to store the .mix files - - -- Plugins - pluginModNames :: [ModuleName], - -- ^ the @-fplugin@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - pluginModNameOpts :: [(ModuleName,String)], - frontendPluginOpts :: [String], - -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - - externalPluginSpecs :: [ExternalPluginSpec], - -- ^ External plugins loaded from shared libraries - - -- For ghc -M - depMakefile :: FilePath, - depIncludePkgDeps :: Bool, - depIncludeCppDeps :: Bool, - depExcludeMods :: [ModuleName], - depSuffixes :: [String], - - -- Package flags - packageDBFlags :: [PackageDBFlag], - -- ^ The @-package-db@ flags given on the command line, In - -- *reverse* order that they're specified on the command line. - -- This is intended to be applied with the list of "initial" - -- package databases derived from @GHC_PACKAGE_PATH@; see - -- 'getUnitDbRefs'. - - ignorePackageFlags :: [IgnorePackageFlag], - -- ^ The @-ignore-package@ flags from the command line. - -- In *reverse* order that they're specified on the command line. - packageFlags :: [PackageFlag], - -- ^ The @-package@ and @-hide-package@ flags from the command-line. - -- In *reverse* order that they're specified on the command line. - pluginPackageFlags :: [PackageFlag], - -- ^ The @-plugin-package-id@ flags from command line. - -- In *reverse* order that they're specified on the command line. - trustFlags :: [TrustFlag], - -- ^ The @-trust@ and @-distrust@ flags. - -- In *reverse* order that they're specified on the command line. - packageEnv :: Maybe FilePath, - -- ^ Filepath to the package environment file (if overriding default) - - - -- hsc dynamic flags - dumpFlags :: EnumSet DumpFlag, - generalFlags :: EnumSet GeneralFlag, - warningFlags :: EnumSet WarningFlag, - fatalWarningFlags :: EnumSet WarningFlag, - customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] - fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings - -- Don't change this without updating extensionFlags: - language :: Maybe Language, - -- | Safe Haskell mode - safeHaskell :: SafeHaskellMode, - safeInfer :: Bool, - safeInferred :: Bool, - -- We store the location of where some extension and flags were turned on so - -- we can produce accurate error messages when Safe Haskell fails due to - -- them. - thOnLoc :: SrcSpan, - newDerivOnLoc :: SrcSpan, - deriveViaOnLoc :: SrcSpan, - overlapInstLoc :: SrcSpan, - incoherentOnLoc :: SrcSpan, - pkgTrustOnLoc :: SrcSpan, - warnSafeOnLoc :: SrcSpan, - warnUnsafeOnLoc :: SrcSpan, - trustworthyOnLoc :: SrcSpan, - -- Don't change this without updating extensionFlags: - -- Here we collect the settings of the language extensions - -- from the command line, the ghci config file and - -- from interactive :set / :seti commands. - extensions :: [OnOff LangExt.Extension], - -- extensionFlags should always be equal to - -- flattenExtensionFlags language extensions - -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used - -- by template-haskell - extensionFlags :: EnumSet LangExt.Extension, - - -- | Unfolding control - -- See Note [Discounts and thresholds] in GHC.Core.Unfold - unfoldingOpts :: !UnfoldingOpts, - - maxWorkerArgs :: Int, - - ghciHistSize :: Int, - - flushOut :: FlushOut, - - ghcVersionFile :: Maybe FilePath, - haddockOptions :: Maybe String, - - -- | GHCi scripts specified by -ghci-script, in reverse order - ghciScripts :: [String], - - -- Output style options - pprUserLength :: Int, - pprCols :: Int, - - useUnicode :: Bool, - useColor :: OverridingBool, - canUseColor :: Bool, - colScheme :: Col.Scheme, - - -- | what kind of {-# SCC #-} to add automatically - profAuto :: ProfAuto, - callerCcFilters :: [CallerCcFilter], - - interactivePrint :: Maybe String, - - -- | Machine dependent flags (-m\ stuff) - sseVersion :: Maybe SseVersion, - bmiVersion :: Maybe BmiVersion, - avx :: Bool, - avx2 :: Bool, - avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. - avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. - avx512f :: Bool, -- Enable AVX-512 instructions. - avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. - fma :: Bool, -- ^ Enable FMA instructions. - - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - - -- Constants used to control the amount of optimization done. - - -- | Max size, in bytes, of inline array allocations. - maxInlineAllocSize :: Int, - - -- | Only inline memcpy if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemcpyInsns :: Int, - - -- | Only inline memset if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemsetInsns :: Int, - - -- | Reverse the order of error messages in GHC/GHCi - reverseErrors :: Bool, - - -- | Limit the maximum number of errors to show - maxErrors :: Maybe Int, - - -- | Unique supply configuration for testing build determinism - initialUnique :: Word, - uniqueIncrement :: Int, - -- 'Int' because it can be used to test uniques in decreasing order. - - -- | Temporary: CFG Edge weights for fast iterations - cfgWeights :: Weights -} {- Note [RHS Floating] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -767,43 +367,6 @@ data DynFlags = DynFlags { allows for experimentation. -} -class HasDynFlags m where - getDynFlags :: m DynFlags - -{- It would be desirable to have the more generalised - - instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where - getDynFlags = lift getDynFlags - -instance definition. However, that definition would overlap with the -`HasDynFlags (GhcT m)` instance. Instead we define instances for a -couple of common Monad transformers explicitly. -} - -instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where - getDynFlags = lift getDynFlags - -class ContainsDynFlags t where - extractDynFlags :: t -> DynFlags - --- | The type for the -jN argument, specifying that -j on its own represents --- using the number of machine processors. -data ParMakeCount - -- | Use this many processors (@-j@ flag). - = ParMakeThisMany Int - -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). - | ParMakeNumProcessors - -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). - | ParMakeSemaphore FilePath - ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -820,22 +383,6 @@ settings dflags = Settings , sRawSettings = rawSettings dflags } -programName :: DynFlags -> String -programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags -projectVersion :: DynFlags -> String -projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) -ghcUsagePath :: DynFlags -> FilePath -ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags -ghciUsagePath :: DynFlags -> FilePath -ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags -toolDir :: DynFlags -> Maybe FilePath -toolDir dflags = fileSettings_toolDir $ fileSettings dflags -topDir :: DynFlags -> FilePath -topDir dflags = fileSettings_topDir $ fileSettings dflags -extraGccViaCFlags :: DynFlags -> [String] -extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags -globalPackageDatabasePath :: DynFlags -> FilePath -globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags pgm_L :: DynFlags -> String pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags pgm_P :: DynFlags -> (String,[Option]) @@ -909,430 +456,8 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags opt_i :: DynFlags -> [String] opt_i dflags= toolSettings_opt_i $ toolSettings dflags --- | The directory for this version of ghc in the user's app directory --- The appdir used to be in ~/.ghc but to respect the XDG specification --- we want to move it under $XDG_DATA_HOME/ --- However, old tooling (like cabal) might still write package environments --- to the old directory, so we prefer that if a subdirectory of ~/.ghc --- with the correct target and GHC version suffix exists. --- --- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that --- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR --- --- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version -versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath -versionedAppDir appname platform = do - -- Make sure we handle the case the HOME isn't set (see #11678) - -- We need to fallback to the old scheme if the subdirectory exists. - msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) - [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ - , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ - ] - where - checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case - True -> pure dir - False -> MaybeT (pure Nothing) - -versionedFilePath :: ArchOS -> FilePath -versionedFilePath platform = uniqueSubdir platform - --- | The 'GhcMode' tells us whether we're doing multi-module --- compilation (controlled via the "GHC" API) or one-shot --- (single-module) compilation. This makes a difference primarily to --- the "GHC.Unit.Finder": in one-shot mode we look for interface files for --- imported modules, but in multi-module mode we look for source files --- in order to check whether they need to be recompiled. -data GhcMode - = CompManager -- ^ @\-\-make@, GHCi, etc. - | OneShot -- ^ @ghc -c Foo.hs@ - | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this - deriving Eq - -instance Outputable GhcMode where - ppr CompManager = text "CompManager" - ppr OneShot = text "OneShot" - ppr MkDepend = text "MkDepend" - -isOneShot :: GhcMode -> Bool -isOneShot OneShot = True -isOneShot _other = False - --- | What to do in the link step, if there is one. -data GhcLink - = NoLink -- ^ Don't link at all - | LinkBinary -- ^ Link object code into a binary - | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both - -- bytecode and object code). - | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) - | LinkStaticLib -- ^ Link objects into a static lib - | LinkMergedObj -- ^ Link objects into a merged "GHCi object" - deriving (Eq, Show) - -isNoLink :: GhcLink -> Bool -isNoLink NoLink = True -isNoLink _ = False - --- | We accept flags which make packages visible, but how they select --- the package varies; this data type reflects what selection criterion --- is used. -data PackageArg = - PackageArg String -- ^ @-package@, by 'PackageName' - | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' - deriving (Eq, Show) - -instance Outputable PackageArg where - ppr (PackageArg pn) = text "package" <+> text pn - ppr (UnitIdArg uid) = text "unit" <+> ppr uid - --- | Represents the renaming that may be associated with an exposed --- package, e.g. the @rns@ part of @-package "foo (rns)"@. --- --- Here are some example parsings of the package flags (where --- a string literal is punned to be a 'ModuleName': --- --- * @-package foo@ is @ModRenaming True []@ --- * @-package foo ()@ is @ModRenaming False []@ --- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ --- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ --- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ -data ModRenaming = ModRenaming { - modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? - modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope - -- under name @n at . - } deriving (Eq) -instance Outputable ModRenaming where - ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) - --- | Flags for manipulating the set of non-broken packages. -newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ - deriving (Eq) - --- | Flags for manipulating package trust. -data TrustFlag - = TrustPackage String -- ^ @-trust@ - | DistrustPackage String -- ^ @-distrust@ - deriving (Eq) - --- | Flags for manipulating packages visibility. -data PackageFlag - = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ - | HidePackage String -- ^ @-hide-package@ - deriving (Eq) -- NB: equality instance is used by packageFlagsChanged - -data PackageDBFlag - = PackageDB PkgDbRef - | NoUserPackageDB - | NoGlobalPackageDB - | ClearPackageDBs - deriving (Eq) - -packageFlagsChanged :: DynFlags -> DynFlags -> Bool -packageFlagsChanged idflags1 idflags0 = - packageFlags idflags1 /= packageFlags idflags0 || - ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || - pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || - trustFlags idflags1 /= trustFlags idflags0 || - packageDBFlags idflags1 /= packageDBFlags idflags0 || - packageGFlags idflags1 /= packageGFlags idflags0 - where - packageGFlags dflags = map (`gopt` dflags) - [ Opt_HideAllPackages - , Opt_HideAllPluginPackages - , Opt_AutoLinkPackages ] - -instance Outputable PackageFlag where - ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) - ppr (HidePackage str) = text "-hide-package" <+> text str - -data DynLibLoader - = Deployable - | SystemDependent - deriving Eq - -data RtsOptsEnabled - = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly - | RtsOptsAll - deriving (Show) - --- | Are we building with @-fPIE@ or @-fPIC@ enabled? -positionIndependent :: DynFlags -> Bool -positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags - --- Note [-dynamic-too business] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- With -dynamic-too flag, we try to build both the non-dynamic and dynamic --- objects in a single run of the compiler: the pipeline is the same down to --- Core optimisation, then the backend (from Core to object code) is executed --- twice. --- --- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic --- and dynamic loaded interfaces (#9176). --- --- To make matters worse, we automatically enable -dynamic-too when some modules --- need Template-Haskell and GHC is dynamically linked (cf --- GHC.Driver.Pipeline.compileOne'). --- --- We used to try and fall back from a dynamic-too failure but this feature --- didn't work as expected (#20446) so it was removed to simplify the --- implementation and not obscure latent bugs. - -data DynamicTooState - = DT_Dont -- ^ Don't try to build dynamic objects too - | DT_OK -- ^ Will still try to generate dynamic objects - | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) - deriving (Eq,Show,Ord) - -dynamicTooState :: DynFlags -> DynamicTooState -dynamicTooState dflags - | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont - | dynamicNow dflags = DT_Dyn - | otherwise = DT_OK - -setDynamicNow :: DynFlags -> DynFlags -setDynamicNow dflags0 = - dflags0 - { dynamicNow = True - } - ----------------------------------------------------------------------------- --- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value -initDynFlags :: DynFlags -> IO DynFlags -initDynFlags dflags = do - let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing - canUseUnicode <- do let enc = localeEncoding - str = "‘’" - (withCString enc str $ \cstr -> - do str' <- peekCString enc cstr - return (str == str')) - `catchIOError` \_ -> return False - ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" - let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode - maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" - maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" - let adjustCols (Just env) = Col.parseScheme env - adjustCols Nothing = id - let (useColor', colScheme') = - (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) - (useColor dflags, colScheme dflags) - tmp_dir <- normalise <$> getTemporaryDirectory - return dflags{ - useUnicode = useUnicode', - useColor = useColor', - canUseColor = stderrSupportsAnsiColors, - colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, - tmpDir = TempDir tmp_dir - } - --- | The normal 'DynFlags'. Note that they are not suitable for use in this form --- and must be fully initialized by 'GHC.runGhc' first. -defaultDynFlags :: Settings -> DynFlags -defaultDynFlags mySettings = --- See Note [Updating flag description in the User's Guide] - DynFlags { - ghcMode = CompManager, - ghcLink = LinkBinary, - backend = platformDefaultBackend (sTargetPlatform mySettings), - verbosity = 0, - debugLevel = 0, - simplPhases = 2, - maxSimplIterations = 4, - ruleCheck = Nothing, - binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) - maxRelevantBinds = Just 6, - maxValidHoleFits = Just 6, - maxRefHoleFits = Just 6, - refLevelHoleFits = Nothing, - maxUncoveredPatterns = 4, - maxPmCheckModels = 30, - simplTickFactor = 100, - dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple - specConstrThreshold = Just 2000, - specConstrCount = Just 3, - specConstrRecursive = 3, - liberateCaseThreshold = Just 2000, - floatLamArgs = Just 0, -- Default: float only if no fvs - liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsKnown = False, -- Default: don't turn known calls into unknown ones - cmmProcAlignment = Nothing, - - historySize = 20, - strictnessBefore = [], - - parMakeCount = Nothing, - - enableTimeStats = False, - ghcHeapSize = Nothing, - - importPaths = ["."], - mainModuleNameIs = mAIN_NAME, - mainFunIs = Nothing, - reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, - solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, - givensFuel = mAX_GIVENS_FUEL, - wantedsFuel = mAX_WANTEDS_FUEL, - qcsFuel = mAX_QC_FUEL, - - homeUnitId_ = mainUnitId, - homeUnitInstanceOf_ = Nothing, - homeUnitInstantiations_ = [], - - workingDirectory = Nothing, - thisPackageName = Nothing, - hiddenModules = Set.empty, - reexportedModules = Set.empty, - - objectDir = Nothing, - dylibInstallName = Nothing, - hiDir = Nothing, - hieDir = Nothing, - stubDir = Nothing, - dumpDir = Nothing, - - objectSuf_ = phaseInputExt StopLn, - hcSuf = phaseInputExt HCc, - hiSuf_ = "hi", - hieSuf = "hie", - - dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, - dynHiSuf_ = "dyn_hi", - dynamicNow = False, - - pluginModNames = [], - pluginModNameOpts = [], - frontendPluginOpts = [], - - externalPluginSpecs = [], - - outputFile_ = Nothing, - dynOutputFile_ = Nothing, - outputHi = Nothing, - dynOutputHi = Nothing, - dynLibLoader = SystemDependent, - dumpPrefix = "non-module.", - dumpPrefixForce = Nothing, - ldInputs = [], - includePaths = IncludeSpecs [] [] [], - libraryPaths = [], - frameworkPaths = [], - cmdlineFrameworks = [], - rtsOpts = Nothing, - rtsOptsEnabled = RtsOptsSafeOnly, - rtsOptsSuggestions = True, - - hpcDir = ".hpc", - - packageDBFlags = [], - packageFlags = [], - pluginPackageFlags = [], - ignorePackageFlags = [], - trustFlags = [], - packageEnv = Nothing, - targetWays_ = Set.empty, - splitInfo = Nothing, - - ghcNameVersion = sGhcNameVersion mySettings, - fileSettings = sFileSettings mySettings, - toolSettings = sToolSettings mySettings, - targetPlatform = sTargetPlatform mySettings, - platformMisc = sPlatformMisc mySettings, - rawSettings = sRawSettings mySettings, - - tmpDir = panic "defaultDynFlags: uninitialized tmpDir", - - llvmOptLevel = 0, - - -- ghc -M values - depMakefile = "Makefile", - depIncludePkgDeps = False, - depIncludeCppDeps = False, - depExcludeMods = [], - depSuffixes = [], - -- end of ghc -M values - ghcVersionFile = Nothing, - haddockOptions = Nothing, - dumpFlags = EnumSet.empty, - generalFlags = EnumSet.fromList (defaultFlags mySettings), - warningFlags = EnumSet.fromList standardWarnings, - fatalWarningFlags = EnumSet.empty, - customWarningCategories = completeWarningCategorySet, - fatalCustomWarningCategories = emptyWarningCategorySet, - ghciScripts = [], - language = Nothing, - safeHaskell = Sf_None, - safeInfer = True, - safeInferred = True, - thOnLoc = noSrcSpan, - newDerivOnLoc = noSrcSpan, - deriveViaOnLoc = noSrcSpan, - overlapInstLoc = noSrcSpan, - incoherentOnLoc = noSrcSpan, - pkgTrustOnLoc = noSrcSpan, - warnSafeOnLoc = noSrcSpan, - warnUnsafeOnLoc = noSrcSpan, - trustworthyOnLoc = noSrcSpan, - extensions = [], - extensionFlags = flattenExtensionFlags Nothing [], - - unfoldingOpts = defaultUnfoldingOpts, - maxWorkerArgs = 10, - - ghciHistSize = 50, -- keep a log of length 50 by default - - flushOut = defaultFlushOut, - pprUserLength = 5, - pprCols = 100, - useUnicode = False, - useColor = Auto, - canUseColor = False, - colScheme = Col.defaultScheme, - profAuto = NoProfAuto, - callerCcFilters = [], - interactivePrint = Nothing, - sseVersion = Nothing, - bmiVersion = Nothing, - avx = False, - avx2 = False, - avx512cd = False, - avx512er = False, - avx512f = False, - avx512pf = False, - fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", - - maxInlineAllocSize = 128, - maxInlineMemcpyInsns = 32, - maxInlineMemsetInsns = 32, - - initialUnique = 0, - uniqueIncrement = 1, - - reverseErrors = False, - maxErrors = Nothing, - cfgWeights = defaultWeights - } - -type FatalMessager = String -> IO () - -defaultFatalMessager :: FatalMessager -defaultFatalMessager = hPutStrLn stderr - - -newtype FlushOut = FlushOut (IO ()) - -defaultFlushOut :: FlushOut -defaultFlushOut = FlushOut $ hFlush stdout - {- Note [Verbosity levels] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -1344,283 +469,6 @@ Note [Verbosity levels] 5 | "ghc -v -ddump-all" -} -data OnOff a = On a - | Off a - deriving (Eq, Show) - -instance Outputable a => Outputable (OnOff a) where - ppr (On x) = text "On" <+> ppr x - ppr (Off x) = text "Off" <+> ppr x - --- OnOffs accumulate in reverse order, so we use foldr in order to --- process them in the right order -flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension -flattenExtensionFlags ml = foldr f defaultExtensionFlags - where f (On f) flags = EnumSet.insert f flags - f (Off f) flags = EnumSet.delete f flags - defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) - --- | The language extensions implied by the various language variants. --- When updating this be sure to update the flag documentation in --- @docs/users_guide/exts at . -languageExtensions :: Maybe Language -> [LangExt.Extension] - --- Nothing: the default case -languageExtensions Nothing = languageExtensions (Just GHC2021) - -languageExtensions (Just Haskell98) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.NPlusKPatterns, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.FieldSelectors, - LangExt.NondecreasingIndentation, - -- strictly speaking non-standard, but we always had this - -- on implicitly before the option was added in 7.1, and - -- turning it off breaks code, so we're keeping it on for - -- backwards compatibility. Cabal uses -XHaskell98 by - -- default unless you specify another language. - LangExt.DeepSubsumption - -- Non-standard but enabled for backwards compatability (see GHC proposal #511) - ] - -languageExtensions (Just Haskell2010) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - LangExt.DeepSubsumption ] - -languageExtensions (Just GHC2021) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.MonomorphismRestriction, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - -- Now the new extensions (not in Haskell2010) - LangExt.BangPatterns, - LangExt.BinaryLiterals, - LangExt.ConstrainedClassMethods, - LangExt.ConstraintKinds, - LangExt.DeriveDataTypeable, - LangExt.DeriveFoldable, - LangExt.DeriveFunctor, - LangExt.DeriveGeneric, - LangExt.DeriveLift, - LangExt.DeriveTraversable, - LangExt.EmptyCase, - LangExt.EmptyDataDeriving, - LangExt.ExistentialQuantification, - LangExt.ExplicitForAll, - LangExt.FlexibleContexts, - LangExt.FlexibleInstances, - LangExt.GADTSyntax, - LangExt.GeneralizedNewtypeDeriving, - LangExt.HexFloatLiterals, - LangExt.ImportQualifiedPost, - LangExt.InstanceSigs, - LangExt.KindSignatures, - LangExt.MultiParamTypeClasses, - LangExt.NamedFieldPuns, - LangExt.NamedWildCards, - LangExt.NumericUnderscores, - LangExt.PolyKinds, - LangExt.PostfixOperators, - LangExt.RankNTypes, - LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" - LangExt.StandaloneDeriving, - LangExt.StandaloneKindSignatures, - LangExt.TupleSections, - LangExt.TypeApplications, - LangExt.TypeOperators, - LangExt.TypeSynonymInstances] - -hasPprDebug :: DynFlags -> Bool -hasPprDebug = dopt Opt_D_ppr_debug - -hasNoDebugOutput :: DynFlags -> Bool -hasNoDebugOutput = dopt Opt_D_no_debug_output - -hasNoStateHack :: DynFlags -> Bool -hasNoStateHack = gopt Opt_G_NoStateHack - -hasNoOptCoercion :: DynFlags -> Bool -hasNoOptCoercion = gopt Opt_G_NoOptCoercion - - --- | Test whether a 'DumpFlag' is set -dopt :: DumpFlag -> DynFlags -> Bool -dopt = getDumpFlagFrom verbosity dumpFlags - --- | Set a 'DumpFlag' -dopt_set :: DynFlags -> DumpFlag -> DynFlags -dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } - --- | Unset a 'DumpFlag' -dopt_unset :: DynFlags -> DumpFlag -> DynFlags -dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } - --- | Test whether a 'GeneralFlag' is set --- --- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) --- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables --- Opt_SplitSections. --- -gopt :: GeneralFlag -> DynFlags -> Bool -gopt Opt_PIC dflags - | dynamicNow dflags = True -gopt Opt_ExternalDynamicRefs dflags - | dynamicNow dflags = True -gopt Opt_SplitSections dflags - | dynamicNow dflags = False -gopt f dflags = f `EnumSet.member` generalFlags dflags - --- | Set a 'GeneralFlag' -gopt_set :: DynFlags -> GeneralFlag -> DynFlags -gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } - --- | Unset a 'GeneralFlag' -gopt_unset :: DynFlags -> GeneralFlag -> DynFlags -gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } - --- | Test whether a 'WarningFlag' is set -wopt :: WarningFlag -> DynFlags -> Bool -wopt f dflags = f `EnumSet.member` warningFlags dflags - --- | Set a 'WarningFlag' -wopt_set :: DynFlags -> WarningFlag -> DynFlags -wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } - --- | Unset a 'WarningFlag' -wopt_unset :: DynFlags -> WarningFlag -> DynFlags -wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } - --- | Test whether a 'WarningFlag' is set as fatal -wopt_fatal :: WarningFlag -> DynFlags -> Bool -wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags - --- | Mark a 'WarningFlag' as fatal (do not set the flag) -wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_set_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } - --- | Mark a 'WarningFlag' as not fatal -wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_unset_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } - - --- | Enable all custom warning categories. -wopt_set_all_custom :: DynFlags -> DynFlags -wopt_set_all_custom dfs - = dfs{ customWarningCategories = completeWarningCategorySet } - --- | Disable all custom warning categories. -wopt_unset_all_custom :: DynFlags -> DynFlags -wopt_unset_all_custom dfs - = dfs{ customWarningCategories = emptyWarningCategorySet } - --- | Mark all custom warning categories as fatal (do not set the flags). -wopt_set_all_fatal_custom :: DynFlags -> DynFlags -wopt_set_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = completeWarningCategorySet } - --- | Mark all custom warning categories as non-fatal. -wopt_unset_all_fatal_custom :: DynFlags -> DynFlags -wopt_unset_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } - --- | Set a custom 'WarningCategory' -wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } - --- | Unset a custom 'WarningCategory' -wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as fatal (do not set the flag) -wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as not fatal -wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Are there any custom warning categories enabled? -wopt_any_custom :: DynFlags -> Bool -wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) - - --- | Test whether a 'LangExt.Extension' is set -xopt :: LangExt.Extension -> DynFlags -> Bool -xopt f dflags = f `EnumSet.member` extensionFlags dflags - --- | Set a 'LangExt.Extension' -xopt_set :: DynFlags -> LangExt.Extension -> DynFlags -xopt_set dfs f - = let onoffs = On f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Unset a 'LangExt.Extension' -xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags -xopt_unset dfs f - = let onoffs = Off f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Set or unset a 'LangExt.Extension', unless it has been explicitly --- set or unset before. -xopt_set_unlessExplSpec - :: LangExt.Extension - -> (DynFlags -> LangExt.Extension -> DynFlags) - -> DynFlags -> DynFlags -xopt_set_unlessExplSpec ext setUnset dflags = - let referedExts = stripOnOff <$> extensions dflags - stripOnOff (On x) = x - stripOnOff (Off x) = x - in - if ext `elem` referedExts then dflags else setUnset dflags ext - -xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields -xopt_DuplicateRecordFields dfs - | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields - | otherwise = FieldLabel.NoDuplicateRecordFields - -xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors -xopt_FieldSelectors dfs - | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors - | otherwise = FieldLabel.NoFieldSelectors - -lang_set :: DynFlags -> Maybe Language -> DynFlags -lang_set dflags lang = - dflags { - language = lang, - extensionFlags = flattenExtensionFlags lang (extensions dflags) - } - -- | Set the Haskell language standard to use setLanguage :: Language -> DynP () setLanguage l = upd (`lang_set` Just l) @@ -3119,11 +1967,6 @@ flagsForCompletion isInteractive modeFilter OnlyGhc = not isInteractive modeFilter HiddenFlag = False -type TurnOnFlag = Bool -- True <=> we are turning the flag on - -- False <=> we are turning the flag off -turnOn :: TurnOnFlag; turnOn = True -turnOff :: TurnOnFlag; turnOff = False - data FlagSpec flag = FlagSpec { flagSpecName :: String -- ^ Flag in string form @@ -3874,62 +2717,6 @@ xFlagsDeps = [ flagSpec "ViewPatterns" LangExt.ViewPatterns ] -defaultFlags :: Settings -> [GeneralFlag] -defaultFlags settings --- See Note [Updating flag description in the User's Guide] - = [ Opt_AutoLinkPackages, - Opt_DiagnosticsShowCaret, - Opt_EmbedManifest, - Opt_FamAppCache, - Opt_GenManifest, - Opt_GhciHistory, - Opt_GhciSandbox, - Opt_HelpfulErrors, - Opt_KeepHiFiles, - Opt_KeepOFiles, - Opt_OmitYields, - Opt_PrintBindContents, - Opt_ProfCountEntries, - Opt_SharedImplib, - Opt_SimplPreInlining, - Opt_VersionMacros, - Opt_RPath, - Opt_DumpWithWays, - Opt_CompactUnwind, - Opt_ShowErrorContext, - Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter - ] - - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - - -- Default floating flags (see Note [RHS Floating]) - ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] - - - ++ default_PIC platform - - ++ validHoleFitDefaults - - - where platform = sTargetPlatform settings - --- | These are the default settings for the display and sorting of valid hole --- fits in typed-hole error messages. See Note [Valid hole fits include ...] - -- in the "GHC.Tc.Errors.Hole" module. -validHoleFitDefaults :: [GeneralFlag] -validHoleFitDefaults - = [ Opt_ShowTypeAppOfHoleFits - , Opt_ShowTypeOfHoleFits - , Opt_ShowProvOfHoleFits - , Opt_ShowMatchesOfHoleFits - , Opt_ShowValidHoleFits - , Opt_SortValidHoleFits - , Opt_SortBySizeHoleFits - , Opt_ShowHoleConstraints ] - - validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] validHoleFitsImpliedGFlags = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) @@ -3938,32 +2725,6 @@ validHoleFitsImpliedGFlags , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ] -default_PIC :: Platform -> [GeneralFlag] -default_PIC platform = - case (platformOS platform, platformArch platform) of - -- Darwin always requires PIC. Especially on more recent macOS releases - -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses - -- while we could work around this on x86_64 (like WINE does), we won't be - -- able on aarch64, where this is enforced. - (OSDarwin, ArchX86_64) -> [Opt_PIC] - -- For AArch64, we need to always have PIC enabled. The relocation model - -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't - -- control much how far apart symbols are in memory for our in-memory static - -- linker; and thus need to ensure we get sufficiently capable relocations. - -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top - -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to - -- be built with -fPIC. - (OSDarwin, ArchAArch64) -> [Opt_PIC] - (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in - -- OpenBSD since 5.3 release - -- (1 May 2013) we need to - -- always generate PIC. See - -- #10597 for more - -- information. - _ -> [] - -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] @@ -4053,85 +2814,6 @@ impliedXFlags , (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures) ] --- Note [When is StarIsType enabled] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- The StarIsType extension determines whether to treat '*' as a regular type --- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType --- programs expect '*' to be synonymous with 'Type', so by default StarIsType is --- enabled. --- --- Programs that use TypeOperators might expect to repurpose '*' for --- multiplication or another binary operation, but making TypeOperators imply --- NoStarIsType caused too much breakage on Hackage. --- - --- Note [Documenting optimisation flags] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- If you change the list of flags enabled for particular optimisation levels --- please remember to update the User's Guide. The relevant file is: --- --- docs/users_guide/using-optimisation.rst --- --- Make sure to note whether a flag is implied by -O0, -O or -O2. - -optLevelFlags :: [([Int], GeneralFlag)] --- Default settings of flags, before any command-line overrides -optLevelFlags -- see Note [Documenting optimisation flags] - = [ ([0,1,2], Opt_DoLambdaEtaExpansion) - , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] - , ([0,1,2], Opt_LlvmTBAA) - , ([0,1,2], Opt_ProfManualCcs ) - , ([2], Opt_DictsStrict) - - , ([0], Opt_IgnoreInterfacePragmas) - , ([0], Opt_OmitInterfacePragmas) - - , ([1,2], Opt_CoreConstantFolding) - - , ([1,2], Opt_CallArity) - , ([1,2], Opt_Exitification) - , ([1,2], Opt_CaseMerge) - , ([1,2], Opt_CaseFolding) - , ([1,2], Opt_CmmElimCommonBlocks) - , ([2], Opt_AsmShortcutting) - , ([1,2], Opt_CmmSink) - , ([1,2], Opt_CmmStaticPred) - , ([1,2], Opt_CSE) - , ([1,2], Opt_StgCSE) - , ([2], Opt_StgLiftLams) - , ([1,2], Opt_CmmControlFlow) - - , ([1,2], Opt_EnableRewriteRules) - -- Off for -O0. Otherwise we desugar list literals - -- to 'build' but don't run the simplifier passes that - -- would rewrite them back to cons cells! This seems - -- silly, and matters for the GHCi debugger. - - , ([1,2], Opt_FloatIn) - , ([1,2], Opt_FullLaziness) - , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_Loopification) - , ([1,2], Opt_CfgBlocklayout) -- Experimental - - , ([1,2], Opt_Specialise) - , ([1,2], Opt_CrossModuleSpecialise) - , ([1,2], Opt_InlineGenerics) - , ([1,2], Opt_Strictness) - , ([1,2], Opt_UnboxSmallStrictFields) - , ([1,2], Opt_CprAnal) - , ([1,2], Opt_WorkerWrapper) - , ([1,2], Opt_SolveConstantDicts) - , ([1,2], Opt_NumConstantFolding) - - , ([2], Opt_LiberateCase) - , ([2], Opt_SpecConstr) - , ([2], Opt_FastPAPCalls) --- , ([2], Opt_RegsGraph) --- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) --- Static Argument Transformation needs investigation. See #9374 - ] -- | Things you get with `-dlint`. @@ -4439,12 +3121,6 @@ setDebugLevel mb_n = | n > 2 = setGeneralFlag' Opt_ExposeInternalSymbols | otherwise = id -data PkgDbRef - = GlobalPkgDb - | UserPkgDb - | PkgDbPath FilePath - deriving Eq - addPkgDbRef :: PkgDbRef -> DynP () addPkgDbRef p = upd $ \s -> s { packageDBFlags = PackageDB p : packageDBFlags s } @@ -5070,29 +3746,6 @@ needSourceNotes dflags = debugLevel dflags > 0 -- ----------------------------------------------------------------------------- -- Linker/compiler information --- LinkerInfo contains any extra options needed by the system linker. -data LinkerInfo - = GnuLD [Option] - | Mold [Option] - | GnuGold [Option] - | LlvmLLD [Option] - | DarwinLD [Option] - | SolarisLD [Option] - | AixLD [Option] - | UnknownLD - deriving Eq - --- CompilerInfo tells us which C compiler we're using -data CompilerInfo - = GCC - | Clang - | AppleClang - | AppleClang51 - | Emscripten - | UnknownCC - deriving Eq - - -- | Should we use `-XLinker -rpath` when linking or not? -- See Note [-fno-use-rpaths] useXLinkerRPath :: DynFlags -> OS -> Bool @@ -5144,60 +3797,6 @@ decodeSize str foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO () foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO () - --- | Initialize the pretty-printing options -initSDocContext :: DynFlags -> PprStyle -> SDocContext -initSDocContext dflags style = SDC - { sdocStyle = style - , sdocColScheme = colScheme dflags - , sdocLastColour = Col.colReset - , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) - , sdocDefaultDepth = pprUserLength dflags - , sdocLineLength = pprCols dflags - , sdocCanUseUnicode = useUnicode dflags - , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags - , sdocPprDebug = dopt Opt_D_ppr_debug dflags - , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags - , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags - , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags - , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags - , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags - , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags - , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags - , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags - , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags - , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags - , sdocSuppressTicks = gopt Opt_SuppressTicks dflags - , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags - , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags - , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags - , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags - , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags - , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags - , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags - , sdocSuppressUniques = gopt Opt_SuppressUniques dflags - , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags - , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags - , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags - , sdocErrorSpans = gopt Opt_ErrorSpans dflags - , sdocStarIsType = xopt LangExt.StarIsType dflags - , sdocLinearTypes = xopt LangExt.LinearTypes dflags - , sdocListTuplePuns = True - , sdocPrintTypeAbbreviations = True - , sdocUnitIdForUser = ftext - } - --- | Initialize the pretty-printing options using the default user style -initDefaultSDocContext :: DynFlags -> SDocContext -initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle - -initPromotionTickContext :: DynFlags -> PromotionTickContext -initPromotionTickContext dflags = - PromTickCtx { - ptcListTuplePuns = True, - ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags - } - outputFile :: DynFlags -> Maybe String outputFile dflags | dynamicNow dflags = dynOutputFile_ dflags @@ -5208,11 +3807,6 @@ objectSuf dflags | dynamicNow dflags = dynObjectSuf_ dflags | otherwise = objectSuf_ dflags -ways :: DynFlags -> Ways -ways dflags - | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) - | otherwise = targetWays_ dflags - -- | Pretty-print the difference between 2 DynFlags. -- -- For now only their general flags but it could be extended. ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -82,7 +82,7 @@ import GHC.Types.SrcLoc import GHC.Data.Bag -- collect ev vars from pats import GHC.Data.Maybe import GHC.Types.Name (Name, dataName) -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import qualified GHC.LanguageExtensions as LangExt import Data.Data ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude import GHC.Core (CoreRule, CoreExpr, RuleName) import GHC.Core.DataCon import GHC.Core.Type -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import GHC.Driver.Flags (WarningFlag) import GHC.Hs import GHC.HsToCore.Pmc.Solver.Types ===================================== compiler/GHC/Runtime/Context.hs ===================================== @@ -19,7 +19,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Plugins import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume ) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -119,7 +119,7 @@ import GHC.Core import GHC.Core.TyCo.Ppr import GHC.Utils.FV import GHC.Types.Var.Set -import GHC.Driver.Session (DynFlags(reductionDepth)) +import GHC.Driver.DynFlags (DynFlags(reductionDepth)) import GHC.Builtin.Names import GHC.Types.Basic import GHC.Types.Unique.Set ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -232,7 +232,7 @@ import {-# SOURCE #-} GHC.Tc.Types.Origin , FixedRuntimeRepOrigin, FixedRuntimeRepContext ) -- others: -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.Name as Name -- We use this to make dictionaries for type literals. -- Perhaps there's a better way to do this? ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -78,7 +78,7 @@ import GHC.Utils.Panic.Plain import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import GHC.Utils.Misc (HasDebugCallStack) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) import GHC.Unit.Module.ModIface ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -51,7 +51,7 @@ import GHC.Data.Maybe import GHC.Data.Graph.Directed import GHC.Driver.Backend -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.SourceFile ( hscSourceString ) ===================================== compiler/GHC/Unit/Module/ModSummary.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.Types import GHC.Unit.Module ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -75,7 +75,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Platform import GHC.Platform.Ways ===================================== compiler/ghc.cabal.in ===================================== @@ -434,6 +434,7 @@ Library GHC.Driver.Config.StgToCmm GHC.Driver.Config.Tidy GHC.Driver.Config.StgToJS + GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -106,6 +106,7 @@ GHC.Driver.CmdLine GHC.Driver.Config.Core.Lint GHC.Driver.Config.Diagnostic GHC.Driver.Config.Logger +GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -107,6 +107,7 @@ GHC.Driver.CmdLine GHC.Driver.Config.Core.Lint GHC.Driver.Config.Diagnostic GHC.Driver.Config.Logger +GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -1,21 +1,24 @@ ref compiler/GHC/Core/Coercion/Axiom.hs:463:2: Note [RoughMap and rm_empty] ref compiler/GHC/Core/Opt/OccurAnal.hs:983:7: Note [Loop breaking] ref compiler/GHC/Core/Opt/SetLevels.hs:1574:30: Note [Top level scope] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2825:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4009:8: Note [Lambda-bound unfoldings] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2826:13: Note [Case binder next] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4018:8: Note [Lambda-bound unfoldings] ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] -ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] -ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Core/Opt/Specialise.hs:1765:29: Note [Arity decrease] +ref compiler/GHC/Core/TyCo/Rep.hs:1565:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Driver/DynFlags.hs:1234:49: Note [Eta-reduction in -O0] +ref compiler/GHC/Driver/DynFlags.hs:1329:14: Note [When is StarIsType enabled] +ref compiler/GHC/Driver/DynFlags.hs:1349:14: Note [When is StarIsType enabled] +ref compiler/GHC/Driver/DynFlags.hs:1365:14: Note [When is StarIsType enabled] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] -ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice] -ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices] +ref compiler/GHC/Hs/Expr.hs:1738:87: Note [Lifecycle of a splice] +ref compiler/GHC/Hs/Expr.hs:1774:7: Note [Pending Splices] ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constraints] ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations] +ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -32,12 +35,12 @@ ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested sp ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] +ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] -ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics] -ref compiler/GHC/Types/Demand.hs:306:25: Note [Preserving Boxity of results is rarely a win] +ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] +ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:410:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:200:31: Note [fun_id in Match] @@ -46,7 +49,7 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:272:10: Note [WayFlags] +ref testsuite/config/ghc:276:10: Note [WayFlags] ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2636861bebe2b62b7af68a4bc1cbc5ffb155fa17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2636861bebe2b62b7af68a4bc1cbc5ffb155fa17 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 14 21:53:45 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 14 May 2023 17:53:45 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Two fast paths Message-ID: <6461586967146_171ad9562c619460756f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: c2619514 by Simon Peyton Jones at 2023-05-14T22:53:00+01:00 Two fast paths * Naturally coherent constraints * Hole-fits - - - - - 2 changed files: - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Solver/Dict.hs Changes: ===================================== compiler/GHC/Tc/Errors/Hole.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ExistentialQuantification #-} module GHC.Tc.Errors.Hole @@ -40,7 +41,10 @@ import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence import GHC.Tc.Utils.TcType import GHC.Core.Type +import GHC.Core.TyCon( TyCon, isGenerativeTyCon ) +import GHC.Core.TyCo.Rep( Type(..) ) import GHC.Core.DataCon +import GHC.Core.Predicate( Pred(..), classifyPredType, eqRelRole ) import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Builtin.Names ( gHC_ERR ) @@ -981,28 +985,33 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $ tcSubTypeSigma orig (ExprSigCtxt NoRRC) ty hole_ty ; traceTc "Checking hole fit {" empty ; traceTc "wanteds are: " $ ppr wanted - ; if isEmptyWC wanted && isEmptyBag th_relevant_cts - then do { traceTc "}" empty - ; return (True, wrap) } - else do { fresh_binds <- newTcEvBinds - -- The relevant constraints may contain HoleDests, so we must - -- take care to clone them as well (to avoid #15370). - ; cloned_relevants <- mapBagM cloneWantedCtEv th_relevant_cts - -- We wrap the WC in the nested implications, for details, see - -- Note [Checking hole fits] - ; let wrapInImpls cts = foldl (flip (setWCAndBinds fresh_binds)) cts th_implics - final_wc = wrapInImpls $ addSimples wanted $ - mapBag mkNonCanonical cloned_relevants - -- We add the cloned relevants to the wanteds generated - -- by the call to tcSubType_NC, for details, see - -- Note [Relevant constraints]. There's no need to clone - -- the wanteds, because they are freshly generated by the - -- call to`tcSubtype_NC`. - ; traceTc "final_wc is: " $ ppr final_wc - -- See Note [Speeding up valid hole-fits] - ; (rem, _) <- tryTc $ runTcSEarlyAbort $ simplifyTopWanteds final_wc - ; traceTc "}" empty - ; return (any isSolvedWC rem, wrap) } } + ; if | isEmptyWC wanted, isEmptyBag th_relevant_cts + -> do { traceTc "}" empty + ; return (True, wrap) } + + | checkInsoluble wanted + -> return (False, wrap) + + | otherwise + -> do { fresh_binds <- newTcEvBinds + -- The relevant constraints may contain HoleDests, so we must + -- take care to clone them as well (to avoid #15370). + ; cloned_relevants <- mapBagM cloneWantedCtEv th_relevant_cts + -- We wrap the WC in the nested implications, for details, see + -- Note [Checking hole fits] + ; let wrapInImpls cts = foldl (flip (setWCAndBinds fresh_binds)) cts th_implics + final_wc = wrapInImpls $ addSimples wanted $ + mapBag mkNonCanonical cloned_relevants + -- We add the cloned relevants to the wanteds generated + -- by the call to tcSubType_NC, for details, see + -- Note [Relevant constraints]. There's no need to clone + -- the wanteds, because they are freshly generated by the + -- call to`tcSubtype_NC`. + ; traceTc "final_wc is: " $ ppr final_wc + -- See Note [Speeding up valid hole-fits] + ; (rem, _) <- tryTc $ runTcSEarlyAbort $ simplifyTopWanteds final_wc + ; traceTc "}" empty + ; return (any isSolvedWC rem, wrap) } } where orig = ExprHoleOrigin (hole_occ <$> th_hole) @@ -1012,3 +1021,31 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $ -> WantedConstraints -- The new constraints. setWCAndBinds binds imp wc = mkImplicWC $ unitBag $ imp { ic_wanted = wc , ic_binds = binds } + +checkInsoluble :: WantedConstraints -> Bool +checkInsoluble (WC { wc_simple = simples }) + = any is_insol simples + where + is_insol ct = case classifyPredType (ctPred ct) of + EqPred r t1 t2 -> definitelyNotEqual (eqRelRole r) t1 t2 + _ -> False + +definitelyNotEqual :: Role -> TcType -> TcType -> Bool +definitelyNotEqual r t1 t2 + = go t1 t2 + where + go t1 t2 + | Just t1' <- coreView t1 = go t1' t2 + | Just t2' <- coreView t2 = go t1 t2' + + go (TyConApp tc _) t2 | isGenerativeTyCon tc r = go_tc tc t2 + go t1 (TyConApp tc _) | isGenerativeTyCon tc r = go_tc tc t1 + go (FunTy {ft_af = af1}) (FunTy {ft_af = af2}) = af1 /= af2 + go _ _ = False + + go_tc :: TyCon -> TcType -> Bool + -- The TyCon is generative, and is not a saturated FunTy + go_tc tc1 (TyConApp tc2 _) | isGenerativeTyCon tc2 r = tc1 /= tc2 + go_tc _ (FunTy {}) = True + go_tc _ (ForAllTy {}) = True + go_tc _ _ = False \ No newline at end of file ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -69,7 +69,7 @@ solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage () -- NC: this comes from CNonCanonical or CIrredCan -- Precondition: already rewritten by inert set solveDictNC ev cls tys - = do { dict_ct <- simpleStage (canDictCt ev cls tys) + = do { dict_ct <- canDictCt ev cls tys ; solveDict dict_ct } solveDict :: DictCt -> SolverStage () @@ -100,18 +100,29 @@ updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev }) -- Add the new constraint to the inert set ; updInertCans (updDicts (addDict dict_ct)) } -canDictCt :: CtEvidence -> Class -> [Type] -> TcS DictCt +canDictCt :: CtEvidence -> Class -> [Type] -> SolverStage DictCt -- Once-only processing of Dict constraints: -- * expand superclasses -- * deal with CallStack canDictCt ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { dflags <- getDynFlags + = Stage $ + do { dflags <- getDynFlags ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys - -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] - ; emitWork (listToBag sc_cts) - ; return (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = doNotExpand }) } + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + + -- For equality classes, /replace/ the current constraint with its + -- superclasses, rather than /adding/ them. + -- See (NC1) in Note [Naturally coherent classes] + ; if isEqualityClass cls + then case sc_cts of + [ct] -> startAgainWith ct + _ -> pprPanic "canDictCt" (ppr cls) + else + + do { emitWork (listToBag sc_cts) + ; continueWith (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = doNotExpand }) } } -- doNotExpand: We have already expanded superclasses for /this/ dict -- so set the fuel to doNotExpand to avoid repeating expansion @@ -123,7 +134,8 @@ canDictCt ev cls tys -- of solving it directly from a given. -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types - = do { -- First we emit a new constraint that will capture the + = Stage $ + do { -- First we emit a new constraint that will capture the -- given CallStack. let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so @@ -139,18 +151,19 @@ canDictCt ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; return (DictCt { di_ev = new_ev, di_cls = cls - , di_tys = tys, di_pend_sc = doNotExpand }) } + ; continueWith (DictCt { di_ev = new_ev, di_cls = cls + , di_tys = tys, di_pend_sc = doNotExpand }) } -- doNotExpand: No superclasses for class CallStack -- See invariants in CDictCan.cc_pend_sc | otherwise - = do { dflags <- getDynFlags + = Stage $ + do { dflags <- getDynFlags ; let fuel | classHasSCs cls = wantedsFuel dflags | otherwise = doNotExpand -- See Invariants in `CCDictCan.cc_pend_sc` - ; return (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = fuel }) } + ; continueWith (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = fuel }) } where loc = ctEvLoc ev orig = ctLocOrigin loc @@ -790,7 +803,7 @@ matchClassInst dflags inerts clas tys loc -- whether top level, or local quantified constraints. -- See Note [Instance and Given overlap] | not (xopt LangExt.IncoherentInstances dflags) - , not (naturallyCoherentClass clas) + , not (naturallyCoherentClass clas) -- See (NC3) in Note [Naturally coherent classes] , not (noMatchableGivenDicts inerts loc clas tys) = do { traceTcS "Delaying instance application" $ vcat [ text "Work item=" <+> pprClassPred clas tys ] @@ -822,8 +835,13 @@ matchClassInst dflags inerts clas tys loc -- See also Note [The equality types story] in GHC.Builtin.Types.Prim. naturallyCoherentClass :: Class -> Bool naturallyCoherentClass cls - = isCTupleClass cls - || cls `hasKey` heqTyConKey + = isCTupleClass cls || isEqualityClass cls + +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey || cls `hasKey` eqTyConKey || cls `hasKey` coercibleTyConKey @@ -917,14 +935,50 @@ this: instance a ~# b => a ~~ b (See Note [The equality types story] in GHC.Builtin.Types.Prim.) -Faced with [W] t1 ~~ t2, it's always OK to reduce it to [W] t1 ~# t2, -without worrying about Note [Instance and Given overlap]. Why? Because -if we had [G] s1 ~~ s2, then we'd get the superclass [G] s1 ~# s2, and -so the reduction of the [W] constraint does not risk losing any solutions. +PS: the term "naturally coherent" doesn't really seem helpful. +Perhaps "invertible" or something? I left it for now though. -On the other hand, it can be fatal to /fail/ to reduce such -equalities, on the grounds of Note [Instance and Given overlap], -because many good things flow from [W] t1 ~# t2. +For naturally coherent classes: + +(NC1) For Givens, when expanding superclasses, we /replace/ the constraint + with its superclasses (which, remember, are equally powerful) rather than + /adding/ them. This can make a huge difference. Consider T17836, which + has a constraint like + forall b,c. a ~ (b,c) => + forall d,e. c ~ (d,e) => + ...etc... + If we just /add/ the superclasses of [G] g1:a ~ (b,c), we'll put + [G] g1:(a~(b,c)) in the inert set and emit [G] g2:a ~# (b,c). That will + kick out g1, and it'll be re-inserted as [G] g1':(b,c)~(b,c) which does + no good to anyone. When the implication is deeply nested, this has + quadratic cost, and no benefit. Just replace! + + Originally I tried this for all naturally-coherent classes, including + tuples. But discarding the tuple Given (which "replacing" does) means that + we may have to reconstruct it for a recursive call, and the optimiser isn't + quite clever enought to figure that out: see #10359 and its test case. + This is less pressing for equality classes because they have to be unpacked + strictly, so CSE-ing away the reconstuction works fine. Hence the use + of isEqualityClass rather than naturallyCoherentClass in canDictCt. + A bit ad-hoc. + +(NC2) Because of this replacement, we don't need do the fancy footwork + of Note [Solving superclass constraints], so the computation of `sc_loc` + in `mk_strict_superclasses` can be simpler. + + For tuple predicates, this matters, because their size can be large, + and we don't want to add a big class to the size of the dictionaries + in the chain. When we get down to a base predicate, we'll include + its size. See #10335 + +(NC3) Faced with [W] t1 ~ t2, it's always OK to reduce it to [W] t1 ~# t2, + without worrying about Note [Instance and Given overlap]. Why? Because + if we had [G] s1 ~ s2, then we'd get the superclass [G] s1 ~# s2, and + so the reduction of the [W] constraint does not risk losing any solutions. + + On the other hand, it can be fatal to /fail/ to reduce such equalities + on the grounds of Note [Instance and Given overlap], fbecause many good + things flow from [W] t1 ~# t2. The same reasoning applies to @@ -947,9 +1001,6 @@ And less obviously to: Examples: T5853, T10432, T5315, T9222, T2627b, T3028b -PS: the term "naturally coherent" doesn't really seem helpful. -Perhaps "invertible" or something? I left it for now though. - Note [Local instances and incoherence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -1934,18 +1985,8 @@ mk_strict_superclasses fuel rec_clss ev@(CtGiven { ctev_evar = evar, ctev_loc = `App` (evId evar `mkVarApps` (tvs ++ dict_ids)) `mkVarApps` sc_tvs - sc_loc | isCTupleClass cls - = loc -- For tuple predicates, just take them apart, without - -- adding their (large) size into the chain. When we - -- get down to a base predicate, we'll include its size. - -- #10335 - - | isEqPredClass cls || cls `hasKey` coercibleTyConKey - = loc -- The only superclasses of ~, ~~, and Coercible are primitive - -- equalities, and they don't use the GivenSCOrigin mechanism - -- detailed in Note [Solving superclass constraints] in - -- GHC.Tc.TyCl.Instance. Skip for a tiny performance win. - + sc_loc | naturallyCoherentClass cls + = loc -- See (NC2) in Note [Naturally coherent classes] | otherwise = loc { ctl_origin = mk_sc_origin (ctLocOrigin loc) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2619514d5418fe21b19ac3ec7ab740175d2b63e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2619514d5418fe21b19ac3ec7ab740175d2b63e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 08:56:34 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Mon, 15 May 2023 04:56:34 -0400 Subject: [Git][ghc/ghc][wip/ghc-driver-dynflags] Split DynFlags structure into own module Message-ID: <6461f3c23dcfd_171ad9672075d06867ab@gitlab.mail> Oleg Grenrus pushed to branch wip/ghc-driver-dynflags at Glasgow Haskell Compiler / GHC Commits: 6ae8450e by Oleg Grenrus at 2023-05-15T11:55:31+03:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 27 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/State.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -26,7 +26,7 @@ import qualified Text.ParserCombinators.ReadP as P import GHC.Prelude import GHC.Utils.Outputable as Outputable -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.CostCentre import GHC.Types.CostCentre.State import GHC.Types.Name hiding (varName) ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Core.Opt.Monad ( import GHC.Prelude hiding ( read ) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv ) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Unit.Module.Env import GHC.Unit.Module.ModGuts( ModGuts(..) ) import GHC.Unit.Module.Deps( Dependencies(..) ) -import GHC.Driver.Session( DynFlags ) +import GHC.Driver.DynFlags( DynFlags ) import GHC.Driver.Ppr( showSDoc ) import GHC.Core -- All of it ===================================== compiler/GHC/Data/IOEnv.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Data.IOEnv ( import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Hooks import GHC.IO (catchException) import GHC.Utils.Exception ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Driver.Config.Diagnostic where import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Prelude import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Config/Logger.hs ===================================== @@ -5,7 +5,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Logger (LogFlags (..)) import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -0,0 +1,1531 @@ +{-# LANGUAGE LambdaCase #-} +module GHC.Driver.DynFlags ( + -- * Dynamic flags and associated configuration types + DumpFlag(..), + GeneralFlag(..), + WarningFlag(..), DiagnosticReason(..), + Language(..), + FatalMessager, FlushOut(..), + ProfAuto(..), + hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion, + dopt, dopt_set, dopt_unset, + gopt, gopt_set, gopt_unset, + wopt, wopt_set, wopt_unset, + wopt_fatal, wopt_set_fatal, wopt_unset_fatal, + wopt_set_all_custom, wopt_unset_all_custom, + wopt_set_all_fatal_custom, wopt_unset_all_fatal_custom, + wopt_set_custom, wopt_unset_custom, + wopt_set_fatal_custom, wopt_unset_fatal_custom, + wopt_any_custom, + xopt, xopt_set, xopt_unset, + xopt_set_unlessExplSpec, + xopt_DuplicateRecordFields, + xopt_FieldSelectors, + lang_set, + DynamicTooState(..), dynamicTooState, setDynamicNow, + OnOff(..), + DynFlags(..), + ParMakeCount(..), + ways, + HasDynFlags(..), ContainsDynFlags(..), + RtsOptsEnabled(..), + GhcMode(..), isOneShot, + GhcLink(..), isNoLink, + PackageFlag(..), PackageArg(..), ModRenaming(..), + packageFlagsChanged, + IgnorePackageFlag(..), TrustFlag(..), + PackageDBFlag(..), PkgDbRef(..), + Option(..), showOpt, + DynLibLoader(..), + positionIndependent, + optimisationFlags, + + -- ** Manipulating DynFlags + defaultDynFlags, -- Settings -> DynFlags + initDynFlags, -- DynFlags -> IO DynFlags + defaultFatalMessager, + defaultFlushOut, + optLevelFlags, + languageExtensions, + + TurnOnFlag, + turnOn, + turnOff, + + -- ** System tool settings and locations + programName, projectVersion, + ghcUsagePath, ghciUsagePath, topDir, toolDir, + versionedAppDir, versionedFilePath, + extraGccViaCFlags, globalPackageDatabasePath, + + -- * Linker/compiler information + LinkerInfo(..), + CompilerInfo(..), + + -- * Include specifications + IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes, + addImplicitQuoteInclude, + + -- * SDoc + initSDocContext, initDefaultSDocContext, + initPromotionTickContext, +) where + +import GHC.Prelude + +import GHC.Platform +import GHC.Platform.Ways + +import GHC.CmmToAsm.CFG.Weight +import GHC.Core.Unfold +import GHC.Data.Bool +import GHC.Data.EnumSet (EnumSet) +import GHC.Data.Maybe +import GHC.Builtin.Names ( mAIN_NAME ) +import GHC.Driver.Backend +import GHC.Driver.Flags +import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.Plugins.External +import GHC.Settings +import GHC.Settings.Constants +import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) +import GHC.Types.Error (DiagnosticReason(..)) +import GHC.Types.ProfAuto +import GHC.Types.SafeHaskell +import GHC.Types.SrcLoc +import GHC.Unit.Module +import GHC.Unit.Module.Warnings +import GHC.Utils.CliOption +import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) +import GHC.UniqueSubdir (uniqueSubdir) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.TmpFs + +import qualified GHC.Types.FieldLabel as FieldLabel +import qualified GHC.Utils.Ppr.Colour as Col +import qualified GHC.Data.EnumSet as EnumSet + +import {-# SOURCE #-} GHC.Core.Opt.CallerCC + +import Control.Monad (msum, (<=<)) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.Writer (WriterT) +import Data.IORef +import System.IO +import System.IO.Error (catchIOError) +import System.Environment (lookupEnv) +import System.FilePath (normalise, ()) +import System.Directory +import GHC.Foreign (withCString, peekCString) + +import qualified Data.Set as Set + +import qualified GHC.LanguageExtensions as LangExt + +-- ----------------------------------------------------------------------------- +-- DynFlags + +-- | Contains not only a collection of 'GeneralFlag's but also a plethora of +-- information relating to the compilation of a single file or GHC session +data DynFlags = DynFlags { + ghcMode :: GhcMode, + ghcLink :: GhcLink, + backend :: !Backend, + -- ^ The backend to use (if any). + -- + -- Whenever you change the backend, also make sure to set 'ghcLink' to + -- something sensible. + -- + -- 'NoBackend' can be used to avoid generating any output, however, note that: + -- + -- * If a program uses Template Haskell the typechecker may need to run code + -- from an imported module. To facilitate this, code generation is enabled + -- for modules imported by modules that use template haskell, using the + -- default backend for the platform. + -- See Note [-fno-code mode]. + + + -- formerly Settings + ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, + fileSettings :: {-# UNPACK #-} !FileSettings, + targetPlatform :: Platform, -- Filled in by SysTools + toolSettings :: {-# UNPACK #-} !ToolSettings, + platformMisc :: {-# UNPACK #-} !PlatformMisc, + rawSettings :: [(String, String)], + tmpDir :: TempDir, + + llvmOptLevel :: Int, -- ^ LLVM optimisation level + verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] + debugLevel :: Int, -- ^ How much debug information to produce + simplPhases :: Int, -- ^ Number of simplifier phases + maxSimplIterations :: Int, -- ^ Max simplifier iterations + ruleCheck :: Maybe String, + strictnessBefore :: [Int], -- ^ Additional demand analysis + + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. + + enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? + ghcHeapSize :: Maybe Int, -- ^ The heap size to set. + + maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt + -- to show in type error messages + maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show + -- in typed hole error messages + maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole + -- fits to show in typed hole error + -- messages + refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for + -- refinement hole fits in typed hole + -- error messages + maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show + -- in non-exhaustiveness warnings + maxPmCheckModels :: Int, -- ^ Soft limit on the number of models + -- the pattern match checker checks + -- a pattern against. A safe guard + -- against exponential blow-up. + simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks + dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an + -- Unboxed demand on returned products with at most + -- this number of fields + specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr + specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function + specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types + -- Not optional; otherwise ForceSpecConstr can diverge. + binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above + -- this threshold will be dumped in a binary file + -- by the assembler code generator. 0 and Nothing disables + -- this feature. See 'GHC.StgToCmm.Config'. + liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase + floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating + -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' + + liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- recursive function. + liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- non-recursive function. + liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call + -- into an unknown call. + + cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. + + historySize :: Int, -- ^ Simplification history size + + importPaths :: [FilePath], + mainModuleNameIs :: ModuleName, + mainFunIs :: Maybe String, + reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth + solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver + -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + homeUnitId_ :: UnitId, -- ^ Target home unit-id + homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate + homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations + + -- Note [Filepaths and Multiple Home Units] + workingDirectory :: Maybe FilePath, + thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units + hiddenModules :: Set.Set ModuleName, + reexportedModules :: Set.Set ModuleName, + + -- ways + targetWays_ :: Ways, -- ^ Target way flags from the command line + + -- For object splitting + splitInfo :: Maybe (String,Int), + + -- paths etc. + objectDir :: Maybe String, + dylibInstallName :: Maybe String, + hiDir :: Maybe String, + hieDir :: Maybe String, + stubDir :: Maybe String, + dumpDir :: Maybe String, + + objectSuf_ :: String, + hcSuf :: String, + hiSuf_ :: String, + hieSuf :: String, + + dynObjectSuf_ :: String, + dynHiSuf_ :: String, + + outputFile_ :: Maybe String, + dynOutputFile_ :: Maybe String, + outputHi :: Maybe String, + dynOutputHi :: Maybe String, + dynLibLoader :: DynLibLoader, + + dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output + -- because of -dynamic-too. This predicate is + -- used to query the appropriate fields + -- (outputFile/dynOutputFile, ways, etc.) + + -- | This defaults to 'non-module'. It can be set by + -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on + -- where its output is going. + dumpPrefix :: FilePath, + + -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' + -- or 'ghc.GHCi.UI.runStmt'. + -- Set by @-ddump-file-prefix@ + dumpPrefixForce :: Maybe FilePath, + + ldInputs :: [Option], + + includePaths :: IncludeSpecs, + libraryPaths :: [String], + frameworkPaths :: [String], -- used on darwin only + cmdlineFrameworks :: [String], -- ditto + + rtsOpts :: Maybe String, + rtsOptsEnabled :: RtsOptsEnabled, + rtsOptsSuggestions :: Bool, + + hpcDir :: String, -- ^ Path to store the .mix files + + -- Plugins + pluginModNames :: [ModuleName], + -- ^ the @-fplugin@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + pluginModNameOpts :: [(ModuleName,String)], + frontendPluginOpts :: [String], + -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + + externalPluginSpecs :: [ExternalPluginSpec], + -- ^ External plugins loaded from shared libraries + + -- For ghc -M + depMakefile :: FilePath, + depIncludePkgDeps :: Bool, + depIncludeCppDeps :: Bool, + depExcludeMods :: [ModuleName], + depSuffixes :: [String], + + -- Package flags + packageDBFlags :: [PackageDBFlag], + -- ^ The @-package-db@ flags given on the command line, In + -- *reverse* order that they're specified on the command line. + -- This is intended to be applied with the list of "initial" + -- package databases derived from @GHC_PACKAGE_PATH@; see + -- 'getUnitDbRefs'. + + ignorePackageFlags :: [IgnorePackageFlag], + -- ^ The @-ignore-package@ flags from the command line. + -- In *reverse* order that they're specified on the command line. + packageFlags :: [PackageFlag], + -- ^ The @-package@ and @-hide-package@ flags from the command-line. + -- In *reverse* order that they're specified on the command line. + pluginPackageFlags :: [PackageFlag], + -- ^ The @-plugin-package-id@ flags from command line. + -- In *reverse* order that they're specified on the command line. + trustFlags :: [TrustFlag], + -- ^ The @-trust@ and @-distrust@ flags. + -- In *reverse* order that they're specified on the command line. + packageEnv :: Maybe FilePath, + -- ^ Filepath to the package environment file (if overriding default) + + + -- hsc dynamic flags + dumpFlags :: EnumSet DumpFlag, + generalFlags :: EnumSet GeneralFlag, + warningFlags :: EnumSet WarningFlag, + fatalWarningFlags :: EnumSet WarningFlag, + customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] + fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings + -- Don't change this without updating extensionFlags: + language :: Maybe Language, + -- | Safe Haskell mode + safeHaskell :: SafeHaskellMode, + safeInfer :: Bool, + safeInferred :: Bool, + -- We store the location of where some extension and flags were turned on so + -- we can produce accurate error messages when Safe Haskell fails due to + -- them. + thOnLoc :: SrcSpan, + newDerivOnLoc :: SrcSpan, + deriveViaOnLoc :: SrcSpan, + overlapInstLoc :: SrcSpan, + incoherentOnLoc :: SrcSpan, + pkgTrustOnLoc :: SrcSpan, + warnSafeOnLoc :: SrcSpan, + warnUnsafeOnLoc :: SrcSpan, + trustworthyOnLoc :: SrcSpan, + -- Don't change this without updating extensionFlags: + -- Here we collect the settings of the language extensions + -- from the command line, the ghci config file and + -- from interactive :set / :seti commands. + extensions :: [OnOff LangExt.Extension], + -- extensionFlags should always be equal to + -- flattenExtensionFlags language extensions + -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used + -- by template-haskell + extensionFlags :: EnumSet LangExt.Extension, + + -- | Unfolding control + -- See Note [Discounts and thresholds] in GHC.Core.Unfold + unfoldingOpts :: !UnfoldingOpts, + + maxWorkerArgs :: Int, + + ghciHistSize :: Int, + + flushOut :: FlushOut, + + ghcVersionFile :: Maybe FilePath, + haddockOptions :: Maybe String, + + -- | GHCi scripts specified by -ghci-script, in reverse order + ghciScripts :: [String], + + -- Output style options + pprUserLength :: Int, + pprCols :: Int, + + useUnicode :: Bool, + useColor :: OverridingBool, + canUseColor :: Bool, + colScheme :: Col.Scheme, + + -- | what kind of {-# SCC #-} to add automatically + profAuto :: ProfAuto, + callerCcFilters :: [CallerCcFilter], + + interactivePrint :: Maybe String, + + -- | Machine dependent flags (-m\ stuff) + sseVersion :: Maybe SseVersion, + bmiVersion :: Maybe BmiVersion, + avx :: Bool, + avx2 :: Bool, + avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. + avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. + avx512f :: Bool, -- Enable AVX-512 instructions. + avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. + fma :: Bool, -- ^ Enable FMA instructions. + + -- | Run-time linker information (what options we need, etc.) + rtldInfo :: IORef (Maybe LinkerInfo), + + -- | Run-time C compiler information + rtccInfo :: IORef (Maybe CompilerInfo), + + -- | Run-time assembler information + rtasmInfo :: IORef (Maybe CompilerInfo), + + -- Constants used to control the amount of optimization done. + + -- | Max size, in bytes, of inline array allocations. + maxInlineAllocSize :: Int, + + -- | Only inline memcpy if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemcpyInsns :: Int, + + -- | Only inline memset if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemsetInsns :: Int, + + -- | Reverse the order of error messages in GHC/GHCi + reverseErrors :: Bool, + + -- | Limit the maximum number of errors to show + maxErrors :: Maybe Int, + + -- | Unique supply configuration for testing build determinism + initialUnique :: Word, + uniqueIncrement :: Int, + -- 'Int' because it can be used to test uniques in decreasing order. + + -- | Temporary: CFG Edge weights for fast iterations + cfgWeights :: Weights +} + +class HasDynFlags m where + getDynFlags :: m DynFlags + +{- It would be desirable to have the more generalised + + instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where + getDynFlags = lift getDynFlags + +instance definition. However, that definition would overlap with the +`HasDynFlags (GhcT m)` instance. Instead we define instances for a +couple of common Monad transformers explicitly. -} + +instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where + getDynFlags = lift getDynFlags + +class ContainsDynFlags t where + extractDynFlags :: t -> DynFlags + +----------------------------------------------------------------------------- + +-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value +initDynFlags :: DynFlags -> IO DynFlags +initDynFlags dflags = do + let + refRtldInfo <- newIORef Nothing + refRtccInfo <- newIORef Nothing + refRtasmInfo <- newIORef Nothing + canUseUnicode <- do let enc = localeEncoding + str = "‘’" + (withCString enc str $ \cstr -> + do str' <- peekCString enc cstr + return (str == str')) + `catchIOError` \_ -> return False + ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" + let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode + maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" + maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" + let adjustCols (Just env) = Col.parseScheme env + adjustCols Nothing = id + let (useColor', colScheme') = + (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) + (useColor dflags, colScheme dflags) + tmp_dir <- normalise <$> getTemporaryDirectory + return dflags{ + useUnicode = useUnicode', + useColor = useColor', + canUseColor = stderrSupportsAnsiColors, + colScheme = colScheme', + rtldInfo = refRtldInfo, + rtccInfo = refRtccInfo, + rtasmInfo = refRtasmInfo, + tmpDir = TempDir tmp_dir + } + +-- | The normal 'DynFlags'. Note that they are not suitable for use in this form +-- and must be fully initialized by 'GHC.runGhc' first. +defaultDynFlags :: Settings -> DynFlags +defaultDynFlags mySettings = +-- See Note [Updating flag description in the User's Guide] + DynFlags { + ghcMode = CompManager, + ghcLink = LinkBinary, + backend = platformDefaultBackend (sTargetPlatform mySettings), + verbosity = 0, + debugLevel = 0, + simplPhases = 2, + maxSimplIterations = 4, + ruleCheck = Nothing, + binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) + maxRelevantBinds = Just 6, + maxValidHoleFits = Just 6, + maxRefHoleFits = Just 6, + refLevelHoleFits = Nothing, + maxUncoveredPatterns = 4, + maxPmCheckModels = 30, + simplTickFactor = 100, + dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple + specConstrThreshold = Just 2000, + specConstrCount = Just 3, + specConstrRecursive = 3, + liberateCaseThreshold = Just 2000, + floatLamArgs = Just 0, -- Default: float only if no fvs + liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsKnown = False, -- Default: don't turn known calls into unknown ones + cmmProcAlignment = Nothing, + + historySize = 20, + strictnessBefore = [], + + parMakeCount = Nothing, + + enableTimeStats = False, + ghcHeapSize = Nothing, + + importPaths = ["."], + mainModuleNameIs = mAIN_NAME, + mainFunIs = Nothing, + reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, + solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, + + homeUnitId_ = mainUnitId, + homeUnitInstanceOf_ = Nothing, + homeUnitInstantiations_ = [], + + workingDirectory = Nothing, + thisPackageName = Nothing, + hiddenModules = Set.empty, + reexportedModules = Set.empty, + + objectDir = Nothing, + dylibInstallName = Nothing, + hiDir = Nothing, + hieDir = Nothing, + stubDir = Nothing, + dumpDir = Nothing, + + objectSuf_ = phaseInputExt StopLn, + hcSuf = phaseInputExt HCc, + hiSuf_ = "hi", + hieSuf = "hie", + + dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, + dynHiSuf_ = "dyn_hi", + dynamicNow = False, + + pluginModNames = [], + pluginModNameOpts = [], + frontendPluginOpts = [], + + externalPluginSpecs = [], + + outputFile_ = Nothing, + dynOutputFile_ = Nothing, + outputHi = Nothing, + dynOutputHi = Nothing, + dynLibLoader = SystemDependent, + dumpPrefix = "non-module.", + dumpPrefixForce = Nothing, + ldInputs = [], + includePaths = IncludeSpecs [] [] [], + libraryPaths = [], + frameworkPaths = [], + cmdlineFrameworks = [], + rtsOpts = Nothing, + rtsOptsEnabled = RtsOptsSafeOnly, + rtsOptsSuggestions = True, + + hpcDir = ".hpc", + + packageDBFlags = [], + packageFlags = [], + pluginPackageFlags = [], + ignorePackageFlags = [], + trustFlags = [], + packageEnv = Nothing, + targetWays_ = Set.empty, + splitInfo = Nothing, + + ghcNameVersion = sGhcNameVersion mySettings, + fileSettings = sFileSettings mySettings, + toolSettings = sToolSettings mySettings, + targetPlatform = sTargetPlatform mySettings, + platformMisc = sPlatformMisc mySettings, + rawSettings = sRawSettings mySettings, + + tmpDir = panic "defaultDynFlags: uninitialized tmpDir", + + llvmOptLevel = 0, + + -- ghc -M values + depMakefile = "Makefile", + depIncludePkgDeps = False, + depIncludeCppDeps = False, + depExcludeMods = [], + depSuffixes = [], + -- end of ghc -M values + ghcVersionFile = Nothing, + haddockOptions = Nothing, + dumpFlags = EnumSet.empty, + generalFlags = EnumSet.fromList (defaultFlags mySettings), + warningFlags = EnumSet.fromList standardWarnings, + fatalWarningFlags = EnumSet.empty, + customWarningCategories = completeWarningCategorySet, + fatalCustomWarningCategories = emptyWarningCategorySet, + ghciScripts = [], + language = Nothing, + safeHaskell = Sf_None, + safeInfer = True, + safeInferred = True, + thOnLoc = noSrcSpan, + newDerivOnLoc = noSrcSpan, + deriveViaOnLoc = noSrcSpan, + overlapInstLoc = noSrcSpan, + incoherentOnLoc = noSrcSpan, + pkgTrustOnLoc = noSrcSpan, + warnSafeOnLoc = noSrcSpan, + warnUnsafeOnLoc = noSrcSpan, + trustworthyOnLoc = noSrcSpan, + extensions = [], + extensionFlags = flattenExtensionFlags Nothing [], + + unfoldingOpts = defaultUnfoldingOpts, + maxWorkerArgs = 10, + + ghciHistSize = 50, -- keep a log of length 50 by default + + flushOut = defaultFlushOut, + pprUserLength = 5, + pprCols = 100, + useUnicode = False, + useColor = Auto, + canUseColor = False, + colScheme = Col.defaultScheme, + profAuto = NoProfAuto, + callerCcFilters = [], + interactivePrint = Nothing, + sseVersion = Nothing, + bmiVersion = Nothing, + avx = False, + avx2 = False, + avx512cd = False, + avx512er = False, + avx512f = False, + avx512pf = False, + fma = False, + rtldInfo = panic "defaultDynFlags: no rtldInfo", + rtccInfo = panic "defaultDynFlags: no rtccInfo", + rtasmInfo = panic "defaultDynFlags: no rtasmInfo", + + maxInlineAllocSize = 128, + maxInlineMemcpyInsns = 32, + maxInlineMemsetInsns = 32, + + initialUnique = 0, + uniqueIncrement = 1, + + reverseErrors = False, + maxErrors = Nothing, + cfgWeights = defaultWeights + } + +type FatalMessager = String -> IO () + +defaultFatalMessager :: FatalMessager +defaultFatalMessager = hPutStrLn stderr + + +newtype FlushOut = FlushOut (IO ()) + +defaultFlushOut :: FlushOut +defaultFlushOut = FlushOut $ hFlush stdout + + + +data OnOff a = On a + | Off a + deriving (Eq, Show) + +instance Outputable a => Outputable (OnOff a) where + ppr (On x) = text "On" <+> ppr x + ppr (Off x) = text "Off" <+> ppr x + +-- OnOffs accumulate in reverse order, so we use foldr in order to +-- process them in the right order +flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension +flattenExtensionFlags ml = foldr g defaultExtensionFlags + where g (On f) flags = EnumSet.insert f flags + g (Off f) flags = EnumSet.delete f flags + defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) + +-- ----------------------------------------------------------------------------- +-- -jN + +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + -- | Use this many processors (@-j@ flag). + = ParMakeThisMany Int + -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). + | ParMakeNumProcessors + -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). + | ParMakeSemaphore FilePath + +-- ----------------------------------------------------------------------------- +-- Linker/compiler information + +-- LinkerInfo contains any extra options needed by the system linker. +data LinkerInfo + = GnuLD [Option] + | Mold [Option] + | GnuGold [Option] + | LlvmLLD [Option] + | DarwinLD [Option] + | SolarisLD [Option] + | AixLD [Option] + | UnknownLD + deriving Eq + +-- CompilerInfo tells us which C compiler we're using +data CompilerInfo + = GCC + | Clang + | AppleClang + | AppleClang51 + | Emscripten + | UnknownCC + deriving Eq + +-- | The 'GhcMode' tells us whether we're doing multi-module +-- compilation (controlled via the "GHC" API) or one-shot +-- (single-module) compilation. This makes a difference primarily to +-- the "GHC.Unit.Finder": in one-shot mode we look for interface files for +-- imported modules, but in multi-module mode we look for source files +-- in order to check whether they need to be recompiled. +data GhcMode + = CompManager -- ^ @\-\-make@, GHCi, etc. + | OneShot -- ^ @ghc -c Foo.hs@ + | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this + deriving Eq + +instance Outputable GhcMode where + ppr CompManager = text "CompManager" + ppr OneShot = text "OneShot" + ppr MkDepend = text "MkDepend" + +isOneShot :: GhcMode -> Bool +isOneShot OneShot = True +isOneShot _other = False + +-- | What to do in the link step, if there is one. +data GhcLink + = NoLink -- ^ Don't link at all + | LinkBinary -- ^ Link object code into a binary + | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both + -- bytecode and object code). + | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) + | LinkStaticLib -- ^ Link objects into a static lib + | LinkMergedObj -- ^ Link objects into a merged "GHCi object" + deriving (Eq, Show) + +isNoLink :: GhcLink -> Bool +isNoLink NoLink = True +isNoLink _ = False + +-- | We accept flags which make packages visible, but how they select +-- the package varies; this data type reflects what selection criterion +-- is used. +data PackageArg = + PackageArg String -- ^ @-package@, by 'PackageName' + | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' + deriving (Eq, Show) + +instance Outputable PackageArg where + ppr (PackageArg pn) = text "package" <+> text pn + ppr (UnitIdArg uid) = text "unit" <+> ppr uid + +-- | Represents the renaming that may be associated with an exposed +-- package, e.g. the @rns@ part of @-package "foo (rns)"@. +-- +-- Here are some example parsings of the package flags (where +-- a string literal is punned to be a 'ModuleName': +-- +-- * @-package foo@ is @ModRenaming True []@ +-- * @-package foo ()@ is @ModRenaming False []@ +-- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ +-- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ +-- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ +data ModRenaming = ModRenaming { + modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? + modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope + -- under name @n at . + } deriving (Eq) +instance Outputable ModRenaming where + ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) + +-- | Flags for manipulating the set of non-broken packages. +newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ + deriving (Eq) + +-- | Flags for manipulating package trust. +data TrustFlag + = TrustPackage String -- ^ @-trust@ + | DistrustPackage String -- ^ @-distrust@ + deriving (Eq) + +-- | Flags for manipulating packages visibility. +data PackageFlag + = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ + | HidePackage String -- ^ @-hide-package@ + deriving (Eq) -- NB: equality instance is used by packageFlagsChanged + +data PackageDBFlag + = PackageDB PkgDbRef + | NoUserPackageDB + | NoGlobalPackageDB + | ClearPackageDBs + deriving (Eq) + +packageFlagsChanged :: DynFlags -> DynFlags -> Bool +packageFlagsChanged idflags1 idflags0 = + packageFlags idflags1 /= packageFlags idflags0 || + ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || + pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || + trustFlags idflags1 /= trustFlags idflags0 || + packageDBFlags idflags1 /= packageDBFlags idflags0 || + packageGFlags idflags1 /= packageGFlags idflags0 + where + packageGFlags dflags = map (`gopt` dflags) + [ Opt_HideAllPackages + , Opt_HideAllPluginPackages + , Opt_AutoLinkPackages ] + +instance Outputable PackageFlag where + ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) + ppr (HidePackage str) = text "-hide-package" <+> text str + +data DynLibLoader + = Deployable + | SystemDependent + deriving Eq + +data RtsOptsEnabled + = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly + | RtsOptsAll + deriving (Show) + +-- | Are we building with @-fPIE@ or @-fPIC@ enabled? +positionIndependent :: DynFlags -> Bool +positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags + +-- Note [-dynamic-too business] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- With -dynamic-too flag, we try to build both the non-dynamic and dynamic +-- objects in a single run of the compiler: the pipeline is the same down to +-- Core optimisation, then the backend (from Core to object code) is executed +-- twice. +-- +-- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic +-- and dynamic loaded interfaces (#9176). +-- +-- To make matters worse, we automatically enable -dynamic-too when some modules +-- need Template-Haskell and GHC is dynamically linked (cf +-- GHC.Driver.Pipeline.compileOne'). +-- +-- We used to try and fall back from a dynamic-too failure but this feature +-- didn't work as expected (#20446) so it was removed to simplify the +-- implementation and not obscure latent bugs. + +data DynamicTooState + = DT_Dont -- ^ Don't try to build dynamic objects too + | DT_OK -- ^ Will still try to generate dynamic objects + | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) + deriving (Eq,Show,Ord) + +dynamicTooState :: DynFlags -> DynamicTooState +dynamicTooState dflags + | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont + | dynamicNow dflags = DT_Dyn + | otherwise = DT_OK + +setDynamicNow :: DynFlags -> DynFlags +setDynamicNow dflags0 = + dflags0 + { dynamicNow = True + } + +data PkgDbRef + = GlobalPkgDb + | UserPkgDb + | PkgDbPath FilePath + deriving Eq + +-- | Used to differentiate the scope an include needs to apply to. +-- We have to split the include paths to avoid accidentally forcing recursive +-- includes since -I overrides the system search paths. See #14312. +data IncludeSpecs + = IncludeSpecs { includePathsQuote :: [String] + , includePathsGlobal :: [String] + -- | See Note [Implicit include paths] + , includePathsQuoteImplicit :: [String] + } + deriving Show + +-- | Append to the list of includes a path that shall be included using `-I` +-- when the C compiler is called. These paths override system search paths. +addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addGlobalInclude spec paths = let f = includePathsGlobal spec + in spec { includePathsGlobal = f ++ paths } + +-- | Append to the list of includes a path that shall be included using +-- `-iquote` when the C compiler is called. These paths only apply when quoted +-- includes are used. e.g. #include "foo.h" +addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addQuoteInclude spec paths = let f = includePathsQuote spec + in spec { includePathsQuote = f ++ paths } + +-- | These includes are not considered while fingerprinting the flags for iface +-- | See Note [Implicit include paths] +addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec + in spec { includePathsQuoteImplicit = f ++ paths } + + +-- | Concatenate and flatten the list of global and quoted includes returning +-- just a flat list of paths. +flattenIncludes :: IncludeSpecs -> [String] +flattenIncludes specs = + includePathsQuote specs ++ + includePathsQuoteImplicit specs ++ + includePathsGlobal specs + +{- Note [Implicit include paths] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The compile driver adds the path to the folder containing the source file being + compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' + that are used later to compute the interface file. Because of this, + the flags fingerprint derived from these 'DynFlags' and recorded in the + interface file will end up containing the absolute path to the source folder. + + Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) + store the build artifacts produced by a build BA for reuse in subsequent builds. + + Embedding source paths in interface fingerprints will thwart these attempts and + lead to unnecessary recompilations when the source paths in BA differ from the + source paths in subsequent builds. + -} + +hasPprDebug :: DynFlags -> Bool +hasPprDebug = dopt Opt_D_ppr_debug + +hasNoDebugOutput :: DynFlags -> Bool +hasNoDebugOutput = dopt Opt_D_no_debug_output + +hasNoStateHack :: DynFlags -> Bool +hasNoStateHack = gopt Opt_G_NoStateHack + +hasNoOptCoercion :: DynFlags -> Bool +hasNoOptCoercion = gopt Opt_G_NoOptCoercion + +-- | Test whether a 'DumpFlag' is set +dopt :: DumpFlag -> DynFlags -> Bool +dopt = getDumpFlagFrom verbosity dumpFlags + +-- | Set a 'DumpFlag' +dopt_set :: DynFlags -> DumpFlag -> DynFlags +dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } + +-- | Unset a 'DumpFlag' +dopt_unset :: DynFlags -> DumpFlag -> DynFlags +dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } + +-- | Test whether a 'GeneralFlag' is set +-- +-- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) +-- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables +-- Opt_SplitSections. +-- +gopt :: GeneralFlag -> DynFlags -> Bool +gopt Opt_PIC dflags + | dynamicNow dflags = True +gopt Opt_ExternalDynamicRefs dflags + | dynamicNow dflags = True +gopt Opt_SplitSections dflags + | dynamicNow dflags = False +gopt f dflags = f `EnumSet.member` generalFlags dflags + +-- | Set a 'GeneralFlag' +gopt_set :: DynFlags -> GeneralFlag -> DynFlags +gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } + +-- | Unset a 'GeneralFlag' +gopt_unset :: DynFlags -> GeneralFlag -> DynFlags +gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } + +-- | Test whether a 'WarningFlag' is set +wopt :: WarningFlag -> DynFlags -> Bool +wopt f dflags = f `EnumSet.member` warningFlags dflags + +-- | Set a 'WarningFlag' +wopt_set :: DynFlags -> WarningFlag -> DynFlags +wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } + +-- | Unset a 'WarningFlag' +wopt_unset :: DynFlags -> WarningFlag -> DynFlags +wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } + +-- | Test whether a 'WarningFlag' is set as fatal +wopt_fatal :: WarningFlag -> DynFlags -> Bool +wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags + +-- | Mark a 'WarningFlag' as fatal (do not set the flag) +wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_set_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } + +-- | Mark a 'WarningFlag' as not fatal +wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_unset_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } + + +-- | Enable all custom warning categories. +wopt_set_all_custom :: DynFlags -> DynFlags +wopt_set_all_custom dfs + = dfs{ customWarningCategories = completeWarningCategorySet } + +-- | Disable all custom warning categories. +wopt_unset_all_custom :: DynFlags -> DynFlags +wopt_unset_all_custom dfs + = dfs{ customWarningCategories = emptyWarningCategorySet } + +-- | Mark all custom warning categories as fatal (do not set the flags). +wopt_set_all_fatal_custom :: DynFlags -> DynFlags +wopt_set_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = completeWarningCategorySet } + +-- | Mark all custom warning categories as non-fatal. +wopt_unset_all_fatal_custom :: DynFlags -> DynFlags +wopt_unset_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } + +-- | Set a custom 'WarningCategory' +wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } + +-- | Unset a custom 'WarningCategory' +wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as fatal (do not set the flag) +wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as not fatal +wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Are there any custom warning categories enabled? +wopt_any_custom :: DynFlags -> Bool +wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) + + +-- | Test whether a 'LangExt.Extension' is set +xopt :: LangExt.Extension -> DynFlags -> Bool +xopt f dflags = f `EnumSet.member` extensionFlags dflags + +-- | Set a 'LangExt.Extension' +xopt_set :: DynFlags -> LangExt.Extension -> DynFlags +xopt_set dfs f + = let onoffs = On f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Unset a 'LangExt.Extension' +xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags +xopt_unset dfs f + = let onoffs = Off f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Set or unset a 'LangExt.Extension', unless it has been explicitly +-- set or unset before. +xopt_set_unlessExplSpec + :: LangExt.Extension + -> (DynFlags -> LangExt.Extension -> DynFlags) + -> DynFlags -> DynFlags +xopt_set_unlessExplSpec ext setUnset dflags = + let referedExts = stripOnOff <$> extensions dflags + stripOnOff (On x) = x + stripOnOff (Off x) = x + in + if ext `elem` referedExts then dflags else setUnset dflags ext + +xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields +xopt_DuplicateRecordFields dfs + | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields + | otherwise = FieldLabel.NoDuplicateRecordFields + +xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors +xopt_FieldSelectors dfs + | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors + | otherwise = FieldLabel.NoFieldSelectors + +lang_set :: DynFlags -> Maybe Language -> DynFlags +lang_set dflags lang = + dflags { + language = lang, + extensionFlags = flattenExtensionFlags lang (extensions dflags) + } + +defaultFlags :: Settings -> [GeneralFlag] +defaultFlags settings +-- See Note [Updating flag description in the User's Guide] + = [ Opt_AutoLinkPackages, + Opt_DiagnosticsShowCaret, + Opt_EmbedManifest, + Opt_FamAppCache, + Opt_GenManifest, + Opt_GhciHistory, + Opt_GhciSandbox, + Opt_HelpfulErrors, + Opt_KeepHiFiles, + Opt_KeepOFiles, + Opt_OmitYields, + Opt_PrintBindContents, + Opt_ProfCountEntries, + Opt_SharedImplib, + Opt_SimplPreInlining, + Opt_VersionMacros, + Opt_RPath, + Opt_DumpWithWays, + Opt_CompactUnwind, + Opt_ShowErrorContext, + Opt_SuppressStgReps, + Opt_UnoptimizedCoreForInterpreter + ] + + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + + -- Default floating flags (see Note [RHS Floating]) + ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] + + + ++ default_PIC platform + + ++ validHoleFitDefaults + + + where platform = sTargetPlatform settings + +-- | These are the default settings for the display and sorting of valid hole +-- fits in typed-hole error messages. See Note [Valid hole fits include ...] + -- in the "GHC.Tc.Errors.Hole" module. +validHoleFitDefaults :: [GeneralFlag] +validHoleFitDefaults + = [ Opt_ShowTypeAppOfHoleFits + , Opt_ShowTypeOfHoleFits + , Opt_ShowProvOfHoleFits + , Opt_ShowMatchesOfHoleFits + , Opt_ShowValidHoleFits + , Opt_SortValidHoleFits + , Opt_SortBySizeHoleFits + , Opt_ShowHoleConstraints ] + +-- Note [When is StarIsType enabled] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- The StarIsType extension determines whether to treat '*' as a regular type +-- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType +-- programs expect '*' to be synonymous with 'Type', so by default StarIsType is +-- enabled. +-- +-- Programs that use TypeOperators might expect to repurpose '*' for +-- multiplication or another binary operation, but making TypeOperators imply +-- NoStarIsType caused too much breakage on Hackage. +-- + +-- +-- Note [Documenting optimisation flags] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- If you change the list of flags enabled for particular optimisation levels +-- please remember to update the User's Guide. The relevant file is: +-- +-- docs/users_guide/using-optimisation.rst +-- +-- Make sure to note whether a flag is implied by -O0, -O or -O2. + +optLevelFlags :: [([Int], GeneralFlag)] +-- Default settings of flags, before any command-line overrides +optLevelFlags -- see Note [Documenting optimisation flags] + = [ ([0,1,2], Opt_DoLambdaEtaExpansion) + , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] + , ([0,1,2], Opt_LlvmTBAA) + , ([0,1,2], Opt_ProfManualCcs ) + , ([2], Opt_DictsStrict) + + , ([0], Opt_IgnoreInterfacePragmas) + , ([0], Opt_OmitInterfacePragmas) + + , ([1,2], Opt_CoreConstantFolding) + + , ([1,2], Opt_CallArity) + , ([1,2], Opt_Exitification) + , ([1,2], Opt_CaseMerge) + , ([1,2], Opt_CaseFolding) + , ([1,2], Opt_CmmElimCommonBlocks) + , ([2], Opt_AsmShortcutting) + , ([1,2], Opt_CmmSink) + , ([1,2], Opt_CmmStaticPred) + , ([1,2], Opt_CSE) + , ([1,2], Opt_StgCSE) + , ([2], Opt_StgLiftLams) + , ([1,2], Opt_CmmControlFlow) + + , ([1,2], Opt_EnableRewriteRules) + -- Off for -O0. Otherwise we desugar list literals + -- to 'build' but don't run the simplifier passes that + -- would rewrite them back to cons cells! This seems + -- silly, and matters for the GHCi debugger. + + , ([1,2], Opt_FloatIn) + , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_IgnoreAsserts) + , ([1,2], Opt_Loopification) + , ([1,2], Opt_CfgBlocklayout) -- Experimental + + , ([1,2], Opt_Specialise) + , ([1,2], Opt_CrossModuleSpecialise) + , ([1,2], Opt_InlineGenerics) + , ([1,2], Opt_Strictness) + , ([1,2], Opt_UnboxSmallStrictFields) + , ([1,2], Opt_CprAnal) + , ([1,2], Opt_WorkerWrapper) + , ([1,2], Opt_SolveConstantDicts) + , ([1,2], Opt_NumConstantFolding) + + , ([2], Opt_LiberateCase) + , ([2], Opt_SpecConstr) + , ([2], Opt_FastPAPCalls) +-- , ([2], Opt_RegsGraph) +-- RegsGraph suffers performance regression. See #7679 +-- , ([2], Opt_StaticArgumentTransformation) +-- Static Argument Transformation needs investigation. See #9374 + ] + +type TurnOnFlag = Bool -- True <=> we are turning the flag on + -- False <=> we are turning the flag off +turnOn :: TurnOnFlag; turnOn = True +turnOff :: TurnOnFlag; turnOff = False + +default_PIC :: Platform -> [GeneralFlag] +default_PIC platform = + case (platformOS platform, platformArch platform) of + -- Darwin always requires PIC. Especially on more recent macOS releases + -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses + -- while we could work around this on x86_64 (like WINE does), we won't be + -- able on aarch64, where this is enforced. + (OSDarwin, ArchX86_64) -> [Opt_PIC] + -- For AArch64, we need to always have PIC enabled. The relocation model + -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't + -- control much how far apart symbols are in memory for our in-memory static + -- linker; and thus need to ensure we get sufficiently capable relocations. + -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top + -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to + -- be built with -fPIC. + (OSDarwin, ArchAArch64) -> [Opt_PIC] + (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in + -- OpenBSD since 5.3 release + -- (1 May 2013) we need to + -- always generate PIC. See + -- #10597 for more + -- information. + _ -> [] + +-- | The language extensions implied by the various language variants. +-- When updating this be sure to update the flag documentation in +-- @docs/users_guide/exts at . +languageExtensions :: Maybe Language -> [LangExt.Extension] + +-- Nothing: the default case +languageExtensions Nothing = languageExtensions (Just GHC2021) + +languageExtensions (Just Haskell98) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.NPlusKPatterns, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.FieldSelectors, + LangExt.NondecreasingIndentation, + -- strictly speaking non-standard, but we always had this + -- on implicitly before the option was added in 7.1, and + -- turning it off breaks code, so we're keeping it on for + -- backwards compatibility. Cabal uses -XHaskell98 by + -- default unless you specify another language. + LangExt.DeepSubsumption + -- Non-standard but enabled for backwards compatability (see GHC proposal #511) + ] + +languageExtensions (Just Haskell2010) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + LangExt.DeepSubsumption ] + +languageExtensions (Just GHC2021) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.MonomorphismRestriction, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + -- Now the new extensions (not in Haskell2010) + LangExt.BangPatterns, + LangExt.BinaryLiterals, + LangExt.ConstrainedClassMethods, + LangExt.ConstraintKinds, + LangExt.DeriveDataTypeable, + LangExt.DeriveFoldable, + LangExt.DeriveFunctor, + LangExt.DeriveGeneric, + LangExt.DeriveLift, + LangExt.DeriveTraversable, + LangExt.EmptyCase, + LangExt.EmptyDataDeriving, + LangExt.ExistentialQuantification, + LangExt.ExplicitForAll, + LangExt.FlexibleContexts, + LangExt.FlexibleInstances, + LangExt.GADTSyntax, + LangExt.GeneralizedNewtypeDeriving, + LangExt.HexFloatLiterals, + LangExt.ImportQualifiedPost, + LangExt.InstanceSigs, + LangExt.KindSignatures, + LangExt.MultiParamTypeClasses, + LangExt.NamedFieldPuns, + LangExt.NamedWildCards, + LangExt.NumericUnderscores, + LangExt.PolyKinds, + LangExt.PostfixOperators, + LangExt.RankNTypes, + LangExt.ScopedTypeVariables, + LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.StandaloneDeriving, + LangExt.StandaloneKindSignatures, + LangExt.TupleSections, + LangExt.TypeApplications, + LangExt.TypeOperators, + LangExt.TypeSynonymInstances] + + +ways :: DynFlags -> Ways +ways dflags + | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) + | otherwise = targetWays_ dflags +-- +-- System tool settings and locations + +programName :: DynFlags -> String +programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags +projectVersion :: DynFlags -> String +projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) +ghcUsagePath :: DynFlags -> FilePath +ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags +ghciUsagePath :: DynFlags -> FilePath +ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags +topDir :: DynFlags -> FilePath +topDir dflags = fileSettings_topDir $ fileSettings dflags +toolDir :: DynFlags -> Maybe FilePath +toolDir dflags = fileSettings_toolDir $ fileSettings dflags +extraGccViaCFlags :: DynFlags -> [String] +extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags +globalPackageDatabasePath :: DynFlags -> FilePath +globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags + +-- | The directory for this version of ghc in the user's app directory +-- The appdir used to be in ~/.ghc but to respect the XDG specification +-- we want to move it under $XDG_DATA_HOME/ +-- However, old tooling (like cabal) might still write package environments +-- to the old directory, so we prefer that if a subdirectory of ~/.ghc +-- with the correct target and GHC version suffix exists. +-- +-- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that +-- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR +-- +-- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version +versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath +versionedAppDir appname platform = do + -- Make sure we handle the case the HOME isn't set (see #11678) + -- We need to fallback to the old scheme if the subdirectory exists. + msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) + [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ + , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ + ] + where + checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case + True -> pure dir + False -> MaybeT (pure Nothing) + +versionedFilePath :: ArchOS -> FilePath +versionedFilePath platform = uniqueSubdir platform + +-- SDoc +------------------------------------------- + +-- | Initialize the pretty-printing options +initSDocContext :: DynFlags -> PprStyle -> SDocContext +initSDocContext dflags style = SDC + { sdocStyle = style + , sdocColScheme = colScheme dflags + , sdocLastColour = Col.colReset + , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) + , sdocDefaultDepth = pprUserLength dflags + , sdocLineLength = pprCols dflags + , sdocCanUseUnicode = useUnicode dflags + , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags + , sdocPprDebug = dopt Opt_D_ppr_debug dflags + , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags + , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags + , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags + , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags + , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags + , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags + , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags + , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags + , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags + , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags + , sdocSuppressTicks = gopt Opt_SuppressTicks dflags + , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags + , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags + , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags + , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags + , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags + , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags + , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags + , sdocSuppressUniques = gopt Opt_SuppressUniques dflags + , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags + , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags + , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags + , sdocErrorSpans = gopt Opt_ErrorSpans dflags + , sdocStarIsType = xopt LangExt.StarIsType dflags + , sdocLinearTypes = xopt LangExt.LinearTypes dflags + , sdocListTuplePuns = True + , sdocPrintTypeAbbreviations = True + , sdocUnitIdForUser = ftext + } + +-- | Initialize the pretty-printing options using the default user style +initDefaultSDocContext :: DynFlags -> SDocContext +initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle + +initPromotionTickContext :: DynFlags -> PromotionTickContext +initPromotionTickContext dflags = + PromTickCtx { + ptcListTuplePuns = True, + ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags + } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -41,7 +41,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Errors ( printOrThrowDiagnostics ) import GHC.Driver.Errors.Types ( GhcMessage ) import GHC.Driver.Config.Logger (initLogFlags) ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -7,7 +7,7 @@ module GHC.Driver.Env.Types import GHC.Driver.Errors.Types ( GhcMessage ) import {-# SOURCE #-} GHC.Driver.Hooks -import GHC.Driver.Session ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) +import GHC.Driver.DynFlags ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Prelude ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Prelude import GHC.Driver.Errors.Types import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () import GHC.Types.Error ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Prelude import Data.Bifunctor import Data.Typeable -import GHC.Driver.Session (DynFlags, PackageArg, gopt) +import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt) import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage)) import GHC.Types.Error import GHC.Unit.Module @@ -384,4 +384,4 @@ checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage checkBuildingCabalPackage dflags = if gopt Opt_BuildingCabalPackage dflags then YesBuildingCabalPackage - else NoBuildingCabalPackage \ No newline at end of file + else NoBuildingCabalPackage ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -32,7 +32,7 @@ where import GHC.Prelude import GHC.Driver.Env -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Pipeline.Phases import GHC.Hs.Decls ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -11,7 +11,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.State import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -230,53 +230,40 @@ import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile -import GHC.UniqueSubdir (uniqueSubdir) import GHC.Unit.Types import GHC.Unit.Parser import GHC.Unit.Module import GHC.Unit.Module.Warnings -import GHC.Builtin.Names ( mAIN_NAME ) -import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.DynFlags import GHC.Driver.Flags import GHC.Driver.Backend import GHC.Driver.Plugins.External import GHC.Settings.Config -import GHC.Utils.CliOption import GHC.Core.Unfold import GHC.Driver.CmdLine -import GHC.Settings.Constants import GHC.Utils.Panic -import qualified GHC.Utils.Ppr.Colour as Col import GHC.Utils.Misc import GHC.Utils.Constants (debugIsOn) import GHC.Utils.GlobalVars import GHC.Data.Maybe import GHC.Data.Bool import GHC.Utils.Monad -import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.SrcLoc import GHC.Types.SafeHaskell -import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) -import GHC.Types.ProfAuto -import qualified GHC.Types.FieldLabel as FieldLabel +import GHC.Types.Basic ( treatZeroAsInf ) import GHC.Data.FastString import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable import GHC.Settings import GHC.CmmToAsm.CFG.Weight -import {-# SOURCE #-} GHC.Core.Opt.CallerCC +import GHC.Core.Opt.CallerCC -import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) import Data.IORef import Control.Arrow ((&&&)) import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.Writer -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Except import Control.Monad.Trans.State as State import Data.Functor.Identity @@ -287,17 +274,11 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set import System.FilePath -import System.Directory -import System.Environment (lookupEnv) -import System.IO -import System.IO.Error import Text.ParserCombinators.ReadP hiding (char) import Text.ParserCombinators.ReadP as R -import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet -import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -- Note [Updating flag description in the User's Guide] @@ -376,387 +357,6 @@ import qualified GHC.LanguageExtensions as LangExt -- ----------------------------------------------------------------------------- -- DynFlags --- | Used to differentiate the scope an include needs to apply to. --- We have to split the include paths to avoid accidentally forcing recursive --- includes since -I overrides the system search paths. See #14312. -data IncludeSpecs - = IncludeSpecs { includePathsQuote :: [String] - , includePathsGlobal :: [String] - -- | See Note [Implicit include paths] - , includePathsQuoteImplicit :: [String] - } - deriving Show - --- | Append to the list of includes a path that shall be included using `-I` --- when the C compiler is called. These paths override system search paths. -addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addGlobalInclude spec paths = let f = includePathsGlobal spec - in spec { includePathsGlobal = f ++ paths } - --- | Append to the list of includes a path that shall be included using --- `-iquote` when the C compiler is called. These paths only apply when quoted --- includes are used. e.g. #include "foo.h" -addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addQuoteInclude spec paths = let f = includePathsQuote spec - in spec { includePathsQuote = f ++ paths } - --- | These includes are not considered while fingerprinting the flags for iface --- | See Note [Implicit include paths] -addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec - in spec { includePathsQuoteImplicit = f ++ paths } - - --- | Concatenate and flatten the list of global and quoted includes returning --- just a flat list of paths. -flattenIncludes :: IncludeSpecs -> [String] -flattenIncludes specs = - includePathsQuote specs ++ - includePathsQuoteImplicit specs ++ - includePathsGlobal specs - -{- Note [Implicit include paths] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - The compile driver adds the path to the folder containing the source file being - compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' - that are used later to compute the interface file. Because of this, - the flags fingerprint derived from these 'DynFlags' and recorded in the - interface file will end up containing the absolute path to the source folder. - - Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) - store the build artifacts produced by a build BA for reuse in subsequent builds. - - Embedding source paths in interface fingerprints will thwart these attempts and - lead to unnecessary recompilations when the source paths in BA differ from the - source paths in subsequent builds. - -} - - --- | Contains not only a collection of 'GeneralFlag's but also a plethora of --- information relating to the compilation of a single file or GHC session -data DynFlags = DynFlags { - ghcMode :: GhcMode, - ghcLink :: GhcLink, - backend :: !Backend, - -- ^ The backend to use (if any). - -- - -- Whenever you change the backend, also make sure to set 'ghcLink' to - -- something sensible. - -- - -- 'NoBackend' can be used to avoid generating any output, however, note that: - -- - -- * If a program uses Template Haskell the typechecker may need to run code - -- from an imported module. To facilitate this, code generation is enabled - -- for modules imported by modules that use template haskell, using the - -- default backend for the platform. - -- See Note [-fno-code mode]. - - - -- formerly Settings - ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, - fileSettings :: {-# UNPACK #-} !FileSettings, - targetPlatform :: Platform, -- Filled in by SysTools - toolSettings :: {-# UNPACK #-} !ToolSettings, - platformMisc :: {-# UNPACK #-} !PlatformMisc, - rawSettings :: [(String, String)], - tmpDir :: TempDir, - - llvmOptLevel :: Int, -- ^ LLVM optimisation level - verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] - debugLevel :: Int, -- ^ How much debug information to produce - simplPhases :: Int, -- ^ Number of simplifier phases - maxSimplIterations :: Int, -- ^ Max simplifier iterations - ruleCheck :: Maybe String, - strictnessBefore :: [Int], -- ^ Additional demand analysis - - parMakeCount :: Maybe ParMakeCount, - -- ^ The number of modules to compile in parallel - -- If unspecified, compile with a single job. - - enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? - ghcHeapSize :: Maybe Int, -- ^ The heap size to set. - - maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt - -- to show in type error messages - maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show - -- in typed hole error messages - maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole - -- fits to show in typed hole error - -- messages - refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for - -- refinement hole fits in typed hole - -- error messages - maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show - -- in non-exhaustiveness warnings - maxPmCheckModels :: Int, -- ^ Soft limit on the number of models - -- the pattern match checker checks - -- a pattern against. A safe guard - -- against exponential blow-up. - simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks - dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an - -- Unboxed demand on returned products with at most - -- this number of fields - specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr - specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function - specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types - -- Not optional; otherwise ForceSpecConstr can diverge. - binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above - -- this threshold will be dumped in a binary file - -- by the assembler code generator. 0 and Nothing disables - -- this feature. See 'GHC.StgToCmm.Config'. - liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase - floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating - -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' - - liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- recursive function. - liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- non-recursive function. - liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call - -- into an unknown call. - - cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. - - historySize :: Int, -- ^ Simplification history size - - importPaths :: [FilePath], - mainModuleNameIs :: ModuleName, - mainFunIs :: Maybe String, - reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth - solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver - -- Typically only 1 is needed - givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens - -- Should be < solverIterations - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - homeUnitId_ :: UnitId, -- ^ Target home unit-id - homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate - homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations - - -- Note [Filepaths and Multiple Home Units] - workingDirectory :: Maybe FilePath, - thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units - hiddenModules :: Set.Set ModuleName, - reexportedModules :: Set.Set ModuleName, - - -- ways - targetWays_ :: Ways, -- ^ Target way flags from the command line - - -- For object splitting - splitInfo :: Maybe (String,Int), - - -- paths etc. - objectDir :: Maybe String, - dylibInstallName :: Maybe String, - hiDir :: Maybe String, - hieDir :: Maybe String, - stubDir :: Maybe String, - dumpDir :: Maybe String, - - objectSuf_ :: String, - hcSuf :: String, - hiSuf_ :: String, - hieSuf :: String, - - dynObjectSuf_ :: String, - dynHiSuf_ :: String, - - outputFile_ :: Maybe String, - dynOutputFile_ :: Maybe String, - outputHi :: Maybe String, - dynOutputHi :: Maybe String, - dynLibLoader :: DynLibLoader, - - dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output - -- because of -dynamic-too. This predicate is - -- used to query the appropriate fields - -- (outputFile/dynOutputFile, ways, etc.) - - -- | This defaults to 'non-module'. It can be set by - -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on - -- where its output is going. - dumpPrefix :: FilePath, - - -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' - -- or 'ghc.GHCi.UI.runStmt'. - -- Set by @-ddump-file-prefix@ - dumpPrefixForce :: Maybe FilePath, - - ldInputs :: [Option], - - includePaths :: IncludeSpecs, - libraryPaths :: [String], - frameworkPaths :: [String], -- used on darwin only - cmdlineFrameworks :: [String], -- ditto - - rtsOpts :: Maybe String, - rtsOptsEnabled :: RtsOptsEnabled, - rtsOptsSuggestions :: Bool, - - hpcDir :: String, -- ^ Path to store the .mix files - - -- Plugins - pluginModNames :: [ModuleName], - -- ^ the @-fplugin@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - pluginModNameOpts :: [(ModuleName,String)], - frontendPluginOpts :: [String], - -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - - externalPluginSpecs :: [ExternalPluginSpec], - -- ^ External plugins loaded from shared libraries - - -- For ghc -M - depMakefile :: FilePath, - depIncludePkgDeps :: Bool, - depIncludeCppDeps :: Bool, - depExcludeMods :: [ModuleName], - depSuffixes :: [String], - - -- Package flags - packageDBFlags :: [PackageDBFlag], - -- ^ The @-package-db@ flags given on the command line, In - -- *reverse* order that they're specified on the command line. - -- This is intended to be applied with the list of "initial" - -- package databases derived from @GHC_PACKAGE_PATH@; see - -- 'getUnitDbRefs'. - - ignorePackageFlags :: [IgnorePackageFlag], - -- ^ The @-ignore-package@ flags from the command line. - -- In *reverse* order that they're specified on the command line. - packageFlags :: [PackageFlag], - -- ^ The @-package@ and @-hide-package@ flags from the command-line. - -- In *reverse* order that they're specified on the command line. - pluginPackageFlags :: [PackageFlag], - -- ^ The @-plugin-package-id@ flags from command line. - -- In *reverse* order that they're specified on the command line. - trustFlags :: [TrustFlag], - -- ^ The @-trust@ and @-distrust@ flags. - -- In *reverse* order that they're specified on the command line. - packageEnv :: Maybe FilePath, - -- ^ Filepath to the package environment file (if overriding default) - - - -- hsc dynamic flags - dumpFlags :: EnumSet DumpFlag, - generalFlags :: EnumSet GeneralFlag, - warningFlags :: EnumSet WarningFlag, - fatalWarningFlags :: EnumSet WarningFlag, - customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] - fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings - -- Don't change this without updating extensionFlags: - language :: Maybe Language, - -- | Safe Haskell mode - safeHaskell :: SafeHaskellMode, - safeInfer :: Bool, - safeInferred :: Bool, - -- We store the location of where some extension and flags were turned on so - -- we can produce accurate error messages when Safe Haskell fails due to - -- them. - thOnLoc :: SrcSpan, - newDerivOnLoc :: SrcSpan, - deriveViaOnLoc :: SrcSpan, - overlapInstLoc :: SrcSpan, - incoherentOnLoc :: SrcSpan, - pkgTrustOnLoc :: SrcSpan, - warnSafeOnLoc :: SrcSpan, - warnUnsafeOnLoc :: SrcSpan, - trustworthyOnLoc :: SrcSpan, - -- Don't change this without updating extensionFlags: - -- Here we collect the settings of the language extensions - -- from the command line, the ghci config file and - -- from interactive :set / :seti commands. - extensions :: [OnOff LangExt.Extension], - -- extensionFlags should always be equal to - -- flattenExtensionFlags language extensions - -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used - -- by template-haskell - extensionFlags :: EnumSet LangExt.Extension, - - -- | Unfolding control - -- See Note [Discounts and thresholds] in GHC.Core.Unfold - unfoldingOpts :: !UnfoldingOpts, - - maxWorkerArgs :: Int, - - ghciHistSize :: Int, - - flushOut :: FlushOut, - - ghcVersionFile :: Maybe FilePath, - haddockOptions :: Maybe String, - - -- | GHCi scripts specified by -ghci-script, in reverse order - ghciScripts :: [String], - - -- Output style options - pprUserLength :: Int, - pprCols :: Int, - - useUnicode :: Bool, - useColor :: OverridingBool, - canUseColor :: Bool, - colScheme :: Col.Scheme, - - -- | what kind of {-# SCC #-} to add automatically - profAuto :: ProfAuto, - callerCcFilters :: [CallerCcFilter], - - interactivePrint :: Maybe String, - - -- | Machine dependent flags (-m\ stuff) - sseVersion :: Maybe SseVersion, - bmiVersion :: Maybe BmiVersion, - avx :: Bool, - avx2 :: Bool, - avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. - avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. - avx512f :: Bool, -- Enable AVX-512 instructions. - avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. - fma :: Bool, -- ^ Enable FMA instructions. - - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - - -- Constants used to control the amount of optimization done. - - -- | Max size, in bytes, of inline array allocations. - maxInlineAllocSize :: Int, - - -- | Only inline memcpy if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemcpyInsns :: Int, - - -- | Only inline memset if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemsetInsns :: Int, - - -- | Reverse the order of error messages in GHC/GHCi - reverseErrors :: Bool, - - -- | Limit the maximum number of errors to show - maxErrors :: Maybe Int, - - -- | Unique supply configuration for testing build determinism - initialUnique :: Word, - uniqueIncrement :: Int, - -- 'Int' because it can be used to test uniques in decreasing order. - - -- | Temporary: CFG Edge weights for fast iterations - cfgWeights :: Weights -} {- Note [RHS Floating] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -767,43 +367,6 @@ data DynFlags = DynFlags { allows for experimentation. -} -class HasDynFlags m where - getDynFlags :: m DynFlags - -{- It would be desirable to have the more generalised - - instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where - getDynFlags = lift getDynFlags - -instance definition. However, that definition would overlap with the -`HasDynFlags (GhcT m)` instance. Instead we define instances for a -couple of common Monad transformers explicitly. -} - -instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where - getDynFlags = lift getDynFlags - -class ContainsDynFlags t where - extractDynFlags :: t -> DynFlags - --- | The type for the -jN argument, specifying that -j on its own represents --- using the number of machine processors. -data ParMakeCount - -- | Use this many processors (@-j@ flag). - = ParMakeThisMany Int - -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). - | ParMakeNumProcessors - -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). - | ParMakeSemaphore FilePath - ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -820,22 +383,6 @@ settings dflags = Settings , sRawSettings = rawSettings dflags } -programName :: DynFlags -> String -programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags -projectVersion :: DynFlags -> String -projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) -ghcUsagePath :: DynFlags -> FilePath -ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags -ghciUsagePath :: DynFlags -> FilePath -ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags -toolDir :: DynFlags -> Maybe FilePath -toolDir dflags = fileSettings_toolDir $ fileSettings dflags -topDir :: DynFlags -> FilePath -topDir dflags = fileSettings_topDir $ fileSettings dflags -extraGccViaCFlags :: DynFlags -> [String] -extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags -globalPackageDatabasePath :: DynFlags -> FilePath -globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags pgm_L :: DynFlags -> String pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags pgm_P :: DynFlags -> (String,[Option]) @@ -909,430 +456,8 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags opt_i :: DynFlags -> [String] opt_i dflags= toolSettings_opt_i $ toolSettings dflags --- | The directory for this version of ghc in the user's app directory --- The appdir used to be in ~/.ghc but to respect the XDG specification --- we want to move it under $XDG_DATA_HOME/ --- However, old tooling (like cabal) might still write package environments --- to the old directory, so we prefer that if a subdirectory of ~/.ghc --- with the correct target and GHC version suffix exists. --- --- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that --- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR --- --- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version -versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath -versionedAppDir appname platform = do - -- Make sure we handle the case the HOME isn't set (see #11678) - -- We need to fallback to the old scheme if the subdirectory exists. - msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) - [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ - , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ - ] - where - checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case - True -> pure dir - False -> MaybeT (pure Nothing) - -versionedFilePath :: ArchOS -> FilePath -versionedFilePath platform = uniqueSubdir platform - --- | The 'GhcMode' tells us whether we're doing multi-module --- compilation (controlled via the "GHC" API) or one-shot --- (single-module) compilation. This makes a difference primarily to --- the "GHC.Unit.Finder": in one-shot mode we look for interface files for --- imported modules, but in multi-module mode we look for source files --- in order to check whether they need to be recompiled. -data GhcMode - = CompManager -- ^ @\-\-make@, GHCi, etc. - | OneShot -- ^ @ghc -c Foo.hs@ - | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this - deriving Eq - -instance Outputable GhcMode where - ppr CompManager = text "CompManager" - ppr OneShot = text "OneShot" - ppr MkDepend = text "MkDepend" - -isOneShot :: GhcMode -> Bool -isOneShot OneShot = True -isOneShot _other = False - --- | What to do in the link step, if there is one. -data GhcLink - = NoLink -- ^ Don't link at all - | LinkBinary -- ^ Link object code into a binary - | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both - -- bytecode and object code). - | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) - | LinkStaticLib -- ^ Link objects into a static lib - | LinkMergedObj -- ^ Link objects into a merged "GHCi object" - deriving (Eq, Show) - -isNoLink :: GhcLink -> Bool -isNoLink NoLink = True -isNoLink _ = False - --- | We accept flags which make packages visible, but how they select --- the package varies; this data type reflects what selection criterion --- is used. -data PackageArg = - PackageArg String -- ^ @-package@, by 'PackageName' - | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' - deriving (Eq, Show) - -instance Outputable PackageArg where - ppr (PackageArg pn) = text "package" <+> text pn - ppr (UnitIdArg uid) = text "unit" <+> ppr uid - --- | Represents the renaming that may be associated with an exposed --- package, e.g. the @rns@ part of @-package "foo (rns)"@. --- --- Here are some example parsings of the package flags (where --- a string literal is punned to be a 'ModuleName': --- --- * @-package foo@ is @ModRenaming True []@ --- * @-package foo ()@ is @ModRenaming False []@ --- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ --- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ --- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ -data ModRenaming = ModRenaming { - modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? - modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope - -- under name @n at . - } deriving (Eq) -instance Outputable ModRenaming where - ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) - --- | Flags for manipulating the set of non-broken packages. -newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ - deriving (Eq) - --- | Flags for manipulating package trust. -data TrustFlag - = TrustPackage String -- ^ @-trust@ - | DistrustPackage String -- ^ @-distrust@ - deriving (Eq) - --- | Flags for manipulating packages visibility. -data PackageFlag - = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ - | HidePackage String -- ^ @-hide-package@ - deriving (Eq) -- NB: equality instance is used by packageFlagsChanged - -data PackageDBFlag - = PackageDB PkgDbRef - | NoUserPackageDB - | NoGlobalPackageDB - | ClearPackageDBs - deriving (Eq) - -packageFlagsChanged :: DynFlags -> DynFlags -> Bool -packageFlagsChanged idflags1 idflags0 = - packageFlags idflags1 /= packageFlags idflags0 || - ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || - pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || - trustFlags idflags1 /= trustFlags idflags0 || - packageDBFlags idflags1 /= packageDBFlags idflags0 || - packageGFlags idflags1 /= packageGFlags idflags0 - where - packageGFlags dflags = map (`gopt` dflags) - [ Opt_HideAllPackages - , Opt_HideAllPluginPackages - , Opt_AutoLinkPackages ] - -instance Outputable PackageFlag where - ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) - ppr (HidePackage str) = text "-hide-package" <+> text str - -data DynLibLoader - = Deployable - | SystemDependent - deriving Eq - -data RtsOptsEnabled - = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly - | RtsOptsAll - deriving (Show) - --- | Are we building with @-fPIE@ or @-fPIC@ enabled? -positionIndependent :: DynFlags -> Bool -positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags - --- Note [-dynamic-too business] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- With -dynamic-too flag, we try to build both the non-dynamic and dynamic --- objects in a single run of the compiler: the pipeline is the same down to --- Core optimisation, then the backend (from Core to object code) is executed --- twice. --- --- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic --- and dynamic loaded interfaces (#9176). --- --- To make matters worse, we automatically enable -dynamic-too when some modules --- need Template-Haskell and GHC is dynamically linked (cf --- GHC.Driver.Pipeline.compileOne'). --- --- We used to try and fall back from a dynamic-too failure but this feature --- didn't work as expected (#20446) so it was removed to simplify the --- implementation and not obscure latent bugs. - -data DynamicTooState - = DT_Dont -- ^ Don't try to build dynamic objects too - | DT_OK -- ^ Will still try to generate dynamic objects - | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) - deriving (Eq,Show,Ord) - -dynamicTooState :: DynFlags -> DynamicTooState -dynamicTooState dflags - | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont - | dynamicNow dflags = DT_Dyn - | otherwise = DT_OK - -setDynamicNow :: DynFlags -> DynFlags -setDynamicNow dflags0 = - dflags0 - { dynamicNow = True - } - ----------------------------------------------------------------------------- --- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value -initDynFlags :: DynFlags -> IO DynFlags -initDynFlags dflags = do - let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing - canUseUnicode <- do let enc = localeEncoding - str = "‘’" - (withCString enc str $ \cstr -> - do str' <- peekCString enc cstr - return (str == str')) - `catchIOError` \_ -> return False - ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" - let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode - maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" - maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" - let adjustCols (Just env) = Col.parseScheme env - adjustCols Nothing = id - let (useColor', colScheme') = - (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) - (useColor dflags, colScheme dflags) - tmp_dir <- normalise <$> getTemporaryDirectory - return dflags{ - useUnicode = useUnicode', - useColor = useColor', - canUseColor = stderrSupportsAnsiColors, - colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, - tmpDir = TempDir tmp_dir - } - --- | The normal 'DynFlags'. Note that they are not suitable for use in this form --- and must be fully initialized by 'GHC.runGhc' first. -defaultDynFlags :: Settings -> DynFlags -defaultDynFlags mySettings = --- See Note [Updating flag description in the User's Guide] - DynFlags { - ghcMode = CompManager, - ghcLink = LinkBinary, - backend = platformDefaultBackend (sTargetPlatform mySettings), - verbosity = 0, - debugLevel = 0, - simplPhases = 2, - maxSimplIterations = 4, - ruleCheck = Nothing, - binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) - maxRelevantBinds = Just 6, - maxValidHoleFits = Just 6, - maxRefHoleFits = Just 6, - refLevelHoleFits = Nothing, - maxUncoveredPatterns = 4, - maxPmCheckModels = 30, - simplTickFactor = 100, - dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple - specConstrThreshold = Just 2000, - specConstrCount = Just 3, - specConstrRecursive = 3, - liberateCaseThreshold = Just 2000, - floatLamArgs = Just 0, -- Default: float only if no fvs - liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsKnown = False, -- Default: don't turn known calls into unknown ones - cmmProcAlignment = Nothing, - - historySize = 20, - strictnessBefore = [], - - parMakeCount = Nothing, - - enableTimeStats = False, - ghcHeapSize = Nothing, - - importPaths = ["."], - mainModuleNameIs = mAIN_NAME, - mainFunIs = Nothing, - reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, - solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, - givensFuel = mAX_GIVENS_FUEL, - wantedsFuel = mAX_WANTEDS_FUEL, - qcsFuel = mAX_QC_FUEL, - - homeUnitId_ = mainUnitId, - homeUnitInstanceOf_ = Nothing, - homeUnitInstantiations_ = [], - - workingDirectory = Nothing, - thisPackageName = Nothing, - hiddenModules = Set.empty, - reexportedModules = Set.empty, - - objectDir = Nothing, - dylibInstallName = Nothing, - hiDir = Nothing, - hieDir = Nothing, - stubDir = Nothing, - dumpDir = Nothing, - - objectSuf_ = phaseInputExt StopLn, - hcSuf = phaseInputExt HCc, - hiSuf_ = "hi", - hieSuf = "hie", - - dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, - dynHiSuf_ = "dyn_hi", - dynamicNow = False, - - pluginModNames = [], - pluginModNameOpts = [], - frontendPluginOpts = [], - - externalPluginSpecs = [], - - outputFile_ = Nothing, - dynOutputFile_ = Nothing, - outputHi = Nothing, - dynOutputHi = Nothing, - dynLibLoader = SystemDependent, - dumpPrefix = "non-module.", - dumpPrefixForce = Nothing, - ldInputs = [], - includePaths = IncludeSpecs [] [] [], - libraryPaths = [], - frameworkPaths = [], - cmdlineFrameworks = [], - rtsOpts = Nothing, - rtsOptsEnabled = RtsOptsSafeOnly, - rtsOptsSuggestions = True, - - hpcDir = ".hpc", - - packageDBFlags = [], - packageFlags = [], - pluginPackageFlags = [], - ignorePackageFlags = [], - trustFlags = [], - packageEnv = Nothing, - targetWays_ = Set.empty, - splitInfo = Nothing, - - ghcNameVersion = sGhcNameVersion mySettings, - fileSettings = sFileSettings mySettings, - toolSettings = sToolSettings mySettings, - targetPlatform = sTargetPlatform mySettings, - platformMisc = sPlatformMisc mySettings, - rawSettings = sRawSettings mySettings, - - tmpDir = panic "defaultDynFlags: uninitialized tmpDir", - - llvmOptLevel = 0, - - -- ghc -M values - depMakefile = "Makefile", - depIncludePkgDeps = False, - depIncludeCppDeps = False, - depExcludeMods = [], - depSuffixes = [], - -- end of ghc -M values - ghcVersionFile = Nothing, - haddockOptions = Nothing, - dumpFlags = EnumSet.empty, - generalFlags = EnumSet.fromList (defaultFlags mySettings), - warningFlags = EnumSet.fromList standardWarnings, - fatalWarningFlags = EnumSet.empty, - customWarningCategories = completeWarningCategorySet, - fatalCustomWarningCategories = emptyWarningCategorySet, - ghciScripts = [], - language = Nothing, - safeHaskell = Sf_None, - safeInfer = True, - safeInferred = True, - thOnLoc = noSrcSpan, - newDerivOnLoc = noSrcSpan, - deriveViaOnLoc = noSrcSpan, - overlapInstLoc = noSrcSpan, - incoherentOnLoc = noSrcSpan, - pkgTrustOnLoc = noSrcSpan, - warnSafeOnLoc = noSrcSpan, - warnUnsafeOnLoc = noSrcSpan, - trustworthyOnLoc = noSrcSpan, - extensions = [], - extensionFlags = flattenExtensionFlags Nothing [], - - unfoldingOpts = defaultUnfoldingOpts, - maxWorkerArgs = 10, - - ghciHistSize = 50, -- keep a log of length 50 by default - - flushOut = defaultFlushOut, - pprUserLength = 5, - pprCols = 100, - useUnicode = False, - useColor = Auto, - canUseColor = False, - colScheme = Col.defaultScheme, - profAuto = NoProfAuto, - callerCcFilters = [], - interactivePrint = Nothing, - sseVersion = Nothing, - bmiVersion = Nothing, - avx = False, - avx2 = False, - avx512cd = False, - avx512er = False, - avx512f = False, - avx512pf = False, - fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", - - maxInlineAllocSize = 128, - maxInlineMemcpyInsns = 32, - maxInlineMemsetInsns = 32, - - initialUnique = 0, - uniqueIncrement = 1, - - reverseErrors = False, - maxErrors = Nothing, - cfgWeights = defaultWeights - } - -type FatalMessager = String -> IO () - -defaultFatalMessager :: FatalMessager -defaultFatalMessager = hPutStrLn stderr - - -newtype FlushOut = FlushOut (IO ()) - -defaultFlushOut :: FlushOut -defaultFlushOut = FlushOut $ hFlush stdout - {- Note [Verbosity levels] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -1344,283 +469,6 @@ Note [Verbosity levels] 5 | "ghc -v -ddump-all" -} -data OnOff a = On a - | Off a - deriving (Eq, Show) - -instance Outputable a => Outputable (OnOff a) where - ppr (On x) = text "On" <+> ppr x - ppr (Off x) = text "Off" <+> ppr x - --- OnOffs accumulate in reverse order, so we use foldr in order to --- process them in the right order -flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension -flattenExtensionFlags ml = foldr f defaultExtensionFlags - where f (On f) flags = EnumSet.insert f flags - f (Off f) flags = EnumSet.delete f flags - defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) - --- | The language extensions implied by the various language variants. --- When updating this be sure to update the flag documentation in --- @docs/users_guide/exts at . -languageExtensions :: Maybe Language -> [LangExt.Extension] - --- Nothing: the default case -languageExtensions Nothing = languageExtensions (Just GHC2021) - -languageExtensions (Just Haskell98) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.NPlusKPatterns, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.FieldSelectors, - LangExt.NondecreasingIndentation, - -- strictly speaking non-standard, but we always had this - -- on implicitly before the option was added in 7.1, and - -- turning it off breaks code, so we're keeping it on for - -- backwards compatibility. Cabal uses -XHaskell98 by - -- default unless you specify another language. - LangExt.DeepSubsumption - -- Non-standard but enabled for backwards compatability (see GHC proposal #511) - ] - -languageExtensions (Just Haskell2010) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - LangExt.DeepSubsumption ] - -languageExtensions (Just GHC2021) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.MonomorphismRestriction, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - -- Now the new extensions (not in Haskell2010) - LangExt.BangPatterns, - LangExt.BinaryLiterals, - LangExt.ConstrainedClassMethods, - LangExt.ConstraintKinds, - LangExt.DeriveDataTypeable, - LangExt.DeriveFoldable, - LangExt.DeriveFunctor, - LangExt.DeriveGeneric, - LangExt.DeriveLift, - LangExt.DeriveTraversable, - LangExt.EmptyCase, - LangExt.EmptyDataDeriving, - LangExt.ExistentialQuantification, - LangExt.ExplicitForAll, - LangExt.FlexibleContexts, - LangExt.FlexibleInstances, - LangExt.GADTSyntax, - LangExt.GeneralizedNewtypeDeriving, - LangExt.HexFloatLiterals, - LangExt.ImportQualifiedPost, - LangExt.InstanceSigs, - LangExt.KindSignatures, - LangExt.MultiParamTypeClasses, - LangExt.NamedFieldPuns, - LangExt.NamedWildCards, - LangExt.NumericUnderscores, - LangExt.PolyKinds, - LangExt.PostfixOperators, - LangExt.RankNTypes, - LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" - LangExt.StandaloneDeriving, - LangExt.StandaloneKindSignatures, - LangExt.TupleSections, - LangExt.TypeApplications, - LangExt.TypeOperators, - LangExt.TypeSynonymInstances] - -hasPprDebug :: DynFlags -> Bool -hasPprDebug = dopt Opt_D_ppr_debug - -hasNoDebugOutput :: DynFlags -> Bool -hasNoDebugOutput = dopt Opt_D_no_debug_output - -hasNoStateHack :: DynFlags -> Bool -hasNoStateHack = gopt Opt_G_NoStateHack - -hasNoOptCoercion :: DynFlags -> Bool -hasNoOptCoercion = gopt Opt_G_NoOptCoercion - - --- | Test whether a 'DumpFlag' is set -dopt :: DumpFlag -> DynFlags -> Bool -dopt = getDumpFlagFrom verbosity dumpFlags - --- | Set a 'DumpFlag' -dopt_set :: DynFlags -> DumpFlag -> DynFlags -dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } - --- | Unset a 'DumpFlag' -dopt_unset :: DynFlags -> DumpFlag -> DynFlags -dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } - --- | Test whether a 'GeneralFlag' is set --- --- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) --- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables --- Opt_SplitSections. --- -gopt :: GeneralFlag -> DynFlags -> Bool -gopt Opt_PIC dflags - | dynamicNow dflags = True -gopt Opt_ExternalDynamicRefs dflags - | dynamicNow dflags = True -gopt Opt_SplitSections dflags - | dynamicNow dflags = False -gopt f dflags = f `EnumSet.member` generalFlags dflags - --- | Set a 'GeneralFlag' -gopt_set :: DynFlags -> GeneralFlag -> DynFlags -gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } - --- | Unset a 'GeneralFlag' -gopt_unset :: DynFlags -> GeneralFlag -> DynFlags -gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } - --- | Test whether a 'WarningFlag' is set -wopt :: WarningFlag -> DynFlags -> Bool -wopt f dflags = f `EnumSet.member` warningFlags dflags - --- | Set a 'WarningFlag' -wopt_set :: DynFlags -> WarningFlag -> DynFlags -wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } - --- | Unset a 'WarningFlag' -wopt_unset :: DynFlags -> WarningFlag -> DynFlags -wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } - --- | Test whether a 'WarningFlag' is set as fatal -wopt_fatal :: WarningFlag -> DynFlags -> Bool -wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags - --- | Mark a 'WarningFlag' as fatal (do not set the flag) -wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_set_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } - --- | Mark a 'WarningFlag' as not fatal -wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_unset_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } - - --- | Enable all custom warning categories. -wopt_set_all_custom :: DynFlags -> DynFlags -wopt_set_all_custom dfs - = dfs{ customWarningCategories = completeWarningCategorySet } - --- | Disable all custom warning categories. -wopt_unset_all_custom :: DynFlags -> DynFlags -wopt_unset_all_custom dfs - = dfs{ customWarningCategories = emptyWarningCategorySet } - --- | Mark all custom warning categories as fatal (do not set the flags). -wopt_set_all_fatal_custom :: DynFlags -> DynFlags -wopt_set_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = completeWarningCategorySet } - --- | Mark all custom warning categories as non-fatal. -wopt_unset_all_fatal_custom :: DynFlags -> DynFlags -wopt_unset_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } - --- | Set a custom 'WarningCategory' -wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } - --- | Unset a custom 'WarningCategory' -wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as fatal (do not set the flag) -wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as not fatal -wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Are there any custom warning categories enabled? -wopt_any_custom :: DynFlags -> Bool -wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) - - --- | Test whether a 'LangExt.Extension' is set -xopt :: LangExt.Extension -> DynFlags -> Bool -xopt f dflags = f `EnumSet.member` extensionFlags dflags - --- | Set a 'LangExt.Extension' -xopt_set :: DynFlags -> LangExt.Extension -> DynFlags -xopt_set dfs f - = let onoffs = On f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Unset a 'LangExt.Extension' -xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags -xopt_unset dfs f - = let onoffs = Off f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Set or unset a 'LangExt.Extension', unless it has been explicitly --- set or unset before. -xopt_set_unlessExplSpec - :: LangExt.Extension - -> (DynFlags -> LangExt.Extension -> DynFlags) - -> DynFlags -> DynFlags -xopt_set_unlessExplSpec ext setUnset dflags = - let referedExts = stripOnOff <$> extensions dflags - stripOnOff (On x) = x - stripOnOff (Off x) = x - in - if ext `elem` referedExts then dflags else setUnset dflags ext - -xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields -xopt_DuplicateRecordFields dfs - | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields - | otherwise = FieldLabel.NoDuplicateRecordFields - -xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors -xopt_FieldSelectors dfs - | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors - | otherwise = FieldLabel.NoFieldSelectors - -lang_set :: DynFlags -> Maybe Language -> DynFlags -lang_set dflags lang = - dflags { - language = lang, - extensionFlags = flattenExtensionFlags lang (extensions dflags) - } - -- | Set the Haskell language standard to use setLanguage :: Language -> DynP () setLanguage l = upd (`lang_set` Just l) @@ -3119,11 +1967,6 @@ flagsForCompletion isInteractive modeFilter OnlyGhc = not isInteractive modeFilter HiddenFlag = False -type TurnOnFlag = Bool -- True <=> we are turning the flag on - -- False <=> we are turning the flag off -turnOn :: TurnOnFlag; turnOn = True -turnOff :: TurnOnFlag; turnOff = False - data FlagSpec flag = FlagSpec { flagSpecName :: String -- ^ Flag in string form @@ -3874,62 +2717,6 @@ xFlagsDeps = [ flagSpec "ViewPatterns" LangExt.ViewPatterns ] -defaultFlags :: Settings -> [GeneralFlag] -defaultFlags settings --- See Note [Updating flag description in the User's Guide] - = [ Opt_AutoLinkPackages, - Opt_DiagnosticsShowCaret, - Opt_EmbedManifest, - Opt_FamAppCache, - Opt_GenManifest, - Opt_GhciHistory, - Opt_GhciSandbox, - Opt_HelpfulErrors, - Opt_KeepHiFiles, - Opt_KeepOFiles, - Opt_OmitYields, - Opt_PrintBindContents, - Opt_ProfCountEntries, - Opt_SharedImplib, - Opt_SimplPreInlining, - Opt_VersionMacros, - Opt_RPath, - Opt_DumpWithWays, - Opt_CompactUnwind, - Opt_ShowErrorContext, - Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter - ] - - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - - -- Default floating flags (see Note [RHS Floating]) - ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] - - - ++ default_PIC platform - - ++ validHoleFitDefaults - - - where platform = sTargetPlatform settings - --- | These are the default settings for the display and sorting of valid hole --- fits in typed-hole error messages. See Note [Valid hole fits include ...] - -- in the "GHC.Tc.Errors.Hole" module. -validHoleFitDefaults :: [GeneralFlag] -validHoleFitDefaults - = [ Opt_ShowTypeAppOfHoleFits - , Opt_ShowTypeOfHoleFits - , Opt_ShowProvOfHoleFits - , Opt_ShowMatchesOfHoleFits - , Opt_ShowValidHoleFits - , Opt_SortValidHoleFits - , Opt_SortBySizeHoleFits - , Opt_ShowHoleConstraints ] - - validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] validHoleFitsImpliedGFlags = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) @@ -3938,32 +2725,6 @@ validHoleFitsImpliedGFlags , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ] -default_PIC :: Platform -> [GeneralFlag] -default_PIC platform = - case (platformOS platform, platformArch platform) of - -- Darwin always requires PIC. Especially on more recent macOS releases - -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses - -- while we could work around this on x86_64 (like WINE does), we won't be - -- able on aarch64, where this is enforced. - (OSDarwin, ArchX86_64) -> [Opt_PIC] - -- For AArch64, we need to always have PIC enabled. The relocation model - -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't - -- control much how far apart symbols are in memory for our in-memory static - -- linker; and thus need to ensure we get sufficiently capable relocations. - -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top - -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to - -- be built with -fPIC. - (OSDarwin, ArchAArch64) -> [Opt_PIC] - (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in - -- OpenBSD since 5.3 release - -- (1 May 2013) we need to - -- always generate PIC. See - -- #10597 for more - -- information. - _ -> [] - -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] @@ -4053,85 +2814,6 @@ impliedXFlags , (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures) ] --- Note [When is StarIsType enabled] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- The StarIsType extension determines whether to treat '*' as a regular type --- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType --- programs expect '*' to be synonymous with 'Type', so by default StarIsType is --- enabled. --- --- Programs that use TypeOperators might expect to repurpose '*' for --- multiplication or another binary operation, but making TypeOperators imply --- NoStarIsType caused too much breakage on Hackage. --- - --- Note [Documenting optimisation flags] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- If you change the list of flags enabled for particular optimisation levels --- please remember to update the User's Guide. The relevant file is: --- --- docs/users_guide/using-optimisation.rst --- --- Make sure to note whether a flag is implied by -O0, -O or -O2. - -optLevelFlags :: [([Int], GeneralFlag)] --- Default settings of flags, before any command-line overrides -optLevelFlags -- see Note [Documenting optimisation flags] - = [ ([0,1,2], Opt_DoLambdaEtaExpansion) - , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] - , ([0,1,2], Opt_LlvmTBAA) - , ([0,1,2], Opt_ProfManualCcs ) - , ([2], Opt_DictsStrict) - - , ([0], Opt_IgnoreInterfacePragmas) - , ([0], Opt_OmitInterfacePragmas) - - , ([1,2], Opt_CoreConstantFolding) - - , ([1,2], Opt_CallArity) - , ([1,2], Opt_Exitification) - , ([1,2], Opt_CaseMerge) - , ([1,2], Opt_CaseFolding) - , ([1,2], Opt_CmmElimCommonBlocks) - , ([2], Opt_AsmShortcutting) - , ([1,2], Opt_CmmSink) - , ([1,2], Opt_CmmStaticPred) - , ([1,2], Opt_CSE) - , ([1,2], Opt_StgCSE) - , ([2], Opt_StgLiftLams) - , ([1,2], Opt_CmmControlFlow) - - , ([1,2], Opt_EnableRewriteRules) - -- Off for -O0. Otherwise we desugar list literals - -- to 'build' but don't run the simplifier passes that - -- would rewrite them back to cons cells! This seems - -- silly, and matters for the GHCi debugger. - - , ([1,2], Opt_FloatIn) - , ([1,2], Opt_FullLaziness) - , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_Loopification) - , ([1,2], Opt_CfgBlocklayout) -- Experimental - - , ([1,2], Opt_Specialise) - , ([1,2], Opt_CrossModuleSpecialise) - , ([1,2], Opt_InlineGenerics) - , ([1,2], Opt_Strictness) - , ([1,2], Opt_UnboxSmallStrictFields) - , ([1,2], Opt_CprAnal) - , ([1,2], Opt_WorkerWrapper) - , ([1,2], Opt_SolveConstantDicts) - , ([1,2], Opt_NumConstantFolding) - - , ([2], Opt_LiberateCase) - , ([2], Opt_SpecConstr) - , ([2], Opt_FastPAPCalls) --- , ([2], Opt_RegsGraph) --- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) --- Static Argument Transformation needs investigation. See #9374 - ] -- | Things you get with `-dlint`. @@ -4439,12 +3121,6 @@ setDebugLevel mb_n = | n > 2 = setGeneralFlag' Opt_ExposeInternalSymbols | otherwise = id -data PkgDbRef - = GlobalPkgDb - | UserPkgDb - | PkgDbPath FilePath - deriving Eq - addPkgDbRef :: PkgDbRef -> DynP () addPkgDbRef p = upd $ \s -> s { packageDBFlags = PackageDB p : packageDBFlags s } @@ -5070,29 +3746,6 @@ needSourceNotes dflags = debugLevel dflags > 0 -- ----------------------------------------------------------------------------- -- Linker/compiler information --- LinkerInfo contains any extra options needed by the system linker. -data LinkerInfo - = GnuLD [Option] - | Mold [Option] - | GnuGold [Option] - | LlvmLLD [Option] - | DarwinLD [Option] - | SolarisLD [Option] - | AixLD [Option] - | UnknownLD - deriving Eq - --- CompilerInfo tells us which C compiler we're using -data CompilerInfo - = GCC - | Clang - | AppleClang - | AppleClang51 - | Emscripten - | UnknownCC - deriving Eq - - -- | Should we use `-XLinker -rpath` when linking or not? -- See Note [-fno-use-rpaths] useXLinkerRPath :: DynFlags -> OS -> Bool @@ -5144,60 +3797,6 @@ decodeSize str foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO () foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO () - --- | Initialize the pretty-printing options -initSDocContext :: DynFlags -> PprStyle -> SDocContext -initSDocContext dflags style = SDC - { sdocStyle = style - , sdocColScheme = colScheme dflags - , sdocLastColour = Col.colReset - , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) - , sdocDefaultDepth = pprUserLength dflags - , sdocLineLength = pprCols dflags - , sdocCanUseUnicode = useUnicode dflags - , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags - , sdocPprDebug = dopt Opt_D_ppr_debug dflags - , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags - , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags - , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags - , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags - , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags - , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags - , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags - , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags - , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags - , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags - , sdocSuppressTicks = gopt Opt_SuppressTicks dflags - , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags - , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags - , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags - , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags - , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags - , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags - , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags - , sdocSuppressUniques = gopt Opt_SuppressUniques dflags - , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags - , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags - , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags - , sdocErrorSpans = gopt Opt_ErrorSpans dflags - , sdocStarIsType = xopt LangExt.StarIsType dflags - , sdocLinearTypes = xopt LangExt.LinearTypes dflags - , sdocListTuplePuns = True - , sdocPrintTypeAbbreviations = True - , sdocUnitIdForUser = ftext - } - --- | Initialize the pretty-printing options using the default user style -initDefaultSDocContext :: DynFlags -> SDocContext -initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle - -initPromotionTickContext :: DynFlags -> PromotionTickContext -initPromotionTickContext dflags = - PromTickCtx { - ptcListTuplePuns = True, - ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags - } - outputFile :: DynFlags -> Maybe String outputFile dflags | dynamicNow dflags = dynOutputFile_ dflags @@ -5208,11 +3807,6 @@ objectSuf dflags | dynamicNow dflags = dynObjectSuf_ dflags | otherwise = objectSuf_ dflags -ways :: DynFlags -> Ways -ways dflags - | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) - | otherwise = targetWays_ dflags - -- | Pretty-print the difference between 2 DynFlags. -- -- For now only their general flags but it could be extended. ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -82,7 +82,7 @@ import GHC.Types.SrcLoc import GHC.Data.Bag -- collect ev vars from pats import GHC.Data.Maybe import GHC.Types.Name (Name, dataName) -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import qualified GHC.LanguageExtensions as LangExt import Data.Data ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude import GHC.Core (CoreRule, CoreExpr, RuleName) import GHC.Core.DataCon import GHC.Core.Type -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import GHC.Driver.Flags (WarningFlag) import GHC.Hs import GHC.HsToCore.Pmc.Solver.Types ===================================== compiler/GHC/Runtime/Context.hs ===================================== @@ -19,7 +19,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Plugins import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume ) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -119,7 +119,7 @@ import GHC.Core import GHC.Core.TyCo.Ppr import GHC.Utils.FV import GHC.Types.Var.Set -import GHC.Driver.Session (DynFlags(reductionDepth)) +import GHC.Driver.DynFlags (DynFlags(reductionDepth)) import GHC.Builtin.Names import GHC.Types.Basic import GHC.Types.Unique.Set ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -232,7 +232,7 @@ import {-# SOURCE #-} GHC.Tc.Types.Origin , FixedRuntimeRepOrigin, FixedRuntimeRepContext ) -- others: -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.Name as Name -- We use this to make dictionaries for type literals. -- Perhaps there's a better way to do this? ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -78,7 +78,7 @@ import GHC.Utils.Panic.Plain import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import GHC.Utils.Misc (HasDebugCallStack) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) import GHC.Unit.Module.ModIface ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -51,7 +51,7 @@ import GHC.Data.Maybe import GHC.Data.Graph.Directed import GHC.Driver.Backend -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.SourceFile ( hscSourceString ) ===================================== compiler/GHC/Unit/Module/ModSummary.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.Types import GHC.Unit.Module ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -75,7 +75,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Platform import GHC.Platform.Ways ===================================== compiler/ghc.cabal.in ===================================== @@ -434,6 +434,7 @@ Library GHC.Driver.Config.StgToCmm GHC.Driver.Config.Tidy GHC.Driver.Config.StgToJS + GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -106,6 +106,7 @@ GHC.Driver.CmdLine GHC.Driver.Config.Core.Lint GHC.Driver.Config.Diagnostic GHC.Driver.Config.Logger +GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -107,6 +107,7 @@ GHC.Driver.CmdLine GHC.Driver.Config.Core.Lint GHC.Driver.Config.Diagnostic GHC.Driver.Config.Logger +GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -1,21 +1,21 @@ ref compiler/GHC/Core/Coercion/Axiom.hs:463:2: Note [RoughMap and rm_empty] ref compiler/GHC/Core/Opt/OccurAnal.hs:983:7: Note [Loop breaking] ref compiler/GHC/Core/Opt/SetLevels.hs:1574:30: Note [Top level scope] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2825:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4009:8: Note [Lambda-bound unfoldings] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2826:13: Note [Case binder next] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4018:8: Note [Lambda-bound unfoldings] ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] -ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] -ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Core/Opt/Specialise.hs:1765:29: Note [Arity decrease] +ref compiler/GHC/Core/TyCo/Rep.hs:1565:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Driver/DynFlags.hs:1245:49: Note [Eta-reduction in -O0] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] -ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice] -ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices] +ref compiler/GHC/Hs/Expr.hs:1738:87: Note [Lifecycle of a splice] +ref compiler/GHC/Hs/Expr.hs:1774:7: Note [Pending Splices] ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constraints] ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations] +ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -32,12 +32,12 @@ ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested sp ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] +ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] -ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics] -ref compiler/GHC/Types/Demand.hs:306:25: Note [Preserving Boxity of results is rarely a win] +ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] +ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:410:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:200:31: Note [fun_id in Match] @@ -46,7 +46,7 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:272:10: Note [WayFlags] +ref testsuite/config/ghc:276:10: Note [WayFlags] ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ae8450e0cab396acc40a687285387f85e222c70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ae8450e0cab396acc40a687285387f85e222c70 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 10:03:13 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Mon, 15 May 2023 06:03:13 -0400 Subject: [Git][ghc/ghc][wip/compact-sourcetext] 4 commits: compiler: Use compact representation for SourceText Message-ID: <6462036196fe4_171ad965352c5c72682e@gitlab.mail> Zubin pushed to branch wip/compact-sourcetext at Glasgow Haskell Compiler / GHC Commits: 1eefcb73 by Zubin Duggal at 2023-05-15T15:19:09+05:30 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - c6d55776 by Zubin Duggal at 2023-05-15T15:25:14+05:30 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 745ed77e by Zubin Duggal at 2023-05-15T15:28:22+05:30 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - d9394fd9 by Zubin Duggal at 2023-05-15T15:29:42+05:30 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/IPE.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Types/Tickish.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44027418ebd05b1311933f3f066a642ab5b5f06c...d9394fd9a72d4c85da6c53444fc5f99189e7ad8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44027418ebd05b1311933f3f066a642ab5b5f06c...d9394fd9a72d4c85da6c53444fc5f99189e7ad8a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 10:36:19 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 15 May 2023 06:36:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/restore-lcl-env Message-ID: <64620b23db79f_171ad96a04f7807360eb@gitlab.mail> Matthew Pickering pushed new branch wip/restore-lcl-env at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/restore-lcl-env You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 10:46:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 06:46:53 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever Message-ID: <64620d9dc0d3e_171ad96a04f7807401c7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - eb081cb2 by sheaf at 2023-05-15T06:46:36-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - a6b1fe86 by M Farkas-Dyck at 2023-05-15T06:46:44-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 17 changed files: - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/Type.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Types/Id/Make.hs - testsuite/tests/hsc2hs/Makefile - testsuite/tests/numeric/should_run/Makefile - testsuite/tests/numeric/should_run/T7014.primops - testsuite/tests/simplCore/should_compile/Makefile - + testsuite/tests/simplCore/should_compile/T23307.hs - + testsuite/tests/simplCore/should_compile/T23307.stderr - + testsuite/tests/simplCore/should_compile/T23307a.hs - + testsuite/tests/simplCore/should_compile/T23307a.stderr - + testsuite/tests/simplCore/should_compile/T23307b.hs - + testsuite/tests/simplCore/should_compile/T23307c.hs - + testsuite/tests/simplCore/should_compile/T23307c.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs-boot ===================================== @@ -36,6 +36,8 @@ mkSubCo :: HasDebugCallStack => Coercion -> Coercion mkProofIrrelCo :: Role -> Coercion -> Coercion -> Coercion -> Coercion mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion +funRole :: Role -> FunSel -> Role + isGReflCo :: Coercion -> Bool isReflCo :: Coercion -> Bool isReflexiveCo :: Coercion -> Bool ===================================== compiler/GHC/Core/TyCo/Rep.hs-boot ===================================== @@ -8,6 +8,7 @@ import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) data Type data Coercion +data FunSel data CoSel data UnivCoProvenance data TyLit ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -274,7 +274,7 @@ import {-# SOURCE #-} GHC.Core.Coercion , mkTyConAppCo, mkAppCo , mkForAllCo, mkFunCo2, mkAxiomInstCo, mkUnivCo , mkSymCo, mkTransCo, mkSelCo, mkLRCo, mkInstCo - , mkKindCo, mkSubCo, mkFunCo + , mkKindCo, mkSubCo, mkFunCo, funRole , decomposePiCos, coercionKind , coercionRKind, coercionType , isReflexiveCo, seqCo @@ -1331,9 +1331,12 @@ tyConAppFunCo_maybe :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Maybe Coercion -- ^ Return Just if this TyConAppCo should be represented as a FunCo tyConAppFunCo_maybe r tc cos - | Just (af, mult, arg, res) <- ty_con_app_fun_maybe (mkReflCo r manyDataConTy) tc cos - = Just (mkFunCo r af mult arg res) - | otherwise = Nothing + | Just (af, mult, arg, res) <- ty_con_app_fun_maybe mult_refl tc cos + = Just (mkFunCo r af mult arg res) + | otherwise + = Nothing + where + mult_refl = mkReflCo (funRole r SelMult) manyDataConTy ty_con_app_fun_maybe :: (HasDebugCallStack, Outputable a) => a -> TyCon -> [a] -> Maybe (FunTyFlag, a, a, a) ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -1196,27 +1196,42 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } imp_occ_env = mkImportOccEnv hsc_env decl_spec all_avails - -- Look up a RdrName used in an import, failing if it is ambiguous - -- (e.g. because it refers to multiple record fields) - lookup_name :: IE GhcPs -> RdrName -> IELookupM ImpOccItem - lookup_name ie rdr = do - xs <- lookup_names ie rdr - case xs of - [cax] -> return cax - _ -> failLookupWith (AmbiguousImport rdr (map imp_item xs)) + -- Look up a parent (type constructor, class or data constructor) + -- in an import. + lookup_parent :: IE GhcPs -> RdrName -> IELookupM ImpOccItem + lookup_parent ie rdr = + assertPpr (not $ isVarNameSpace ns) + (vcat [ text "filterImports lookup_parent: unexpected variable" + , text "rdr:" <+> ppr rdr + , text "namespace:" <+> pprNameSpace ns ]) $ + do { xs <- lookup_names ie rdr + ; case xs of + cax :| [] -> return cax + _ -> pprPanic "filter_imports lookup_parent ambiguous" $ + vcat [ text "rdr:" <+> ppr rdr + , text "lookups:" <+> ppr (fmap imp_item xs) ] } + -- Looking up non-variables is always unambiguous, + -- as there can be at most one corresponding item + -- in the imp_occ_env. + -- See item (1) of Note [Exporting duplicate declarations] + -- in GHC.Tc.Gen.Export. + where + occ = rdrNameOcc rdr + ns = occNameSpace occ -- Look up a RdrName used in an import, returning multiple values if there -- are several fields with the same name exposed by the module - lookup_names :: IE GhcPs -> RdrName -> IELookupM [ImpOccItem] + lookup_names :: IE GhcPs -> RdrName -> IELookupM (NonEmpty ImpOccItem) lookup_names ie rdr | isQual rdr = failLookupWith (QualImportError rdr) - | null lookups - = failLookupWith (BadImport ie BadImportIsParent) | otherwise - = return $ concatMap nonDetNameEnvElts lookups + = case lookups of + [] -> failLookupWith (BadImport ie BadImportIsParent) + item:items -> return $ item :| items where - lookups = lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr) + lookups = concatMap nonDetNameEnvElts + $ lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr) lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])] lookup_lie (L loc ieRdr) @@ -1248,10 +1263,9 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) Succeeded a -> return (Just a) lookup_err_msg err = case err of - BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails - IllegalImport -> pure ImportLookupIllegal + BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails + IllegalImport -> pure ImportLookupIllegal QualImportError rdr -> pure (ImportLookupQualified rdr) - AmbiguousImport rdr xs -> pure (ImportLookupAmbiguous rdr xs) -- For each import item, we convert its RdrNames to Names, -- and at the same time compute all the GlobalRdrElt corresponding @@ -1269,12 +1283,12 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- See Note [Importing DuplicateRecordFields] xs <- lookup_names ie (ieWrappedName n) return ( [ (IEVar noExtField (L l (replaceWrappedName n name)), [gre]) - | ImpOccItem { imp_item = gre } <- xs + | ImpOccItem { imp_item = gre } <- NE.toList xs , let name = greName gre ] , [] ) IEThingAll _ (L l tc) -> do - ImpOccItem gre child_gres _ <- lookup_name ie $ ieWrappedName tc + ImpOccItem gre child_gres _ <- lookup_parent ie $ ieWrappedName tc let name = greName gre warns @@ -1299,19 +1313,19 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- Here the 'C' can be a data constructor -- *or* a type/class, or even both -> let tc = ieWrappedName tc' - tc_name = lookup_name ie tc - dc_name = lookup_name ie (setRdrNameSpace tc srcDataName) + tc_name = lookup_parent ie tc + dc_name = lookup_parent ie (setRdrNameSpace tc srcDataName) in case catIELookupM [ tc_name, dc_name ] of [] -> failLookupWith (BadImport ie BadImportIsParent) names -> return ([mkIEThingAbs tc' l (imp_item name) | name <- names], []) | otherwise - -> do ImpOccItem { imp_item = gre } <- lookup_name ie (ieWrappedName tc') + -> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc') return ([mkIEThingAbs tc' l gre], []) IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns -> do ImpOccItem { imp_item = gre, imp_bundled = subnames } - <- lookup_name (IEThingAbs noAnn ltc) (ieWrappedName rdr_tc) + <- lookup_parent (IEThingAbs noAnn ltc) (ieWrappedName rdr_tc) let name = greName gre -- Look up the children in the sub-names of the parent @@ -1358,7 +1372,6 @@ data IELookupError = QualImportError RdrName | BadImport (IE GhcPs) BadImportIsSubordinate | IllegalImport - | AmbiguousImport RdrName [GlobalRdrElt] -- e.g. a duplicated field name as a top-level import failLookupWith :: IELookupError -> IELookupM a failLookupWith err = Failed err ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -1053,8 +1053,7 @@ dataConSrcToImplBang bang_opts fam_envs arg_ty arg_ty' = case mb_co of { Just redn -> scaledSet arg_ty (reductionReducedType redn) ; Nothing -> arg_ty } - , all (not . isNewTyCon . fst) (splitTyConApp_maybe $ scaledThing arg_ty') - , shouldUnpackTy bang_opts unpk_prag fam_envs arg_ty' + , shouldUnpackArgTy bang_opts unpk_prag fam_envs arg_ty' = if bang_opt_unbox_disable bang_opts then HsStrict True -- Not unpacking because of -O0 -- See Note [Detecting useless UNPACK pragmas] in GHC.Core.DataCon @@ -1329,69 +1328,95 @@ mkUbxSumAltTy :: [Type] -> Type mkUbxSumAltTy [ty] = ty mkUbxSumAltTy tys = mkTupleTy Unboxed tys -shouldUnpackTy :: BangOpts -> SrcUnpackedness -> FamInstEnvs -> Scaled Type -> Bool +shouldUnpackArgTy :: BangOpts -> SrcUnpackedness -> FamInstEnvs -> Scaled Type -> Bool -- True if we ought to unpack the UNPACK the argument type -- See Note [Recursive unboxing] -- We look "deeply" inside rather than relying on the DataCons -- we encounter on the way, because otherwise we might well -- end up relying on ourselves! -shouldUnpackTy bang_opts prag fam_envs ty - | Just data_cons <- unpackable_type_datacons (scaledThing ty) - = all (ok_con_args emptyNameSet) data_cons && should_unpack data_cons +shouldUnpackArgTy bang_opts prag fam_envs arg_ty + | Just data_cons <- unpackable_type_datacons (scaledThing arg_ty) + , all ok_con data_cons -- Returns True only if we can't get a + -- loop involving these data cons + , should_unpack prag arg_ty data_cons -- ...hence the call to dataConArgUnpack in + -- should_unpack won't loop + -- See Wrinkle (W1b) of Note [Recursive unboxing] for this loopy stuff + = True + | otherwise = False where - ok_con_args :: NameSet -> DataCon -> Bool - ok_con_args dcs con - | dc_name `elemNameSet` dcs - = False - | otherwise - = all (ok_arg dcs') - (dataConOrigArgTys con `zip` dataConSrcBangs con) - -- NB: dataConSrcBangs gives the *user* request; - -- We'd get a black hole if we used dataConImplBangs + ok_con :: DataCon -> Bool -- True <=> OK to unpack + ok_con top_con -- False <=> not safe + = ok_args emptyNameSet top_con where - dc_name = getName con - dcs' = dcs `extendNameSet` dc_name - - ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool - ok_arg dcs (Scaled _ ty, bang) - = not (attempt_unpack bang) || ok_ty dcs norm_ty - where - norm_ty = topNormaliseType fam_envs ty + top_con_name = getName top_con - ok_ty :: NameSet -> Type -> Bool - ok_ty dcs ty - | Just data_cons <- unpackable_type_datacons ty - = all (ok_con_args dcs) data_cons - | otherwise - = True -- NB True here, in contrast to False at top level - - attempt_unpack :: HsSrcBang -> Bool - attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict) - = bang_opt_strict_data bang_opts - attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict) - = True - attempt_unpack (HsSrcBang _ NoSrcUnpack SrcStrict) - = True -- Be conservative - attempt_unpack (HsSrcBang _ NoSrcUnpack NoSrcStrict) - = bang_opt_strict_data bang_opts -- Be conservative - attempt_unpack _ = False - - -- Determine whether we ought to unpack a field based on user annotations if present and heuristics if not. - should_unpack data_cons = + ok_args dcs con + = all (ok_arg dcs) $ + (dataConOrigArgTys con `zip` dataConSrcBangs con) + -- NB: dataConSrcBangs gives the *user* request; + -- We'd get a black hole if we used dataConImplBangs + + ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool + ok_arg dcs (Scaled _ ty, HsSrcBang _ unpack_prag str_prag) + | strict_field str_prag + , Just data_cons <- unpackable_type_datacons (topNormaliseType fam_envs ty) + , should_unpack_conservative unpack_prag data_cons -- Wrinkle (W3) + = all (ok_rec_con dcs) data_cons -- of Note [Recursive unboxing] + | otherwise + = True -- NB True here, in contrast to False at top level + + -- See Note [Recursive unboxing] + -- * Do not look at the HsImplBangs to `con`; see Wrinkle (W1a) + -- * For the "at the root" comments see Wrinkle (W2) + ok_rec_con dcs con + | dc_name == top_con_name = False -- Recursion at the root + | dc_name `elemNameSet` dcs = True -- Not at the root + | otherwise = ok_args (dcs `extendNameSet` dc_name) con + where + dc_name = getName con + + strict_field :: SrcStrictness -> Bool + -- True <=> strict field + strict_field NoSrcStrict = bang_opt_strict_data bang_opts + strict_field SrcStrict = True + strict_field SrcLazy = False + + -- Determine whether we ought to unpack a field, + -- based on user annotations if present. + -- A conservative version of should_unpack that doesn't look at how + -- many fields the field would unpack to... because that leads to a loop. + -- "Conservative" = err on the side of saying "yes". + should_unpack_conservative :: SrcUnpackedness -> [DataCon] -> Bool + should_unpack_conservative SrcNoUnpack _ = False -- {-# NOUNPACK #-} + should_unpack_conservative SrcUnpack _ = True -- {-# NOUNPACK #-} + should_unpack_conservative NoSrcUnpack dcs = not (is_sum dcs) + -- is_sum: we never unpack sums without a pragma; otherwise be conservative + + -- Determine whether we ought to unpack a field, + -- based on user annotations if present, and heuristics if not. + should_unpack :: SrcUnpackedness -> Scaled Type -> [DataCon] -> Bool + should_unpack prag arg_ty data_cons = case prag of SrcNoUnpack -> False -- {-# NOUNPACK #-} SrcUnpack -> True -- {-# UNPACK #-} NoSrcUnpack -- No explicit unpack pragma, so use heuristics - | (_:_:_) <- data_cons - -> False -- don't unpack sum types automatically, but they can be unpacked with an explicit source UNPACK. - | otherwise + | is_sum data_cons + -> False -- Don't unpack sum types automatically, but they can + -- be unpacked with an explicit source UNPACK. + | otherwise -- Wrinkle (W4) of Note [Recursive unboxing] -> bang_opt_unbox_strict bang_opts || (bang_opt_unbox_small bang_opts && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields] - where (rep_tys, _) = dataConArgUnpack ty + where + (rep_tys, _) = dataConArgUnpack arg_ty + is_sum :: [DataCon] -> Bool + -- We never unpack sum types automatically + -- (Product types, we do. Empty types are weeded out by unpackable_type_datacons.) + is_sum (_:_:_) = True + is_sum _ = False -- Given a type already assumed to have been normalized by topNormaliseType, -- unpackable_type_datacons ty = Just datacons @@ -1403,11 +1428,11 @@ shouldUnpackTy bang_opts prag fam_envs ty unpackable_type_datacons :: Type -> Maybe [DataCon] unpackable_type_datacons ty | Just (tc, _) <- splitTyConApp_maybe ty - , not (isNewTyCon tc) - -- Even though `ty` has been normalised, it could still - -- be a /recursive/ newtype, so we must check for that + , not (isNewTyCon tc) -- Even though `ty` has been normalised, it could still + -- be a /recursive/ newtype, so we must check for that , Just cons <- tyConDataCons_maybe tc - , not (null cons) + , not (null cons) -- Don't upack nullary sums; no need. + -- They already take zero bits , all (null . dataConExTyCoVars) cons = Just cons -- See Note [Unpacking GADTs and existentials] | otherwise @@ -1463,21 +1488,75 @@ But be careful not to try to unbox this! data T = MkT {-# UNPACK #-} !T Int Because then we'd get an infinite number of arguments. -Here is a more complicated case: - data S = MkS {-# UNPACK #-} !T Int - data T = MkT {-# UNPACK #-} !S Int -Each of S and T must decide independently whether to unpack -and they had better not both say yes. So they must both say no. - -Also behave conservatively when there is no UNPACK pragma - data T = MkS !T Int -with -funbox-strict-fields or -funbox-small-strict-fields -we need to behave as if there was an UNPACK pragma there. - -But it's the *argument* type that matters. This is fine: +Note that it's the *argument* type that matters. This is fine: data S = MkS S !Int because Int is non-recursive. +Wrinkles: + +(W1a) We have to be careful that the compiler doesn't go into a loop! + First, we must not look at the HsImplBang decisions of data constructors + in the same mutually recursive group. E.g. + data S = MkS {-# UNPACK #-} !T Int + data T = MkT {-# UNPACK #-} !S Int + Each of S and T must decide /independently/ whether to unpack + and they had better not both say yes. So they must both say no. + (We could detect when we leave the group, and /then/ we can rely on + HsImplBangs; but that requires more plumbing.) + +(W1b) Here is another way the compiler might go into a loop (test T23307b): + data data T = MkT !S Int + data S = MkS !T + Suppose we call `shouldUnpackArgTy` on the !S arg of `T`. In `should_unpack` + we ask if the number of fields that `MkS` unpacks to is small enough + (via rep_tys `lengthAtMost` 1). But how many field /does/ `MkS` unpack + to? Well it depends on the unpacking decision we make for `MkS`, which + in turn depends on `MkT`, which we are busy deciding. Black holes beckon. + + So we /first/ call `ok_con` on `MkS` (and `ok_con` is conservative; + see `should_unpack_conservative`), and only /then/ call `should_unpack`. + Tricky! + +(W2) As #23307 shows, we /do/ want to unpack the second arg of the Yes + data constructor in this example, despite the recursion in List: + data Stream a = Cons a !(Stream a) + data Unconsed a = Unconsed a !(Stream a) + data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) + When looking at + {-# UNPACK #-} (Unconsed a) + we can take Unconsed apart, but then get into a loop with Stream. + That's fine: we can still take Unconsed apart. It's only if we + have a loop /at the root/ that we must not unpack. + +(W3) Moreover (W2) can apply even if there is a recursive loop: + data List a = Nil | Cons {-# UNPACK #-} !(Unconsed a) + data Unconsed a = Unconsed a !(List a) + Here there is mutual recursion between `Unconsed` and `List`; and yet + we can unpack the field of `Cons` because we will not unpack the second + field of `Unconsed`: we never unpack a sum type without an explicit + pragma (see should_unpack). + +(W4) Consider + data T = MkT !Wombat + data Wombat = MkW {-# UNPACK #-} !S Int + data S = MkS {-# NOUNPACK #-} !Wombat Int + Suppose we are deciding whether to unpack the first field of MkT, by + calling (shouldUnpackArgTy Wombat). Then we'll try to unpack the !S field + of MkW, and be stopped by the {-# NOUNPACK #-}, and all is fine; we can + unpack MkT. + + If that NOUNPACK had been a UNPACK, though, we'd get a loop, and would + decide not to unpack the Wombat field of MkT. + + But what if there was no pragma in `data S`? Then we /still/ decide not + to unpack the Wombat field of MkT (at least when auto-unpacking is on), + because we don't know for sure which decision will be taken for the + Wombat field of MkS. + + TL;DR when there is no pragma, behave as if there was a UNPACK, at least + when auto-unpacking is on. See `should_unpack` in `shouldUnpackArgTy`. + + ************************************************************************ * * Wrapping and unwrapping newtypes and type families ===================================== testsuite/tests/hsc2hs/Makefile ===================================== @@ -52,9 +52,9 @@ T11004: T12504: '$(HSC2HS)' $(HSC2HS_OPTS) T12504/path/to/$@.hsc ifeq "$(WINDOWS)" "YES" - grep '{-# LINE 1 \"T12504\\\\path\\\\to\\\\$@\.hsc\" #-}' T12504/path/to/$@.hs + grep '{-# LINE 1 "T12504\\\\path\\\\to\\\\$@\.hsc" #-}' T12504/path/to/$@.hs else - grep '{-# LINE 1 \"T12504/path/to/$@\.hsc\" #-}' T12504/path/to/$@.hs + grep '{-# LINE 1 "T12504/path/to/$@\.hsc" #-}' T12504/path/to/$@.hs endif .PHONY: T15758 ===================================== testsuite/tests/numeric/should_run/Makefile ===================================== @@ -6,5 +6,5 @@ include $(TOP)/mk/test.mk T7014: rm -f T7014.simpl T7014.o T7014.hi '$(TEST_HC)' -Wall -v0 -O --make T7014.hs -fforce-recomp -ddump-simpl > T7014.simpl - ! grep -q -f T7014.primops T7014.simpl + ! grep -Eq -f T7014.primops T7014.simpl ./T7014 ===================================== testsuite/tests/numeric/should_run/T7014.primops ===================================== @@ -2,7 +2,7 @@ and# or# uncheckedShift.*# \+# -\-# +-# \*# quotInt# remInt# ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -254,7 +254,7 @@ str-rules: # g should have been collapsed into one defininition by CSE. .PHONY: T13340 T13340: - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13340.hs -ddump-simpl -dsuppress-all | grep -c '\+#' + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13340.hs -ddump-simpl -dsuppress-all | grep -Ec '\+#' # We expect to see all dictionaries specialized away. ===================================== testsuite/tests/simplCore/should_compile/T23307.hs ===================================== @@ -0,0 +1,5 @@ +module T23307 where + +data Stream a = Nil | Cons a !(Stream a) +data Unconsed a = Unconsed a !(Stream a) +data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) ===================================== testsuite/tests/simplCore/should_compile/T23307.stderr ===================================== @@ -0,0 +1,72 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 29, types: 40, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307.$WYes [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> MUnconsed a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307.Yes @a unbx unbx1 + }}] +T23307.$WYes + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307.Yes @a unbx unbx1 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307.$WUnconsed [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> Stream a %1 -> Unconsed a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Unconsed @a conrep conrep2 + }}] +T23307.$WUnconsed + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Unconsed @a conrep conrep2 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307.$WCons [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> Stream a %1 -> Stream a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Cons @a conrep conrep2 + }}] +T23307.$WCons + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: Stream a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307.Cons @a conrep conrep2 + } + + + ===================================== testsuite/tests/simplCore/should_compile/T23307a.hs ===================================== @@ -0,0 +1,7 @@ +module T23307a where + +data List a = Nil | Cons {-# UNPACK #-} !(Unconsed a) + -- This UNPACK should work + +data Unconsed a = Unconsed a !(List a) +data MUnconsed a = No | Yes {-# UNPACK #-} !(Unconsed a) \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/T23307a.stderr ===================================== @@ -0,0 +1,68 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 28, types: 41, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307a.$WYes [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> MUnconsed a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Yes @a unbx unbx1 + }}] +T23307a.$WYes + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Yes @a unbx unbx1 + } + +-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0} +T23307a.$WUnconsed [InlPrag=INLINE[final] CONLIKE] + :: forall a. a %1 -> List a %1 -> Unconsed a +[GblId[DataConWrapper], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: List a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307a.Unconsed @a conrep conrep2 + }}] +T23307a.$WUnconsed + = \ (@a) + (conrep [Occ=Once1] :: a) + (conrep1 [Occ=Once1] :: List a) -> + case conrep1 of conrep2 [Occ=Once1] { __DEFAULT -> + T23307a.Unconsed @a conrep conrep2 + } + +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} +T23307a.$WCons [InlPrag=INLINE[final] CONLIKE] + :: forall a. Unconsed a %1 -> List a +[GblId[DataConWrapper], + Arity=1, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Cons @a unbx unbx1 + }}] +T23307a.$WCons + = \ (@a) (conrep [Occ=Once1!] :: Unconsed a) -> + case conrep of { Unconsed unbx [Occ=Once1] unbx1 [Occ=Once1] -> + T23307a.Cons @a unbx unbx1 + } + + + ===================================== testsuite/tests/simplCore/should_compile/T23307b.hs ===================================== @@ -0,0 +1,7 @@ +module Foo where + +-- It's easy to get an infinite loop +-- when deciding what to unbox here. + +data T = MkT !S Int +data S = MkS !T \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/T23307c.hs ===================================== @@ -0,0 +1,7 @@ +module Foo where + +newtype Identity x = MkId x +newtype Fix f = MkFix (f (Fix f)) + +-- This test just checks that the compiler itself doesn't loop +data Loop = LCon {-# UNPACK #-} !(Fix Identity) ===================================== testsuite/tests/simplCore/should_compile/T23307c.stderr ===================================== @@ -0,0 +1,5 @@ + +T23307c.hs:7:13: warning: [GHC-40091] + • Ignoring unusable UNPACK pragma on the first argument of ‘LCon’ + • In the definition of data constructor ‘LCon’ + In the data type declaration for ‘Loop’ ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -479,3 +479,8 @@ test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) test('T23267', [expect_broken(23267), only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -fspec-constr')], ghci_script, ['T23267.script']) test('T23362', normal, compile, ['-O']) +test('T23307', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) +test('T23307b', normal, compile, ['-O']) +test('T23307c', normal, compile, ['-O']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f77a8c0295986c0e7d636741a5eeb61bb5e668df...a6b1fe863df264586a91d398eeca46d29cc981d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f77a8c0295986c0e7d636741a5eeb61bb5e668df...a6b1fe863df264586a91d398eeca46d29cc981d2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 11:00:17 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 15 May 2023 07:00:17 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Wibbles Message-ID: <646210c1db538_171ad965352c5c745429@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: f72a67cc by Simon Peyton Jones at 2023-05-15T12:02:12+01:00 Wibbles - - - - - 2 changed files: - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Irred.hs Changes: ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -69,14 +69,17 @@ solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage () -- NC: this comes from CNonCanonical or CIrredCan -- Precondition: already rewritten by inert set solveDictNC ev cls tys - = do { dict_ct <- canDictCt ev cls tys + = do { simpleStage $ traceTcS "solveDictNC" (ppr (mkClassPred cls tys) $$ ppr ev) + ; dict_ct <- canDictCt ev cls tys ; solveDict dict_ct } solveDict :: DictCt -> SolverStage () -- Preconditions: `tys` are already rewritten by the inert set solveDict dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = tys }) = assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ - do { tryInertDicts dict_ct + do { simpleStage $ traceTcS "solveDict" (ppr dict_ct) + + ; tryInertDicts dict_ct ; tryInstances dict_ct -- Try fundeps /after/ tryInstances: @@ -182,20 +185,84 @@ solveCallStack ev ev_cs {- Note [Kick out existing binding for implicit parameter] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we add a new /given/ implicit parameter to the inert set, it /replaces/ +any existing givens for the same implicit parameter. + +Example 1: + Suppose we have (typecheck/should_compile/ImplicitParamFDs) flub :: (?x :: Int) => (Int, Integer) flub = (?x, let ?x = 5 in ?x) -When we are checking the last ?x occurrence, we guess its type -to be a fresh unification variable alpha and emit an (IP "x" alpha) -constraint. But the given (?x :: Int) has been translated to an -IP "x" Int constraint, which has a functional dependency from the -name to the type. So fundep interaction tells us that alpha ~ Int, -and we get a type error. This is bad. - -Instead, we wish to excise any old given for an IP when adding a -new one. +When we are checking the last ?x occurrence, we guess its type to be a fresh +unification variable alpha and emit an (IP "x" alpha) constraint. But the given +(?x :: Int) has been translated to an IP "x" Int constraint, which has a +functional dependency from the name to the type. So if that (?x::Int) is still +in the inert set, we'd get a fundep interaction that tells us that alpha ~ Int, +and we get a type error. This is bad. The "replacement" semantics stops this +happening. + +Example 2: + +f :: (?x :: Char) => Char +f = let ?x = 'a' in ?x + +The "let ?x = ..." generates an implication constraint of the form: + +?x :: Char => ?x :: Char + +Furthermore, the signature for `f` also generates an implication +constraint, so we end up with the following nested implication: + +?x :: Char => (?x :: Char => ?x :: Char) + +Note that the wanted (?x :: Char) constraint may be solved in two incompatible +ways: either by using the parameter from the signature, or by using the local +definition. Our intention is that the local definition should "shadow" the +parameter of the signature. The "replacement" semantics for implicit parameters +does this. + +Example 3: + +Similarly, consider + f :: (?x::a) => Bool -> a + + g v = let ?x::Int = 3 + in (f v, let ?x::Bool = True in f v) + +This should probably be well typed, with + g :: Bool -> (Int, Bool) + +So the inner binding for ?x::Bool *overrides* the outer one. + +See ticket #17104 for a rather tricky example of this overriding +behaviour. + +All this works for the normal cases but it has an odd side effect in +some pathological programs like this: +-- This is accepted, the second parameter shadows +f1 :: (?x :: Int, ?x :: Char) => Char +f1 = ?x + +-- This is rejected, the second parameter shadows +f2 :: (?x :: Int, ?x :: Char) => Int +f2 = ?x + +Both of these are actually wrong: when we try to use either one, +we'll get two incompatible wanted constraints (?x :: Int, ?x :: Char), +which would lead to an error. + +I can think of two ways to fix this: + + 1. Simply disallow multiple constraints for the same implicit + parameter---this is never useful, and it can be detected completely + syntactically. + + 2. Move the shadowing machinery to the location where we nest + implications, and add some code here that will produce an + error if we get multiple givens for the same implicit parameter. -} + {- ****************************************************************************** * * interactDict @@ -510,12 +577,6 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys ; updInertCans (updDicts $ delDict dict_w) ; continueWith () } } } -{- - | cls `hasKey` ipClassKey - , isGiven ev_w - = interactGivenIP inerts dict_w --} - | otherwise = continueWith () @@ -620,100 +681,6 @@ shortCutSolver dflags ev_w ev_i Nothing -> Fresh <$> newWantedNC loc (ctEvRewriters ev_w) pty | otherwise = mzero -{- -********************************************************************** -* * - Implicit parameters -* * -********************************************************************** --} - -{- -interactGivenIP :: InertCans -> DictCt -> TcS (StopOrContinue ()) --- Work item is Given (?x:ty) --- See Note [Shadowing of Implicit Parameters] -interactGivenIP inerts workItem@(DictCt { di_ev = ev, di_cls = cls - , di_tys = tys }) - = do { updInertCans $ \cans -> cans { inert_dicts = addDict workItem filtered_dicts } - ; stopWith ev "Given IP" } - where - dicts = inert_dicts inerts - ip_dicts = findDictsByClass dicts cls - other_ip_dicts = filterBag (not . is_this_ip) ip_dicts - filtered_dicts = addDictsByClass dicts cls other_ip_dicts - - ip_str = case tys of - ip_str:_ -> ip_str - [] -> pprPanic "interactGivenIP" (ppr workItem) - - -- Pick out any Given constraints for the same implicit parameter - is_this_ip (DictCt { di_ev = ev, di_tys = ip_str':_ }) - = isGiven ev && ip_str `tcEqType` ip_str' - is_this_ip _ = False --} -{- Note [Shadowing of Implicit Parameters] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the following example: - -f :: (?x :: Char) => Char -f = let ?x = 'a' in ?x - -The "let ?x = ..." generates an implication constraint of the form: - -?x :: Char => ?x :: Char - -Furthermore, the signature for `f` also generates an implication -constraint, so we end up with the following nested implication: - -?x :: Char => (?x :: Char => ?x :: Char) - -Note that the wanted (?x :: Char) constraint may be solved in -two incompatible ways: either by using the parameter from the -signature, or by using the local definition. Our intention is -that the local definition should "shadow" the parameter of the -signature, and we implement this as follows: when we add a new -*given* implicit parameter to the inert set, it replaces any existing -givens for the same implicit parameter. - -Similarly, consider - f :: (?x::a) => Bool -> a - - g v = let ?x::Int = 3 - in (f v, let ?x::Bool = True in f v) - -This should probably be well typed, with - g :: Bool -> (Int, Bool) - -So the inner binding for ?x::Bool *overrides* the outer one. - -See ticket #17104 for a rather tricky example of this overriding -behaviour. - -All this works for the normal cases but it has an odd side effect in -some pathological programs like this: --- This is accepted, the second parameter shadows -f1 :: (?x :: Int, ?x :: Char) => Char -f1 = ?x - --- This is rejected, the second parameter shadows -f2 :: (?x :: Int, ?x :: Char) => Int -f2 = ?x - -Both of these are actually wrong: when we try to use either one, -we'll get two incompatible wanted constraints (?x :: Int, ?x :: Char), -which would lead to an error. - -I can think of two ways to fix this: - - 1. Simply disallow multiple constraints for the same implicit - parameter---this is never useful, and it can be detected completely - syntactically. - - 2. Move the shadowing machinery to the location where we nest - implications, and add some code here that will produce an - error if we get multiple givens for the same implicit parameter. --} - {- ******************************************************************* * * Top-level reaction for class constraints (CDictCan) ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -62,17 +62,13 @@ tryInertIrreds irred try_inert_irreds :: InertCans -> IrredCt -> TcS (StopOrContinue ()) try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) - | isInsolubleReason reason - -- For insolubles, don't allow the constraint to be dropped - -- which can happen with solveOneFromTheOther, so that - -- we get distinct error messages with -fdefer-type-errors - = continueWith () - | let (matching_irreds, others) = findMatchingIrreds (inert_irreds inerts) ev_w , ((irred_i, swap) : _rest) <- bagToList matching_irreds -- See Note [Multiple matching irreds] , let ev_i = irredCtEvidence irred_i ct_i = CIrredCan irred_i + , not (isInsolubleReason reason && isWanted ev_i && isWanted ev_w) + -- See Note [Insoluble irreds] = do { traceTcS "iteractIrred" $ vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] @@ -106,6 +102,16 @@ matching irreds in the inert set. When another irred comes along that we have not yet labeled insoluble, we can find multiple matches. These multiple matches cause no harm, but it would be wrong to ASSERT that they aren't there (as we once had done). This problem can be tickled by typecheck/should_compile/holes. + +Note [Insoluble irreds] +~~~~~~~~~~~~~~~~~~~~~~~ +For insoluble Wanteds, don't allow a duplicate Wanted to be dropped which +can happen with solveOneFromTheOther, so that we get distinct error messages +with -fdefer-type-errors + +However we do allow an insoluble constraint to be solved from an insoluble +Given. This might seem a little odd, but it's very much a corner case, and +it helps in tests bkpfail24.run, T15450, GivenForallLoop, T20189, T8392a. -} {- ********************************************************************* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f72a67cc8d88293a2b6e11103a6f37dffd331974 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f72a67cc8d88293a2b6e11103a6f37dffd331974 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 12:10:10 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 15 May 2023 08:10:10 -0400 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] Use unboxed codebuffers in base Message-ID: <64622122c9732_171ad96a04f7807531aa@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: ce0082dc by Josh Meredith at 2023-05-15T12:09:45+00:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 9 changed files: - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/Encoding/Failure.hs - libraries/base/GHC/IO/Encoding/Iconv.hs - libraries/base/GHC/IO/Encoding/Latin1.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/IO/Encoding.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} ----------------------------------------------------------------------------- @@ -336,11 +337,13 @@ mkTextEncoding' cfm enc = latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8) -latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8 +latin1_encode input output = IO $ \st -> case Latin1.latin1_encode input output st of + (# st', _why, input', output' #) -> (# st', (input', output') #) -- unchecked, used for char8 --latin1_encode = unsafePerformIO $ do mkTextEncoder Iconv.latin1 >>= return.encode latin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer) -latin1_decode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_decode input output +latin1_decode input output = IO $ \st -> case Latin1.latin1_decode input output st of + (# st', _why, input', output' #) -> (# st', (input',output') #) --latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode unknownEncodingErr :: String -> IO a ===================================== libraries/base/GHC/IO/Encoding/CodePage/API.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, NondecreasingIndentation, - RecordWildCards, ScopedTypeVariables #-} + RecordWildCards, ScopedTypeVariables, + UnboxedTuples #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} module GHC.IO.Encoding.CodePage.API ( @@ -157,11 +158,15 @@ newCP rec fn cp = do utf16_native_encode' :: EncodeBuffer utf16_native_decode' :: DecodeBuffer #if defined(WORDS_BIGENDIAN) -utf16_native_encode' = utf16be_encode -utf16_native_decode' = utf16be_decode +utf16_native_encode' i o = IO $ \st -> case utf16be_encode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) +utf16_native_decode' i o = IO $ \st -> case utf16be_decode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) #else -utf16_native_encode' = utf16le_encode -utf16_native_decode' = utf16le_decode +utf16_native_encode' i o = IO $ \st -> case utf16le_encode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) +utf16_native_decode' i o = IO $ \st -> case utf16le_decode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) #endif saner :: CodeBuffer from to ===================================== libraries/base/GHC/IO/Encoding/Failure.hs ===================================== @@ -1,5 +1,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- | @@ -18,7 +21,8 @@ module GHC.IO.Encoding.Failure ( CodingFailureMode(..), codingFailureModeSuffix, isSurrogate, - recoverDecode, recoverEncode + recoverDecode, recoverEncode, + recoverDecode#, recoverEncode#, ) where import GHC.IO @@ -142,6 +146,12 @@ unescapeRoundtripCharacterSurrogate c | otherwise = Nothing where x = ord c +recoverDecode# :: CodingFailureMode -> Buffer Word8 -> Buffer Char + -> State# RealWorld -> (# State# RealWorld, Buffer Word8, Buffer Char #) +recoverDecode# cfm input output st = + let !(# st', (bIn, bOut) #) = unIO (recoverDecode cfm input output) st + in (# st', bIn, bOut #) + recoverDecode :: CodingFailureMode -> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char) recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } @@ -160,6 +170,12 @@ recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } ow' <- writeCharBuf oraw ow (escapeToRoundtripCharacterSurrogate b) return (input { bufL=ir+1 }, output { bufR=ow' }) +recoverEncode# :: CodingFailureMode -> Buffer Char -> Buffer Word8 + -> State# RealWorld -> (# State# RealWorld, Buffer Char, Buffer Word8 #) +recoverEncode# cfm input output st = + let !(# st', (bIn, bOut) #) = unIO (recoverEncode cfm input output) st + in (# st', bIn, bOut #) + recoverEncode :: CodingFailureMode -> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8) recoverEncode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } ===================================== libraries/base/GHC/IO/Encoding/Iconv.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE CPP , NoImplicitPrelude , NondecreasingIndentation + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} @@ -133,19 +135,24 @@ newIConv from to rec fn = withCAString to $ \ to_str -> do iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt - return BufferCodec{ - encode = fn iconvt, - recover = rec, - close = iclose, + fn_iconvt ibuf obuf st = case unIO (fn iconvt ibuf obuf) st of + (# st', (prog, ibuf', obuf') #) -> (# st', prog, ibuf', obuf' #) + return BufferCodec# { + encode# = fn_iconvt, + recover# = rec#, + close# = iclose, -- iconv doesn't supply a way to save/restore the state - getState = return (), - setState = const $ return () + getState# = return (), + setState# = const $ return () } + where + rec# ibuf obuf st = case unIO (rec ibuf obuf) st of + (# st', (ibuf', obuf') #) -> (# st', ibuf', obuf' #) -iconvDecode :: IConv -> DecodeBuffer +iconvDecode :: IConv -> Buffer Word8 -> Buffer Char -> IO (CodingProgress, Buffer Word8, Buffer Char) iconvDecode iconv_t ibuf obuf = iconvRecode iconv_t ibuf 0 obuf char_shift -iconvEncode :: IConv -> EncodeBuffer +iconvEncode :: IConv -> Buffer Char -> Buffer Word8 -> IO (CodingProgress, Buffer Char, Buffer Word8) iconvEncode iconv_t ibuf obuf = iconvRecode iconv_t ibuf char_shift obuf 0 iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int ===================================== libraries/base/GHC/IO/Encoding/Latin1.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE NoImplicitPrelude , BangPatterns , NondecreasingIndentation + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -56,22 +58,22 @@ mkLatin1 cfm = TextEncoding { textEncodingName = "ISO-8859-1", latin1_DF :: CodingFailureMode -> IO (TextDecoder ()) latin1_DF cfm = - return (BufferCodec { - encode = latin1_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) latin1_EF :: CodingFailureMode -> IO (TextEncoder ()) latin1_EF cfm = - return (BufferCodec { - encode = latin1_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) latin1_checked :: TextEncoding @@ -85,12 +87,12 @@ mkLatin1_checked cfm = TextEncoding { textEncodingName = "ISO-8859-1", latin1_checked_EF :: CodingFailureMode -> IO (TextEncoder ()) latin1_checked_EF cfm = - return (BufferCodec { - encode = latin1_checked_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_checked_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -- ----------------------------------------------------------------------------- @@ -108,22 +110,22 @@ mkAscii cfm = TextEncoding { textEncodingName = "ASCII", ascii_DF :: CodingFailureMode -> IO (TextDecoder ()) ascii_DF cfm = - return (BufferCodec { - encode = ascii_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = ascii_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) ascii_EF :: CodingFailureMode -> IO (TextEncoder ()) ascii_EF cfm = - return (BufferCodec { - encode = ascii_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = ascii_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) @@ -134,97 +136,115 @@ ascii_EF cfm = -- TODO: Eliminate code duplication between the checked and unchecked -- versions of the decoder or encoder (but don't change the Core!) -latin1_decode :: DecodeBuffer +latin1_decode :: DecodeBuffer# latin1_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 + !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -ascii_decode :: DecodeBuffer +ascii_decode :: DecodeBuffer# ascii_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - if c0 > 0x7f then invalid else do - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 + if c0 > 0x7f then invalid st1 else do + let !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -latin1_encode :: EncodeBuffer +latin1_encode :: EncodeBuffer# latin1_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - writeWord8Buf oraw ow (fromIntegral (ord c)) - loop ir' (ow+1) + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (ord c))) st1 + loop ir' (ow+1) st2 in - loop ir0 ow0 + loop ir0 ow0 st -latin1_checked_encode :: EncodeBuffer +latin1_checked_encode :: EncodeBuffer# latin1_checked_encode input output = single_byte_checked_encode 0xff input output -ascii_encode :: EncodeBuffer +ascii_encode :: EncodeBuffer# ascii_encode input output = single_byte_checked_encode 0x7f input output -single_byte_checked_encode :: Int -> EncodeBuffer +single_byte_checked_encode :: Int -> EncodeBuffer# single_byte_checked_encode max_legal_char input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if ord c > max_legal_char then invalid else do - writeWord8Buf oraw ow (fromIntegral (ord c)) - loop ir' (ow+1) + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if ord c > max_legal_char then invalid st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (ord c))) st1 + loop ir' (ow+1) st2 where - invalid = done InvalidSequence ir ow + invalid :: EncodingBuffer# + invalid st' = done InvalidSequence ir ow st' in - loop ir0 ow0 + loop ir0 ow0 st {-# INLINE single_byte_checked_encode #-} ===================================== libraries/base/GHC/IO/Encoding/UTF16.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -61,64 +62,66 @@ mkUTF16 cfm = TextEncoding { textEncodingName = "UTF-16", mkTextDecoder = utf16_DF cfm, mkTextEncoder = utf16_EF cfm } -utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) +utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#)) utf16_DF cfm = do seen_bom <- newIORef Nothing - return (BufferCodec { - encode = utf16_decode seen_bom, - recover = recoverDecode cfm, - close = return (), - getState = readIORef seen_bom, - setState = writeIORef seen_bom + return (BufferCodec# { + encode# = utf16_decode seen_bom, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef seen_bom, + setState# = writeIORef seen_bom }) utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf16_EF cfm = do done_bom <- newIORef False - return (BufferCodec { - encode = utf16_encode done_bom, - recover = recoverEncode cfm, - close = return (), - getState = readIORef done_bom, - setState = writeIORef done_bom + return (BufferCodec# { + encode# = utf16_encode done_bom, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef done_bom, + setState# = writeIORef done_bom }) -utf16_encode :: IORef Bool -> EncodeBuffer +utf16_encode :: IORef Bool -> EncodeBuffer# utf16_encode done_bom input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef done_bom - if b then utf16_native_encode input output + let !(# st1, b #) = unIO (readIORef done_bom) st0 + if b then utf16_native_encode input output st1 else if os - ow < 2 - then return (OutputUnderflow,input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef done_bom True - writeWord8Buf oraw ow bom1 - writeWord8Buf oraw (ow+1) bom2 - utf16_native_encode input output{ bufR = ow+2 } + let !(# st2, () #) = unIO (writeIORef done_bom True) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom2) st3 + utf16_native_encode input output{ bufR = ow+2 } st4 -utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer +utf16_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer# utf16_decode seen_bom input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - mb <- readIORef seen_bom + let !(# st1, mb #) = unIO (readIORef seen_bom) st0 case mb of - Just decode -> decode input output + Just decode -> decode input output st1 Nothing -> - if iw - ir < 2 then return (InputUnderflow,input,output) else do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) + if iw - ir < 2 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 case () of - _ | c0 == bomB && c1 == bomL -> do - writeIORef seen_bom (Just utf16be_decode) - utf16be_decode input{ bufL= ir+2 } output - | c0 == bomL && c1 == bomB -> do - writeIORef seen_bom (Just utf16le_decode) - utf16le_decode input{ bufL= ir+2 } output - | otherwise -> do - writeIORef seen_bom (Just utf16_native_decode) - utf16_native_decode input output + _ | c0 == bomB && c1 == bomL -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16be_decode)) st3 + in utf16be_decode input{ bufL= ir+2 } output st4 + | c0 == bomL && c1 == bomB -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16le_decode)) st3 + in utf16le_decode input{ bufL= ir+2 } output st4 + | otherwise -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16_native_decode)) st3 + in utf16_native_decode input output st4 bomB, bomL, bom1, bom2 :: Word8 @@ -126,10 +129,10 @@ bomB = 0xfe bomL = 0xff -- choose UTF-16BE by default for UTF-16 output -utf16_native_decode :: DecodeBuffer +utf16_native_decode :: DecodeBuffer# utf16_native_decode = utf16be_decode -utf16_native_encode :: EncodeBuffer +utf16_native_encode :: EncodeBuffer# utf16_native_encode = utf16be_encode bom1 = bomB @@ -149,22 +152,22 @@ mkUTF16be cfm = TextEncoding { textEncodingName = "UTF-16BE", utf16be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16be_DF cfm = - return (BufferCodec { - encode = utf16be_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16be_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16be_EF cfm = - return (BufferCodec { - encode = utf16be_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16be_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16le :: TextEncoding @@ -178,114 +181,127 @@ mkUTF16le cfm = TextEncoding { textEncodingName = "UTF16-LE", utf16le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16le_DF cfm = - return (BufferCodec { - encode = utf16le_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16le_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16le_EF cfm = - return (BufferCodec { - encode = utf16le_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16le_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -utf16be_decode :: DecodeBuffer +utf16be_decode :: DecodeBuffer# utf16be_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow - | ir + 1 == iw = done InputUnderflow ir ow + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | ir + 1 == iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 let x1 = fromIntegral c0 `shiftL` 8 + fromIntegral c1 if validate1 x1 - then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1)) - loop (ir+2) ow' - else if iw - ir < 4 then done InputUnderflow ir ow else do - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3 - if not (validate2 x1 x2) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 x1 x2) - loop (ir+4) ow' + then let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral x1))) st2 + in loop (ir+2) ow' st3 + else if iw - ir < 4 then done InputUnderflow ir ow st2 else do + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3 + if not (validate2 x1 x2) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr2 x1 x2)) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input { bufL = 0, bufR = 0 } else input { bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf16le_decode :: DecodeBuffer +utf16le_decode :: DecodeBuffer# utf16le_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow - | ir + 1 == iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | ir + 1 == iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 if validate1 x1 - then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1)) - loop (ir+2) ow' - else if iw - ir < 4 then done InputUnderflow ir ow else do - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 - if not (validate2 x1 x2) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 x1 x2) - loop (ir+4) ow' + then let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral x1))) st2 + in loop (ir+2) ow' st3 + else if iw - ir < 4 then done InputUnderflow ir ow st2 else do + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 + if not (validate2 x1 x2) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr2 x1 x2)) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf16be_encode :: EncodeBuffer +utf16be_encode :: EncodeBuffer# utf16be_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 2 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 2 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of - x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do - writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8)) - writeWord8Buf oraw (ow+1) (fromIntegral x) - loop ir' (ow+2) + x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8))) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) (fromIntegral x)) st2 + loop ir' (ow+2) st3 | otherwise -> do - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) @@ -294,35 +310,39 @@ utf16be_encode c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 -- - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - writeWord8Buf oraw (ow+3) c4 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c4) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -utf16le_encode :: EncodeBuffer +utf16le_encode :: EncodeBuffer# utf16le_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 2 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 2 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of - x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do - writeWord8Buf oraw ow (fromIntegral x) - writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8)) - loop ir' (ow+2) + x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))) st2 + loop ir' (ow+2) st3 | otherwise -> - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) @@ -331,13 +351,13 @@ utf16le_encode c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 -- - writeWord8Buf oraw ow c2 - writeWord8Buf oraw (ow+1) c1 - writeWord8Buf oraw (ow+2) c4 - writeWord8Buf oraw (ow+3) c3 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c2) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c4) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c3) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st chr2 :: Word16 -> Word16 -> Char chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#)) ===================================== libraries/base/GHC/IO/Encoding/UTF32.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -61,68 +62,70 @@ mkUTF32 cfm = TextEncoding { textEncodingName = "UTF-32", mkTextDecoder = utf32_DF cfm, mkTextEncoder = utf32_EF cfm } -utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) +utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#)) utf32_DF cfm = do seen_bom <- newIORef Nothing - return (BufferCodec { - encode = utf32_decode seen_bom, - recover = recoverDecode cfm, - close = return (), - getState = readIORef seen_bom, - setState = writeIORef seen_bom + return (BufferCodec# { + encode# = utf32_decode seen_bom, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef seen_bom, + setState# = writeIORef seen_bom }) utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf32_EF cfm = do done_bom <- newIORef False - return (BufferCodec { - encode = utf32_encode done_bom, - recover = recoverEncode cfm, - close = return (), - getState = readIORef done_bom, - setState = writeIORef done_bom + return (BufferCodec# { + encode# = utf32_encode done_bom, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef done_bom, + setState# = writeIORef done_bom }) -utf32_encode :: IORef Bool -> EncodeBuffer +utf32_encode :: IORef Bool -> EncodeBuffer# utf32_encode done_bom input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef done_bom - if b then utf32_native_encode input output + let !(# st1, b #) = unIO (readIORef done_bom) st0 + if b then utf32_native_encode input output st1 else if os - ow < 4 - then return (OutputUnderflow, input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef done_bom True - writeWord8Buf oraw ow bom0 - writeWord8Buf oraw (ow+1) bom1 - writeWord8Buf oraw (ow+2) bom2 - writeWord8Buf oraw (ow+3) bom3 - utf32_native_encode input output{ bufR = ow+4 } - -utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer + let !(# st2, () #) = unIO (writeIORef done_bom True) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom0) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+2) bom2) st4 + !(# st6, () #) = unIO (writeWord8Buf oraw (ow+3) bom3) st5 + utf32_native_encode input output{ bufR = ow+4 } st6 + +utf32_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer# utf32_decode seen_bom input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - mb <- readIORef seen_bom + let !(# st1, mb #) = unIO (readIORef seen_bom) st0 case mb of - Just decode -> decode input output + Just decode -> decode input output st1 Nothing -> - if iw - ir < 4 then return (InputUnderflow, input,output) else do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + if iw - ir < 4 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 + !(# st4, c2 #) = unIO (readWord8Buf iraw (ir+2)) st3 + !(# st5, c3 #) = unIO (readWord8Buf iraw (ir+3)) st4 case () of - _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> do - writeIORef seen_bom (Just utf32be_decode) - utf32be_decode input{ bufL= ir+4 } output - _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> do - writeIORef seen_bom (Just utf32le_decode) - utf32le_decode input{ bufL= ir+4 } output - | otherwise -> do - writeIORef seen_bom (Just utf32_native_decode) - utf32_native_decode input output + _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32be_decode)) st5 + in utf32be_decode input{ bufL= ir+4 } output st6 + _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32le_decode)) st5 + in utf32le_decode input{ bufL= ir+4 } output st6 + | otherwise -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32_native_decode)) st5 + in utf32_native_decode input output st6 bom0, bom1, bom2, bom3 :: Word8 @@ -132,10 +135,10 @@ bom2 = 0xfe bom3 = 0xff -- choose UTF-32BE by default for UTF-32 output -utf32_native_decode :: DecodeBuffer +utf32_native_decode :: DecodeBuffer# utf32_native_decode = utf32be_decode -utf32_native_encode :: EncodeBuffer +utf32_native_encode :: EncodeBuffer# utf32_native_encode = utf32be_encode -- ----------------------------------------------------------------------------- @@ -152,22 +155,22 @@ mkUTF32be cfm = TextEncoding { textEncodingName = "UTF-32BE", utf32be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf32be_DF cfm = - return (BufferCodec { - encode = utf32be_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32be_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf32be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf32be_EF cfm = - return (BufferCodec { - encode = utf32be_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32be_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) @@ -182,128 +185,145 @@ mkUTF32le cfm = TextEncoding { textEncodingName = "UTF-32LE", utf32le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf32le_DF cfm = - return (BufferCodec { - encode = utf32le_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32le_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf32le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf32le_EF cfm = - return (BufferCodec { - encode = utf32le_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32le_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -utf32be_decode :: DecodeBuffer +utf32be_decode :: DecodeBuffer# utf32be_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | iw - ir < 4 = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | iw - ir < 4 = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 let x1 = chr4 c0 c1 c2 c3 - if not (validate x1) then invalid else do - ow' <- writeCharBuf oraw ow x1 - loop (ir+4) ow' + if not (validate x1) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf32le_decode :: DecodeBuffer +utf32le_decode :: DecodeBuffer# utf32le_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | iw - ir < 4 = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | iw - ir < 4 = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 let x1 = chr4 c3 c2 c1 c0 - if not (validate x1) then invalid else do - ow' <- writeCharBuf oraw ow x1 - loop (ir+4) ow' + if not (validate x1) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf32be_encode :: EncodeBuffer +utf32be_encode :: EncodeBuffer# utf32be_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 4 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 4 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if isSurrogate c then done InvalidSequence ir ow else do + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if isSurrogate c then done InvalidSequence ir ow st1 else do let (c0,c1,c2,c3) = ord4 c - writeWord8Buf oraw ow c0 - writeWord8Buf oraw (ow+1) c1 - writeWord8Buf oraw (ow+2) c2 - writeWord8Buf oraw (ow+3) c3 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c0) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c2) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c3) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -utf32le_encode :: EncodeBuffer +utf32le_encode :: EncodeBuffer# utf32le_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 4 = done OutputUnderflow ir ow + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 4 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if isSurrogate c then done InvalidSequence ir ow else do + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if isSurrogate c then done InvalidSequence ir ow st1 else do let (c0,c1,c2,c3) = ord4 c - writeWord8Buf oraw ow c3 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c1 - writeWord8Buf oraw (ow+3) c0 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c3) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c0) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) = ===================================== libraries/base/GHC/IO/Encoding/UTF8.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -56,22 +57,22 @@ mkUTF8 cfm = TextEncoding { textEncodingName = "UTF-8", utf8_DF :: CodingFailureMode -> IO (TextDecoder ()) utf8_DF cfm = - return (BufferCodec { - encode = utf8_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf8_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf8_EF :: CodingFailureMode -> IO (TextEncoder ()) utf8_EF cfm = - return (BufferCodec { - encode = utf8_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf8_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf8_bom :: TextEncoding @@ -85,177 +86,188 @@ mkUTF8_bom cfm = TextEncoding { textEncodingName = "UTF-8BOM", utf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool) utf8_bom_DF cfm = do ref <- newIORef True - return (BufferCodec { - encode = utf8_bom_decode ref, - recover = recoverDecode cfm, - close = return (), - getState = readIORef ref, - setState = writeIORef ref + return (BufferCodec# { + encode# = utf8_bom_decode ref, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef ref, + setState# = writeIORef ref }) utf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf8_bom_EF cfm = do ref <- newIORef True - return (BufferCodec { - encode = utf8_bom_encode ref, - recover = recoverEncode cfm, - close = return (), - getState = readIORef ref, - setState = writeIORef ref + return (BufferCodec# { + encode# = utf8_bom_encode ref, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef ref, + setState# = writeIORef ref }) -utf8_bom_decode :: IORef Bool -> DecodeBuffer +utf8_bom_decode :: IORef Bool -> DecodeBuffer# utf8_bom_decode ref input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - first <- readIORef ref + let !(# st1, first #) = unIO (readIORef ref) st0 if not first - then utf8_decode input output + then utf8_decode input output st1 else do - let no_bom = do writeIORef ref False; utf8_decode input output - if iw - ir < 1 then return (InputUnderflow,input,output) else do - c0 <- readWord8Buf iraw ir + let no_bom = let !(# st', () #) = unIO (writeIORef ref False) st1 in utf8_decode input output st' + if iw - ir < 1 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir) st1 if (c0 /= bom0) then no_bom else do - if iw - ir < 2 then return (InputUnderflow,input,output) else do - c1 <- readWord8Buf iraw (ir+1) + if iw - ir < 2 then (# st2,InputUnderflow,input,output #) else do + let !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 if (c1 /= bom1) then no_bom else do - if iw - ir < 3 then return (InputUnderflow,input,output) else do - c2 <- readWord8Buf iraw (ir+2) + if iw - ir < 3 then (# st3,InputUnderflow,input,output #) else do + let !(# st4, c2 #) = unIO (readWord8Buf iraw (ir+2)) st3 if (c2 /= bom2) then no_bom else do -- found a BOM, ignore it and carry on - writeIORef ref False - utf8_decode input{ bufL = ir + 3 } output + let !(# st5, () #) = unIO (writeIORef ref False) st4 + utf8_decode input{ bufL = ir + 3 } output st5 -utf8_bom_encode :: IORef Bool -> EncodeBuffer +utf8_bom_encode :: IORef Bool -> EncodeBuffer# utf8_bom_encode ref input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef ref - if not b then utf8_encode input output + let !(# st1, b #) = unIO (readIORef ref) st0 + if not b then utf8_encode input output st1 else if os - ow < 3 - then return (OutputUnderflow,input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef ref False - writeWord8Buf oraw ow bom0 - writeWord8Buf oraw (ow+1) bom1 - writeWord8Buf oraw (ow+2) bom2 - utf8_encode input output{ bufR = ow+3 } + let !(# st2, () #) = unIO (writeIORef ref False) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom0) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+2) bom2) st4 + utf8_encode input output{ bufR = ow+3 } st5 bom0, bom1, bom2 :: Word8 bom0 = 0xef bom1 = 0xbb bom2 = 0xbf -utf8_decode :: DecodeBuffer +utf8_decode :: DecodeBuffer# utf8_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 case c0 of _ | c0 <= 0x7f -> do - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' - | c0 >= 0xc0 && c0 <= 0xc1 -> invalid -- Overlong forms + let !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 + | c0 >= 0xc0 && c0 <= 0xc1 -> invalid st1 -- Overlong forms | c0 >= 0xc2 && c0 <= 0xdf -> - if iw - ir < 2 then done InputUnderflow ir ow else do - c1 <- readWord8Buf iraw (ir+1) - if (c1 < 0x80 || c1 >= 0xc0) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 c0 c1) - loop (ir+2) ow' + if iw - ir < 2 then done InputUnderflow ir ow st1 else do + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + if (c1 < 0x80 || c1 >= 0xc0) then invalid st2 else do + let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (chr2 c0 c1)) st2 + loop (ir+2) ow' st3 | c0 >= 0xe0 && c0 <= 0xef -> case iw - ir of - 1 -> done InputUnderflow ir ow + 1 -> done InputUnderflow ir ow st1 2 -> do -- check for an error even when we don't have -- the full sequence yet (#3341) - c1 <- readWord8Buf iraw (ir+1) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 if not (validate3 c0 c1 0x80) - then invalid else done InputUnderflow ir ow + then invalid st2 else done InputUnderflow ir ow st2 _ -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - if not (validate3 c0 c1 c2) then invalid else do - ow' <- writeCharBuf oraw ow (chr3 c0 c1 c2) - loop (ir+3) ow' + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + if not (validate3 c0 c1 c2) then invalid st3 else do + let !(# st4, ow' #) = unIO (writeCharBuf oraw ow (chr3 c0 c1 c2)) st3 + loop (ir+3) ow' st4 | c0 >= 0xf0 -> case iw - ir of - 1 -> done InputUnderflow ir ow + 1 -> done InputUnderflow ir ow st1 2 -> do -- check for an error even when we don't have -- the full sequence yet (#3341) - c1 <- readWord8Buf iraw (ir+1) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 if not (validate4 c0 c1 0x80 0x80) - then invalid else done InputUnderflow ir ow + then invalid st2 else done InputUnderflow ir ow st2 3 -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 if not (validate4 c0 c1 c2 0x80) - then invalid else done InputUnderflow ir ow + then invalid st3 else done InputUnderflow ir ow st3 _ -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - if not (validate4 c0 c1 c2 c3) then invalid else do - ow' <- writeCharBuf oraw ow (chr4 c0 c1 c2 c3) - loop (ir+4) ow' + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + if not (validate4 c0 c1 c2 c3) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr4 c0 c1 c2 c3)) st4 + loop (ir+4) ow' st5 | otherwise -> - invalid + invalid st1 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0} else input{ bufL = ir } + !ro = output { bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf8_encode :: EncodeBuffer +utf8_encode :: EncodeBuffer# utf8_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of x | x <= 0x7F -> do - writeWord8Buf oraw ow (fromIntegral x) - loop ir' (ow+1) + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 + loop ir' (ow+1) st2 | x <= 0x07FF -> - if os - ow < 2 then done OutputUnderflow ir ow else do + if os - ow < 2 then done OutputUnderflow ir ow st1 else do let (c1,c2) = ord2 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - loop ir' (ow+2) - | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow else do - if os - ow < 3 then done OutputUnderflow ir ow else do + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + loop ir' (ow+2) st3 + | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow st1 else do + if os - ow < 3 then done OutputUnderflow ir ow st1 else do let (c1,c2,c3) = ord3 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - loop ir' (ow+3) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + loop ir' (ow+3) st4 | otherwise -> do - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let (c1,c2,c3,c4) = ord4 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - writeWord8Buf oraw (ow+3) c4 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c4) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -- ----------------------------------------------------------------------------- -- UTF-8 primitives, lifted from Data.Text.Fusion.Utf8 ===================================== libraries/base/changelog.md ===================================== @@ -24,6 +24,8 @@ adding the class `Unsatisfiable :: ErrorMessage -> TypeError`` to `GHC.TypeError`, which provides a mechanism for custom type errors that reports the errors in a more predictable behaviour than ``TypeError``. + * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using + pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce0082dc5c00f5bba0bdd216ce387f2c7803bd71 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce0082dc5c00f5bba0bdd216ce387f2c7803bd71 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 12:13:02 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 15 May 2023 08:13:02 -0400 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] 43 commits: rts: Fix data-race in hs_init_ghc Message-ID: <646221ce11c2f_171ad96b9bae407558fd@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - e45a825f by Josh Meredith at 2023-05-15T12:11:37+00:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 4bab3a1b by Josh Meredith at 2023-05-15T12:12:39+00:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce0082dc5c00f5bba0bdd216ce387f2c7803bd71...4bab3a1b91c088e059724a1060e4eb4eb5cc12ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce0082dc5c00f5bba0bdd216ce387f2c7803bd71...4bab3a1b91c088e059724a1060e4eb4eb5cc12ee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 12:14:49 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 15 May 2023 08:14:49 -0400 Subject: [Git][ghc/ghc][wip/unboxed-codebuffer] Use unboxed codebuffers in base Message-ID: <6462223953c86_171ad9687fa1e4756041@gitlab.mail> Josh Meredith pushed to branch wip/unboxed-codebuffer at Glasgow Haskell Compiler / GHC Commits: 52a9b94d by Josh Meredith at 2023-05-15T12:14:23+00:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 9 changed files: - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/Encoding/Failure.hs - libraries/base/GHC/IO/Encoding/Iconv.hs - libraries/base/GHC/IO/Encoding/Latin1.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/IO/Encoding.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} ----------------------------------------------------------------------------- @@ -336,11 +337,13 @@ mkTextEncoding' cfm enc = latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8) -latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8 +latin1_encode input output = IO $ \st -> case Latin1.latin1_encode input output st of + (# st', _why, input', output' #) -> (# st', (input', output') #) -- unchecked, used for char8 --latin1_encode = unsafePerformIO $ do mkTextEncoder Iconv.latin1 >>= return.encode latin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer) -latin1_decode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_decode input output +latin1_decode input output = IO $ \st -> case Latin1.latin1_decode input output st of + (# st', _why, input', output' #) -> (# st', (input',output') #) --latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode unknownEncodingErr :: String -> IO a ===================================== libraries/base/GHC/IO/Encoding/CodePage/API.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, NondecreasingIndentation, - RecordWildCards, ScopedTypeVariables #-} + RecordWildCards, ScopedTypeVariables, + UnboxedTuples #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} module GHC.IO.Encoding.CodePage.API ( @@ -157,11 +158,15 @@ newCP rec fn cp = do utf16_native_encode' :: EncodeBuffer utf16_native_decode' :: DecodeBuffer #if defined(WORDS_BIGENDIAN) -utf16_native_encode' = utf16be_encode -utf16_native_decode' = utf16be_decode +utf16_native_encode' i o = IO $ \st -> case utf16be_encode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) +utf16_native_decode' i o = IO $ \st -> case utf16be_decode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) #else -utf16_native_encode' = utf16le_encode -utf16_native_decode' = utf16le_decode +utf16_native_encode' i o = IO $ \st -> case utf16le_encode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) +utf16_native_decode' i o = IO $ \st -> case utf16le_decode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) #endif saner :: CodeBuffer from to ===================================== libraries/base/GHC/IO/Encoding/Failure.hs ===================================== @@ -1,5 +1,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- | @@ -18,7 +21,8 @@ module GHC.IO.Encoding.Failure ( CodingFailureMode(..), codingFailureModeSuffix, isSurrogate, - recoverDecode, recoverEncode + recoverDecode, recoverEncode, + recoverDecode#, recoverEncode#, ) where import GHC.IO @@ -142,6 +146,12 @@ unescapeRoundtripCharacterSurrogate c | otherwise = Nothing where x = ord c +recoverDecode# :: CodingFailureMode -> Buffer Word8 -> Buffer Char + -> State# RealWorld -> (# State# RealWorld, Buffer Word8, Buffer Char #) +recoverDecode# cfm input output st = + let !(# st', (bIn, bOut) #) = unIO (recoverDecode cfm input output) st + in (# st', bIn, bOut #) + recoverDecode :: CodingFailureMode -> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char) recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } @@ -160,6 +170,12 @@ recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } ow' <- writeCharBuf oraw ow (escapeToRoundtripCharacterSurrogate b) return (input { bufL=ir+1 }, output { bufR=ow' }) +recoverEncode# :: CodingFailureMode -> Buffer Char -> Buffer Word8 + -> State# RealWorld -> (# State# RealWorld, Buffer Char, Buffer Word8 #) +recoverEncode# cfm input output st = + let !(# st', (bIn, bOut) #) = unIO (recoverEncode cfm input output) st + in (# st', bIn, bOut #) + recoverEncode :: CodingFailureMode -> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8) recoverEncode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } ===================================== libraries/base/GHC/IO/Encoding/Iconv.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE CPP , NoImplicitPrelude , NondecreasingIndentation + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} @@ -133,19 +135,24 @@ newIConv from to rec fn = withCAString to $ \ to_str -> do iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt - return BufferCodec{ - encode = fn iconvt, - recover = rec, - close = iclose, + fn_iconvt ibuf obuf st = case unIO (fn iconvt ibuf obuf) st of + (# st', (prog, ibuf', obuf') #) -> (# st', prog, ibuf', obuf' #) + return BufferCodec# { + encode# = fn_iconvt, + recover# = rec#, + close# = iclose, -- iconv doesn't supply a way to save/restore the state - getState = return (), - setState = const $ return () + getState# = return (), + setState# = const $ return () } + where + rec# ibuf obuf st = case unIO (rec ibuf obuf) st of + (# st', (ibuf', obuf') #) -> (# st', ibuf', obuf' #) -iconvDecode :: IConv -> DecodeBuffer +iconvDecode :: IConv -> Buffer Word8 -> Buffer Char -> IO (CodingProgress, Buffer Word8, Buffer Char) iconvDecode iconv_t ibuf obuf = iconvRecode iconv_t ibuf 0 obuf char_shift -iconvEncode :: IConv -> EncodeBuffer +iconvEncode :: IConv -> Buffer Char -> Buffer Word8 -> IO (CodingProgress, Buffer Char, Buffer Word8) iconvEncode iconv_t ibuf obuf = iconvRecode iconv_t ibuf char_shift obuf 0 iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int ===================================== libraries/base/GHC/IO/Encoding/Latin1.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE NoImplicitPrelude , BangPatterns , NondecreasingIndentation + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -56,22 +58,22 @@ mkLatin1 cfm = TextEncoding { textEncodingName = "ISO-8859-1", latin1_DF :: CodingFailureMode -> IO (TextDecoder ()) latin1_DF cfm = - return (BufferCodec { - encode = latin1_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) latin1_EF :: CodingFailureMode -> IO (TextEncoder ()) latin1_EF cfm = - return (BufferCodec { - encode = latin1_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) latin1_checked :: TextEncoding @@ -85,12 +87,12 @@ mkLatin1_checked cfm = TextEncoding { textEncodingName = "ISO-8859-1", latin1_checked_EF :: CodingFailureMode -> IO (TextEncoder ()) latin1_checked_EF cfm = - return (BufferCodec { - encode = latin1_checked_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_checked_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -- ----------------------------------------------------------------------------- @@ -108,22 +110,22 @@ mkAscii cfm = TextEncoding { textEncodingName = "ASCII", ascii_DF :: CodingFailureMode -> IO (TextDecoder ()) ascii_DF cfm = - return (BufferCodec { - encode = ascii_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = ascii_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) ascii_EF :: CodingFailureMode -> IO (TextEncoder ()) ascii_EF cfm = - return (BufferCodec { - encode = ascii_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = ascii_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) @@ -134,97 +136,115 @@ ascii_EF cfm = -- TODO: Eliminate code duplication between the checked and unchecked -- versions of the decoder or encoder (but don't change the Core!) -latin1_decode :: DecodeBuffer +latin1_decode :: DecodeBuffer# latin1_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 + !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -ascii_decode :: DecodeBuffer +ascii_decode :: DecodeBuffer# ascii_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - if c0 > 0x7f then invalid else do - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 + if c0 > 0x7f then invalid st1 else do + let !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -latin1_encode :: EncodeBuffer +latin1_encode :: EncodeBuffer# latin1_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - writeWord8Buf oraw ow (fromIntegral (ord c)) - loop ir' (ow+1) + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (ord c))) st1 + loop ir' (ow+1) st2 in - loop ir0 ow0 + loop ir0 ow0 st -latin1_checked_encode :: EncodeBuffer +latin1_checked_encode :: EncodeBuffer# latin1_checked_encode input output = single_byte_checked_encode 0xff input output -ascii_encode :: EncodeBuffer +ascii_encode :: EncodeBuffer# ascii_encode input output = single_byte_checked_encode 0x7f input output -single_byte_checked_encode :: Int -> EncodeBuffer +single_byte_checked_encode :: Int -> EncodeBuffer# single_byte_checked_encode max_legal_char input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if ord c > max_legal_char then invalid else do - writeWord8Buf oraw ow (fromIntegral (ord c)) - loop ir' (ow+1) + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if ord c > max_legal_char then invalid st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (ord c))) st1 + loop ir' (ow+1) st2 where - invalid = done InvalidSequence ir ow + invalid :: EncodingBuffer# + invalid st' = done InvalidSequence ir ow st' in - loop ir0 ow0 + loop ir0 ow0 st {-# INLINE single_byte_checked_encode #-} ===================================== libraries/base/GHC/IO/Encoding/UTF16.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -61,64 +62,66 @@ mkUTF16 cfm = TextEncoding { textEncodingName = "UTF-16", mkTextDecoder = utf16_DF cfm, mkTextEncoder = utf16_EF cfm } -utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) +utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#)) utf16_DF cfm = do seen_bom <- newIORef Nothing - return (BufferCodec { - encode = utf16_decode seen_bom, - recover = recoverDecode cfm, - close = return (), - getState = readIORef seen_bom, - setState = writeIORef seen_bom + return (BufferCodec# { + encode# = utf16_decode seen_bom, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef seen_bom, + setState# = writeIORef seen_bom }) utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf16_EF cfm = do done_bom <- newIORef False - return (BufferCodec { - encode = utf16_encode done_bom, - recover = recoverEncode cfm, - close = return (), - getState = readIORef done_bom, - setState = writeIORef done_bom + return (BufferCodec# { + encode# = utf16_encode done_bom, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef done_bom, + setState# = writeIORef done_bom }) -utf16_encode :: IORef Bool -> EncodeBuffer +utf16_encode :: IORef Bool -> EncodeBuffer# utf16_encode done_bom input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef done_bom - if b then utf16_native_encode input output + let !(# st1, b #) = unIO (readIORef done_bom) st0 + if b then utf16_native_encode input output st1 else if os - ow < 2 - then return (OutputUnderflow,input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef done_bom True - writeWord8Buf oraw ow bom1 - writeWord8Buf oraw (ow+1) bom2 - utf16_native_encode input output{ bufR = ow+2 } + let !(# st2, () #) = unIO (writeIORef done_bom True) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom2) st3 + utf16_native_encode input output{ bufR = ow+2 } st4 -utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer +utf16_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer# utf16_decode seen_bom input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - mb <- readIORef seen_bom + let !(# st1, mb #) = unIO (readIORef seen_bom) st0 case mb of - Just decode -> decode input output + Just decode -> decode input output st1 Nothing -> - if iw - ir < 2 then return (InputUnderflow,input,output) else do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) + if iw - ir < 2 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 case () of - _ | c0 == bomB && c1 == bomL -> do - writeIORef seen_bom (Just utf16be_decode) - utf16be_decode input{ bufL= ir+2 } output - | c0 == bomL && c1 == bomB -> do - writeIORef seen_bom (Just utf16le_decode) - utf16le_decode input{ bufL= ir+2 } output - | otherwise -> do - writeIORef seen_bom (Just utf16_native_decode) - utf16_native_decode input output + _ | c0 == bomB && c1 == bomL -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16be_decode)) st3 + in utf16be_decode input{ bufL= ir+2 } output st4 + | c0 == bomL && c1 == bomB -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16le_decode)) st3 + in utf16le_decode input{ bufL= ir+2 } output st4 + | otherwise -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16_native_decode)) st3 + in utf16_native_decode input output st4 bomB, bomL, bom1, bom2 :: Word8 @@ -126,10 +129,10 @@ bomB = 0xfe bomL = 0xff -- choose UTF-16BE by default for UTF-16 output -utf16_native_decode :: DecodeBuffer +utf16_native_decode :: DecodeBuffer# utf16_native_decode = utf16be_decode -utf16_native_encode :: EncodeBuffer +utf16_native_encode :: EncodeBuffer# utf16_native_encode = utf16be_encode bom1 = bomB @@ -149,22 +152,22 @@ mkUTF16be cfm = TextEncoding { textEncodingName = "UTF-16BE", utf16be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16be_DF cfm = - return (BufferCodec { - encode = utf16be_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16be_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16be_EF cfm = - return (BufferCodec { - encode = utf16be_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16be_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16le :: TextEncoding @@ -178,114 +181,127 @@ mkUTF16le cfm = TextEncoding { textEncodingName = "UTF16-LE", utf16le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16le_DF cfm = - return (BufferCodec { - encode = utf16le_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16le_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16le_EF cfm = - return (BufferCodec { - encode = utf16le_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16le_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -utf16be_decode :: DecodeBuffer +utf16be_decode :: DecodeBuffer# utf16be_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow - | ir + 1 == iw = done InputUnderflow ir ow + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | ir + 1 == iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 let x1 = fromIntegral c0 `shiftL` 8 + fromIntegral c1 if validate1 x1 - then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1)) - loop (ir+2) ow' - else if iw - ir < 4 then done InputUnderflow ir ow else do - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3 - if not (validate2 x1 x2) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 x1 x2) - loop (ir+4) ow' + then let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral x1))) st2 + in loop (ir+2) ow' st3 + else if iw - ir < 4 then done InputUnderflow ir ow st2 else do + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3 + if not (validate2 x1 x2) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr2 x1 x2)) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input { bufL = 0, bufR = 0 } else input { bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf16le_decode :: DecodeBuffer +utf16le_decode :: DecodeBuffer# utf16le_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow - | ir + 1 == iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | ir + 1 == iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 if validate1 x1 - then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1)) - loop (ir+2) ow' - else if iw - ir < 4 then done InputUnderflow ir ow else do - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 - if not (validate2 x1 x2) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 x1 x2) - loop (ir+4) ow' + then let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral x1))) st2 + in loop (ir+2) ow' st3 + else if iw - ir < 4 then done InputUnderflow ir ow st2 else do + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 + if not (validate2 x1 x2) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr2 x1 x2)) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf16be_encode :: EncodeBuffer +utf16be_encode :: EncodeBuffer# utf16be_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 2 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 2 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of - x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do - writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8)) - writeWord8Buf oraw (ow+1) (fromIntegral x) - loop ir' (ow+2) + x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8))) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) (fromIntegral x)) st2 + loop ir' (ow+2) st3 | otherwise -> do - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) @@ -294,35 +310,39 @@ utf16be_encode c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 -- - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - writeWord8Buf oraw (ow+3) c4 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c4) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -utf16le_encode :: EncodeBuffer +utf16le_encode :: EncodeBuffer# utf16le_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 2 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 2 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of - x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do - writeWord8Buf oraw ow (fromIntegral x) - writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8)) - loop ir' (ow+2) + x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))) st2 + loop ir' (ow+2) st3 | otherwise -> - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) @@ -331,13 +351,13 @@ utf16le_encode c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 -- - writeWord8Buf oraw ow c2 - writeWord8Buf oraw (ow+1) c1 - writeWord8Buf oraw (ow+2) c4 - writeWord8Buf oraw (ow+3) c3 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c2) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c4) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c3) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st chr2 :: Word16 -> Word16 -> Char chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#)) ===================================== libraries/base/GHC/IO/Encoding/UTF32.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -61,68 +62,70 @@ mkUTF32 cfm = TextEncoding { textEncodingName = "UTF-32", mkTextDecoder = utf32_DF cfm, mkTextEncoder = utf32_EF cfm } -utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) +utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#)) utf32_DF cfm = do seen_bom <- newIORef Nothing - return (BufferCodec { - encode = utf32_decode seen_bom, - recover = recoverDecode cfm, - close = return (), - getState = readIORef seen_bom, - setState = writeIORef seen_bom + return (BufferCodec# { + encode# = utf32_decode seen_bom, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef seen_bom, + setState# = writeIORef seen_bom }) utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf32_EF cfm = do done_bom <- newIORef False - return (BufferCodec { - encode = utf32_encode done_bom, - recover = recoverEncode cfm, - close = return (), - getState = readIORef done_bom, - setState = writeIORef done_bom + return (BufferCodec# { + encode# = utf32_encode done_bom, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef done_bom, + setState# = writeIORef done_bom }) -utf32_encode :: IORef Bool -> EncodeBuffer +utf32_encode :: IORef Bool -> EncodeBuffer# utf32_encode done_bom input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef done_bom - if b then utf32_native_encode input output + let !(# st1, b #) = unIO (readIORef done_bom) st0 + if b then utf32_native_encode input output st1 else if os - ow < 4 - then return (OutputUnderflow, input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef done_bom True - writeWord8Buf oraw ow bom0 - writeWord8Buf oraw (ow+1) bom1 - writeWord8Buf oraw (ow+2) bom2 - writeWord8Buf oraw (ow+3) bom3 - utf32_native_encode input output{ bufR = ow+4 } - -utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer + let !(# st2, () #) = unIO (writeIORef done_bom True) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom0) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+2) bom2) st4 + !(# st6, () #) = unIO (writeWord8Buf oraw (ow+3) bom3) st5 + utf32_native_encode input output{ bufR = ow+4 } st6 + +utf32_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer# utf32_decode seen_bom input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - mb <- readIORef seen_bom + let !(# st1, mb #) = unIO (readIORef seen_bom) st0 case mb of - Just decode -> decode input output + Just decode -> decode input output st1 Nothing -> - if iw - ir < 4 then return (InputUnderflow, input,output) else do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + if iw - ir < 4 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 + !(# st4, c2 #) = unIO (readWord8Buf iraw (ir+2)) st3 + !(# st5, c3 #) = unIO (readWord8Buf iraw (ir+3)) st4 case () of - _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> do - writeIORef seen_bom (Just utf32be_decode) - utf32be_decode input{ bufL= ir+4 } output - _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> do - writeIORef seen_bom (Just utf32le_decode) - utf32le_decode input{ bufL= ir+4 } output - | otherwise -> do - writeIORef seen_bom (Just utf32_native_decode) - utf32_native_decode input output + _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32be_decode)) st5 + in utf32be_decode input{ bufL= ir+4 } output st6 + _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32le_decode)) st5 + in utf32le_decode input{ bufL= ir+4 } output st6 + | otherwise -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32_native_decode)) st5 + in utf32_native_decode input output st6 bom0, bom1, bom2, bom3 :: Word8 @@ -132,10 +135,10 @@ bom2 = 0xfe bom3 = 0xff -- choose UTF-32BE by default for UTF-32 output -utf32_native_decode :: DecodeBuffer +utf32_native_decode :: DecodeBuffer# utf32_native_decode = utf32be_decode -utf32_native_encode :: EncodeBuffer +utf32_native_encode :: EncodeBuffer# utf32_native_encode = utf32be_encode -- ----------------------------------------------------------------------------- @@ -152,22 +155,22 @@ mkUTF32be cfm = TextEncoding { textEncodingName = "UTF-32BE", utf32be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf32be_DF cfm = - return (BufferCodec { - encode = utf32be_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32be_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf32be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf32be_EF cfm = - return (BufferCodec { - encode = utf32be_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32be_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) @@ -182,128 +185,145 @@ mkUTF32le cfm = TextEncoding { textEncodingName = "UTF-32LE", utf32le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf32le_DF cfm = - return (BufferCodec { - encode = utf32le_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32le_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf32le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf32le_EF cfm = - return (BufferCodec { - encode = utf32le_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32le_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -utf32be_decode :: DecodeBuffer +utf32be_decode :: DecodeBuffer# utf32be_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | iw - ir < 4 = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | iw - ir < 4 = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 let x1 = chr4 c0 c1 c2 c3 - if not (validate x1) then invalid else do - ow' <- writeCharBuf oraw ow x1 - loop (ir+4) ow' + if not (validate x1) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf32le_decode :: DecodeBuffer +utf32le_decode :: DecodeBuffer# utf32le_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | iw - ir < 4 = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | iw - ir < 4 = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 let x1 = chr4 c3 c2 c1 c0 - if not (validate x1) then invalid else do - ow' <- writeCharBuf oraw ow x1 - loop (ir+4) ow' + if not (validate x1) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf32be_encode :: EncodeBuffer +utf32be_encode :: EncodeBuffer# utf32be_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 4 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 4 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if isSurrogate c then done InvalidSequence ir ow else do + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if isSurrogate c then done InvalidSequence ir ow st1 else do let (c0,c1,c2,c3) = ord4 c - writeWord8Buf oraw ow c0 - writeWord8Buf oraw (ow+1) c1 - writeWord8Buf oraw (ow+2) c2 - writeWord8Buf oraw (ow+3) c3 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c0) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c2) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c3) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -utf32le_encode :: EncodeBuffer +utf32le_encode :: EncodeBuffer# utf32le_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 4 = done OutputUnderflow ir ow + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 4 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if isSurrogate c then done InvalidSequence ir ow else do + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if isSurrogate c then done InvalidSequence ir ow st1 else do let (c0,c1,c2,c3) = ord4 c - writeWord8Buf oraw ow c3 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c1 - writeWord8Buf oraw (ow+3) c0 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c3) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c0) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) = ===================================== libraries/base/GHC/IO/Encoding/UTF8.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -56,22 +57,22 @@ mkUTF8 cfm = TextEncoding { textEncodingName = "UTF-8", utf8_DF :: CodingFailureMode -> IO (TextDecoder ()) utf8_DF cfm = - return (BufferCodec { - encode = utf8_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf8_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf8_EF :: CodingFailureMode -> IO (TextEncoder ()) utf8_EF cfm = - return (BufferCodec { - encode = utf8_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf8_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf8_bom :: TextEncoding @@ -85,177 +86,188 @@ mkUTF8_bom cfm = TextEncoding { textEncodingName = "UTF-8BOM", utf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool) utf8_bom_DF cfm = do ref <- newIORef True - return (BufferCodec { - encode = utf8_bom_decode ref, - recover = recoverDecode cfm, - close = return (), - getState = readIORef ref, - setState = writeIORef ref + return (BufferCodec# { + encode# = utf8_bom_decode ref, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef ref, + setState# = writeIORef ref }) utf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf8_bom_EF cfm = do ref <- newIORef True - return (BufferCodec { - encode = utf8_bom_encode ref, - recover = recoverEncode cfm, - close = return (), - getState = readIORef ref, - setState = writeIORef ref + return (BufferCodec# { + encode# = utf8_bom_encode ref, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef ref, + setState# = writeIORef ref }) -utf8_bom_decode :: IORef Bool -> DecodeBuffer +utf8_bom_decode :: IORef Bool -> DecodeBuffer# utf8_bom_decode ref input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - first <- readIORef ref + let !(# st1, first #) = unIO (readIORef ref) st0 if not first - then utf8_decode input output + then utf8_decode input output st1 else do - let no_bom = do writeIORef ref False; utf8_decode input output - if iw - ir < 1 then return (InputUnderflow,input,output) else do - c0 <- readWord8Buf iraw ir + let no_bom = let !(# st', () #) = unIO (writeIORef ref False) st1 in utf8_decode input output st' + if iw - ir < 1 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir) st1 if (c0 /= bom0) then no_bom else do - if iw - ir < 2 then return (InputUnderflow,input,output) else do - c1 <- readWord8Buf iraw (ir+1) + if iw - ir < 2 then (# st2,InputUnderflow,input,output #) else do + let !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 if (c1 /= bom1) then no_bom else do - if iw - ir < 3 then return (InputUnderflow,input,output) else do - c2 <- readWord8Buf iraw (ir+2) + if iw - ir < 3 then (# st3,InputUnderflow,input,output #) else do + let !(# st4, c2 #) = unIO (readWord8Buf iraw (ir+2)) st3 if (c2 /= bom2) then no_bom else do -- found a BOM, ignore it and carry on - writeIORef ref False - utf8_decode input{ bufL = ir + 3 } output + let !(# st5, () #) = unIO (writeIORef ref False) st4 + utf8_decode input{ bufL = ir + 3 } output st5 -utf8_bom_encode :: IORef Bool -> EncodeBuffer +utf8_bom_encode :: IORef Bool -> EncodeBuffer# utf8_bom_encode ref input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef ref - if not b then utf8_encode input output + let !(# st1, b #) = unIO (readIORef ref) st0 + if not b then utf8_encode input output st1 else if os - ow < 3 - then return (OutputUnderflow,input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef ref False - writeWord8Buf oraw ow bom0 - writeWord8Buf oraw (ow+1) bom1 - writeWord8Buf oraw (ow+2) bom2 - utf8_encode input output{ bufR = ow+3 } + let !(# st2, () #) = unIO (writeIORef ref False) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom0) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+2) bom2) st4 + utf8_encode input output{ bufR = ow+3 } st5 bom0, bom1, bom2 :: Word8 bom0 = 0xef bom1 = 0xbb bom2 = 0xbf -utf8_decode :: DecodeBuffer +utf8_decode :: DecodeBuffer# utf8_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 case c0 of _ | c0 <= 0x7f -> do - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' - | c0 >= 0xc0 && c0 <= 0xc1 -> invalid -- Overlong forms + let !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 + | c0 >= 0xc0 && c0 <= 0xc1 -> invalid st1 -- Overlong forms | c0 >= 0xc2 && c0 <= 0xdf -> - if iw - ir < 2 then done InputUnderflow ir ow else do - c1 <- readWord8Buf iraw (ir+1) - if (c1 < 0x80 || c1 >= 0xc0) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 c0 c1) - loop (ir+2) ow' + if iw - ir < 2 then done InputUnderflow ir ow st1 else do + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + if (c1 < 0x80 || c1 >= 0xc0) then invalid st2 else do + let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (chr2 c0 c1)) st2 + loop (ir+2) ow' st3 | c0 >= 0xe0 && c0 <= 0xef -> case iw - ir of - 1 -> done InputUnderflow ir ow + 1 -> done InputUnderflow ir ow st1 2 -> do -- check for an error even when we don't have -- the full sequence yet (#3341) - c1 <- readWord8Buf iraw (ir+1) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 if not (validate3 c0 c1 0x80) - then invalid else done InputUnderflow ir ow + then invalid st2 else done InputUnderflow ir ow st2 _ -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - if not (validate3 c0 c1 c2) then invalid else do - ow' <- writeCharBuf oraw ow (chr3 c0 c1 c2) - loop (ir+3) ow' + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + if not (validate3 c0 c1 c2) then invalid st3 else do + let !(# st4, ow' #) = unIO (writeCharBuf oraw ow (chr3 c0 c1 c2)) st3 + loop (ir+3) ow' st4 | c0 >= 0xf0 -> case iw - ir of - 1 -> done InputUnderflow ir ow + 1 -> done InputUnderflow ir ow st1 2 -> do -- check for an error even when we don't have -- the full sequence yet (#3341) - c1 <- readWord8Buf iraw (ir+1) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 if not (validate4 c0 c1 0x80 0x80) - then invalid else done InputUnderflow ir ow + then invalid st2 else done InputUnderflow ir ow st2 3 -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 if not (validate4 c0 c1 c2 0x80) - then invalid else done InputUnderflow ir ow + then invalid st3 else done InputUnderflow ir ow st3 _ -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - if not (validate4 c0 c1 c2 c3) then invalid else do - ow' <- writeCharBuf oraw ow (chr4 c0 c1 c2 c3) - loop (ir+4) ow' + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + if not (validate4 c0 c1 c2 c3) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr4 c0 c1 c2 c3)) st4 + loop (ir+4) ow' st5 | otherwise -> - invalid + invalid st1 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0} else input{ bufL = ir } + !ro = output { bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf8_encode :: EncodeBuffer +utf8_encode :: EncodeBuffer# utf8_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of x | x <= 0x7F -> do - writeWord8Buf oraw ow (fromIntegral x) - loop ir' (ow+1) + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 + loop ir' (ow+1) st2 | x <= 0x07FF -> - if os - ow < 2 then done OutputUnderflow ir ow else do + if os - ow < 2 then done OutputUnderflow ir ow st1 else do let (c1,c2) = ord2 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - loop ir' (ow+2) - | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow else do - if os - ow < 3 then done OutputUnderflow ir ow else do + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + loop ir' (ow+2) st3 + | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow st1 else do + if os - ow < 3 then done OutputUnderflow ir ow st1 else do let (c1,c2,c3) = ord3 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - loop ir' (ow+3) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + loop ir' (ow+3) st4 | otherwise -> do - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let (c1,c2,c3,c4) = ord4 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - writeWord8Buf oraw (ow+3) c4 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c4) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -- ----------------------------------------------------------------------------- -- UTF-8 primitives, lifted from Data.Text.Fusion.Utf8 ===================================== libraries/base/changelog.md ===================================== @@ -28,6 +28,7 @@ * Add more instances for `Compose`: `Enum`, `Bounded`, `Num`, `Real`, `Integral` ([CLC proposal #160](https://github.com/haskell/core-libraries-committee/issues/160)) * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) + * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52a9b94df71dece6a18864e8255bf0ad7a838498 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52a9b94df71dece6a18864e8255bf0ad7a838498 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 15:27:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 11:27:19 -0400 Subject: [Git][ghc/ghc][master] Turn "ambiguous import" error into a panic Message-ID: <64624f572ca06_171ad96fa1e7707834d1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - 1 changed file: - compiler/GHC/Rename/Names.hs Changes: ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -1196,27 +1196,42 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } imp_occ_env = mkImportOccEnv hsc_env decl_spec all_avails - -- Look up a RdrName used in an import, failing if it is ambiguous - -- (e.g. because it refers to multiple record fields) - lookup_name :: IE GhcPs -> RdrName -> IELookupM ImpOccItem - lookup_name ie rdr = do - xs <- lookup_names ie rdr - case xs of - [cax] -> return cax - _ -> failLookupWith (AmbiguousImport rdr (map imp_item xs)) + -- Look up a parent (type constructor, class or data constructor) + -- in an import. + lookup_parent :: IE GhcPs -> RdrName -> IELookupM ImpOccItem + lookup_parent ie rdr = + assertPpr (not $ isVarNameSpace ns) + (vcat [ text "filterImports lookup_parent: unexpected variable" + , text "rdr:" <+> ppr rdr + , text "namespace:" <+> pprNameSpace ns ]) $ + do { xs <- lookup_names ie rdr + ; case xs of + cax :| [] -> return cax + _ -> pprPanic "filter_imports lookup_parent ambiguous" $ + vcat [ text "rdr:" <+> ppr rdr + , text "lookups:" <+> ppr (fmap imp_item xs) ] } + -- Looking up non-variables is always unambiguous, + -- as there can be at most one corresponding item + -- in the imp_occ_env. + -- See item (1) of Note [Exporting duplicate declarations] + -- in GHC.Tc.Gen.Export. + where + occ = rdrNameOcc rdr + ns = occNameSpace occ -- Look up a RdrName used in an import, returning multiple values if there -- are several fields with the same name exposed by the module - lookup_names :: IE GhcPs -> RdrName -> IELookupM [ImpOccItem] + lookup_names :: IE GhcPs -> RdrName -> IELookupM (NonEmpty ImpOccItem) lookup_names ie rdr | isQual rdr = failLookupWith (QualImportError rdr) - | null lookups - = failLookupWith (BadImport ie BadImportIsParent) | otherwise - = return $ concatMap nonDetNameEnvElts lookups + = case lookups of + [] -> failLookupWith (BadImport ie BadImportIsParent) + item:items -> return $ item :| items where - lookups = lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr) + lookups = concatMap nonDetNameEnvElts + $ lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr) lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])] lookup_lie (L loc ieRdr) @@ -1248,10 +1263,9 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) Succeeded a -> return (Just a) lookup_err_msg err = case err of - BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails - IllegalImport -> pure ImportLookupIllegal + BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails + IllegalImport -> pure ImportLookupIllegal QualImportError rdr -> pure (ImportLookupQualified rdr) - AmbiguousImport rdr xs -> pure (ImportLookupAmbiguous rdr xs) -- For each import item, we convert its RdrNames to Names, -- and at the same time compute all the GlobalRdrElt corresponding @@ -1269,12 +1283,12 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- See Note [Importing DuplicateRecordFields] xs <- lookup_names ie (ieWrappedName n) return ( [ (IEVar noExtField (L l (replaceWrappedName n name)), [gre]) - | ImpOccItem { imp_item = gre } <- xs + | ImpOccItem { imp_item = gre } <- NE.toList xs , let name = greName gre ] , [] ) IEThingAll _ (L l tc) -> do - ImpOccItem gre child_gres _ <- lookup_name ie $ ieWrappedName tc + ImpOccItem gre child_gres _ <- lookup_parent ie $ ieWrappedName tc let name = greName gre warns @@ -1299,19 +1313,19 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- Here the 'C' can be a data constructor -- *or* a type/class, or even both -> let tc = ieWrappedName tc' - tc_name = lookup_name ie tc - dc_name = lookup_name ie (setRdrNameSpace tc srcDataName) + tc_name = lookup_parent ie tc + dc_name = lookup_parent ie (setRdrNameSpace tc srcDataName) in case catIELookupM [ tc_name, dc_name ] of [] -> failLookupWith (BadImport ie BadImportIsParent) names -> return ([mkIEThingAbs tc' l (imp_item name) | name <- names], []) | otherwise - -> do ImpOccItem { imp_item = gre } <- lookup_name ie (ieWrappedName tc') + -> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc') return ([mkIEThingAbs tc' l gre], []) IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns -> do ImpOccItem { imp_item = gre, imp_bundled = subnames } - <- lookup_name (IEThingAbs noAnn ltc) (ieWrappedName rdr_tc) + <- lookup_parent (IEThingAbs noAnn ltc) (ieWrappedName rdr_tc) let name = greName gre -- Look up the children in the sub-names of the parent @@ -1358,7 +1372,6 @@ data IELookupError = QualImportError RdrName | BadImport (IE GhcPs) BadImportIsSubordinate | IllegalImport - | AmbiguousImport RdrName [GlobalRdrElt] -- e.g. a duplicated field name as a top-level import failLookupWith :: IELookupError -> IELookupM a failLookupWith err = Failed err View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b9e9300c3766a3ef4b19a2274ecc6e8c56fe86c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b9e9300c3766a3ef4b19a2274ecc6e8c56fe86c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 15:27:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 11:27:55 -0400 Subject: [Git][ghc/ghc][master] Unbreak some tests with latest GNU grep, which now warns about stray '\'. Message-ID: <64624f7bb9ae0_171ad96a04f78078687d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 4 changed files: - testsuite/tests/hsc2hs/Makefile - testsuite/tests/numeric/should_run/Makefile - testsuite/tests/numeric/should_run/T7014.primops - testsuite/tests/simplCore/should_compile/Makefile Changes: ===================================== testsuite/tests/hsc2hs/Makefile ===================================== @@ -52,9 +52,9 @@ T11004: T12504: '$(HSC2HS)' $(HSC2HS_OPTS) T12504/path/to/$@.hsc ifeq "$(WINDOWS)" "YES" - grep '{-# LINE 1 \"T12504\\\\path\\\\to\\\\$@\.hsc\" #-}' T12504/path/to/$@.hs + grep '{-# LINE 1 "T12504\\\\path\\\\to\\\\$@\.hsc" #-}' T12504/path/to/$@.hs else - grep '{-# LINE 1 \"T12504/path/to/$@\.hsc\" #-}' T12504/path/to/$@.hs + grep '{-# LINE 1 "T12504/path/to/$@\.hsc" #-}' T12504/path/to/$@.hs endif .PHONY: T15758 ===================================== testsuite/tests/numeric/should_run/Makefile ===================================== @@ -6,5 +6,5 @@ include $(TOP)/mk/test.mk T7014: rm -f T7014.simpl T7014.o T7014.hi '$(TEST_HC)' -Wall -v0 -O --make T7014.hs -fforce-recomp -ddump-simpl > T7014.simpl - ! grep -q -f T7014.primops T7014.simpl + ! grep -Eq -f T7014.primops T7014.simpl ./T7014 ===================================== testsuite/tests/numeric/should_run/T7014.primops ===================================== @@ -2,7 +2,7 @@ and# or# uncheckedShift.*# \+# -\-# +-# \*# quotInt# remInt# ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -254,7 +254,7 @@ str-rules: # g should have been collapsed into one defininition by CSE. .PHONY: T13340 T13340: - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13340.hs -ddump-simpl -dsuppress-all | grep -c '\+#' + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13340.hs -ddump-simpl -dsuppress-all | grep -Ec '\+#' # We expect to see all dictionaries specialized away. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e305e60cf507808fa31c456ef98295f8f7d00c9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e305e60cf507808fa31c456ef98295f8f7d00c9d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 15:59:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 11:59:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Turn "ambiguous import" error into a panic Message-ID: <646256cecd25_171ad9727818847934d0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - cda3c16b by sheaf at 2023-05-15T11:58:53-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 8d616842 by Sylvain Henry at 2023-05-15T11:59:04-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 36e08885 by Oleg Grenrus at 2023-05-15T11:59:04-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Platform.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Outputable.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6b1fe863df264586a91d398eeca46d29cc981d2...36e08885da884a924b05fecd3f4badb5c8cc75ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6b1fe863df264586a91d398eeca46d29cc981d2...36e08885da884a924b05fecd3f4badb5c8cc75ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 16:01:00 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 15 May 2023 12:01:00 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ROMES: WIP 3 Message-ID: <6462573ca3daa_171ad972afb3ac800477@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 0cc52a47 by Rodrigo Mesquita at 2023-05-15T17:00:53+01:00 ROMES: WIP 3 - - - - - 5 changed files: - hadrian/cfg/system.config.in - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fptools_set_haskell_platform_vars.m4 Changes: ===================================== hadrian/cfg/system.config.in ===================================== @@ -49,20 +49,30 @@ leading-underscore = @LeadingUnderscore@ # Information about build, host and target systems: #================================================== +# ROMES:TODO: Deal with vendor + build-platform = @BuildPlatform@ + build-arch = @BuildArch_CPP@ build-os = @BuildOS_CPP@ + build-vendor = @BuildVendor_CPP@ host-platform = @HostPlatform@ + +# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name. host-arch = @HostArch_CPP@ host-os = @HostOS_CPP@ + host-vendor = @HostVendor_CPP@ target-platform = @TargetPlatform@ target-platform-full = @TargetPlatformFull@ + +# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name. target-arch = @TargetArch_CPP@ target-os = @TargetOS_CPP@ + target-vendor = @TargetVendor_CPP@ llvm-target = @LLVMTarget_CPP@ @@ -75,7 +85,7 @@ ghc-major-version = @GhcMajVersion@ ghc-minor-version = @GhcMinVersion@ ghc-patch-level = @GhcPatchLevel@ -bootstrap-threaded-rts = @GhcThreadedRts@ +bootstrap-threaded-rts = @GhcThreadedRts@ project-name = @ProjectName@ project-version = @ProjectVersion@ @@ -86,35 +96,6 @@ project-patch-level1 = @ProjectPatchLevel1@ project-patch-level2 = @ProjectPatchLevel2@ project-git-commit-id = @ProjectGitCommitId@ -# Compilation and linking flags: -#=============================== - -conf-cc-args-stage0 = @CONF_CC_OPTS_STAGE0@ -conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ -conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ -conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ - -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - -conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ -conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ -conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ -conf-gcc-linker-args-stage3 = @CONF_GCC_LINKER_OPTS_STAGE3@ - -conf-ld-linker-args-stage0 = @CONF_LD_LINKER_OPTS_STAGE0@ -conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ -conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ -conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ - -conf-merge-objects-args-stage0 = @MergeObjsArgs@ -conf-merge-objects-args-stage1 = @MergeObjsArgs@ -conf-merge-objects-args-stage2 = @MergeObjsArgs@ -conf-merge-objects-args-stage3 = @MergeObjsArgs@ - - # Settings: #========== @@ -126,6 +107,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-is-gnu-ld = @LdIsGNULd@ +# ROMES:TODO: Drop almost every of these from settings. settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ ===================================== hadrian/src/Hadrian/Oracles/TextFile.hs ===================================== @@ -163,5 +163,5 @@ instance Hashable Toolchain.Target where hashWithSalt s = hashWithSalt s . show instance NFData Toolchain.Target where - rnf = flip seq () -- ROMES:TODO: Is this a good enough instance? + rnf = flip seq () -- ROMES:TODO: Would be better to do this well, but it isn't easy to make instances for Target ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -135,6 +135,8 @@ data ToolchainSetting -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the -- result. +-- ROMES:TODO: Things that are gotten from the toolchain configs will no longer +-- be part of settings, so they should be moved out setting :: Setting -> Action String setting key = case key of BuildArch -> systemConf "build-arch" @@ -153,7 +155,6 @@ setting key = case key of GhcSourcePath -> systemConf "ghc-source-path" GmpIncludeDir -> systemConf "gmp-include-dir" GmpLibDir -> systemConf "gmp-lib-dir" - -- ROMES:TODO: What's the difference between hostArch and hostArchHaskell? HostArch -> systemConf "host-arch" HostOs -> systemConf "host-os" HostPlatform -> systemConf "host-platform" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -362,6 +362,9 @@ cppify :: String -> String cppify = replaceEq '-' '_' . replaceEq '.' '_' -- | Generate @ghcplatform.h@ header. +-- ROMES:TODO: These will eventually have to be determined at runtime, and no +-- longer hardcoded to a file (passed as -D flags to the preprocessor, +-- probably) generateGhcPlatformH :: Expr String generateGhcPlatformH = do trackGenerateHs ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -40,4 +40,7 @@ AC_DEFUN([GHC_SUBSECTIONS_VIA_SYMBOLS], AC_MSG_RESULT(no)]) ]) -# ROMES:TODO: We can't still remove this because of the DEFINE HAVE_SUBSECTIONS_VIA_SYMBOLS 1, which is used in the rts +# ROMES:TODO: We can't still remove this because of the #DEFINE HAVE_SUBSECTIONS_VIA_SYMBOLS 1, which is used in the rts +# We might have to generate a bunch of -D CPP flags to satisfy these dependencies (future work). + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cc52a47ffb63f6e3dfd79d48cf1100e383e32cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cc52a47ffb63f6e3dfd79d48cf1100e383e32cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 16:30:32 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 15 May 2023 12:30:32 -0400 Subject: [Git][ghc/ghc][wip/T23083] 4 commits: ANFise string literal arguments (#23270) Message-ID: <64625e2892e3c_171ad9727818848069ef@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 949efd62 by Sebastian Graf at 2023-05-15T18:30:26+02:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Fixes #23270. - - - - - 61552353 by Sebastian Graf at 2023-05-15T18:30:26+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - d59f633c by Sebastian Graf at 2023-05-15T18:30:26+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - ccc5024e by Sebastian Graf at 2023-05-15T18:30:26+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Utils/Trace.hs - docs/users_guide/using-optimisation.rst - libraries/base/Unsafe/Coerce.hs - libraries/ghc-bignum/ghc-bignum.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fc83c9106657a7927428689a3d0077077032f36...ccc5024ed5740ab0b92a92049df09a1220b15ce4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fc83c9106657a7927428689a3d0077077032f36...ccc5024ed5740ab0b92a92049df09a1220b15ce4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 17:02:11 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 15 May 2023 13:02:11 -0400 Subject: [Git][ghc/ghc][wip/T23083] 4 commits: ANFise string literal arguments (#23270) Message-ID: <64626593c1303_171ad972f7086081209f@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 90d7b5af by Sebastian Graf at 2023-05-15T19:02:05+02:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Fixes #23270. - - - - - 319207d6 by Sebastian Graf at 2023-05-15T19:02:05+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - f1d7d498 by Sebastian Graf at 2023-05-15T19:02:05+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - 7e299449 by Sebastian Graf at 2023-05-15T19:02:05+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Utils/Trace.hs - docs/users_guide/using-optimisation.rst - libraries/base/Unsafe/Coerce.hs - libraries/ghc-bignum/ghc-bignum.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ccc5024ed5740ab0b92a92049df09a1220b15ce4...7e299449d425bff43ec85b7684928bf775aac32f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ccc5024ed5740ab0b92a92049df09a1220b15ce4...7e299449d425bff43ec85b7684928bf775aac32f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 17:49:13 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 15 May 2023 13:49:13 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: ROMES: WIP 3 Message-ID: <6462709913248_171ad972f70860821846@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 3ffeaa32 by Rodrigo Mesquita at 2023-05-15T18:27:37+01:00 ROMES: WIP 3 - - - - - f83f08a9 by Rodrigo Mesquita at 2023-05-15T18:28:50+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 18 changed files: - hadrian/cfg/system.config.in - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - hadrian/src/Settings/Builders/Ld.hs - hadrian/src/Settings/Builders/MergeObjects.hs - m4/fptools_set_haskell_platform_vars.m4 Changes: ===================================== hadrian/cfg/system.config.in ===================================== @@ -49,20 +49,30 @@ leading-underscore = @LeadingUnderscore@ # Information about build, host and target systems: #================================================== +# ROMES:TODO: Deal with vendor + build-platform = @BuildPlatform@ + build-arch = @BuildArch_CPP@ build-os = @BuildOS_CPP@ + build-vendor = @BuildVendor_CPP@ host-platform = @HostPlatform@ + +# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name. host-arch = @HostArch_CPP@ host-os = @HostOS_CPP@ + host-vendor = @HostVendor_CPP@ target-platform = @TargetPlatform@ target-platform-full = @TargetPlatformFull@ + +# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name. target-arch = @TargetArch_CPP@ target-os = @TargetOS_CPP@ + target-vendor = @TargetVendor_CPP@ llvm-target = @LLVMTarget_CPP@ @@ -75,7 +85,7 @@ ghc-major-version = @GhcMajVersion@ ghc-minor-version = @GhcMinVersion@ ghc-patch-level = @GhcPatchLevel@ -bootstrap-threaded-rts = @GhcThreadedRts@ +bootstrap-threaded-rts = @GhcThreadedRts@ project-name = @ProjectName@ project-version = @ProjectVersion@ @@ -86,35 +96,6 @@ project-patch-level1 = @ProjectPatchLevel1@ project-patch-level2 = @ProjectPatchLevel2@ project-git-commit-id = @ProjectGitCommitId@ -# Compilation and linking flags: -#=============================== - -conf-cc-args-stage0 = @CONF_CC_OPTS_STAGE0@ -conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ -conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ -conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ - -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - -conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ -conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ -conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ -conf-gcc-linker-args-stage3 = @CONF_GCC_LINKER_OPTS_STAGE3@ - -conf-ld-linker-args-stage0 = @CONF_LD_LINKER_OPTS_STAGE0@ -conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ -conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ -conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ - -conf-merge-objects-args-stage0 = @MergeObjsArgs@ -conf-merge-objects-args-stage1 = @MergeObjsArgs@ -conf-merge-objects-args-stage2 = @MergeObjsArgs@ -conf-merge-objects-args-stage3 = @MergeObjsArgs@ - - # Settings: #========== @@ -126,6 +107,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-is-gnu-ld = @LdIsGNULd@ +# ROMES:TODO: Drop almost every of these from settings. settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ ===================================== hadrian/src/Context.hs ===================================== @@ -3,7 +3,7 @@ module Context ( Context (..), vanillaContext, stageContext, -- * Expressions - getStage, getPackage, getWay, getStagedSettingList, getBuildPath, getPackageDbLoc, + getStage, getPackage, getWay, getBuildPath, getPackageDbLoc, getStagedTargetConfig, -- * Paths contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir, @@ -19,6 +19,7 @@ import Context.Type import Hadrian.Expression import Hadrian.Haskell.Cabal import Oracles.Setting +import GHC.Toolchain.Target (Target) -- | Most targets are built only one way, hence the notion of 'vanillaContext'. vanillaContext :: Stage -> Package -> Context @@ -47,9 +48,9 @@ getPackage = package <$> getContext getWay :: Expr Context b Way getWay = way <$> getContext --- | Get a list of configuration settings for the current stage. -getStagedSettingList :: (Stage -> SettingList) -> Args Context b -getStagedSettingList f = getSettingList . f =<< getStage +-- | Get the 'Target' configuration of the current stage +getStagedTargetConfig :: Expr Context b Target +getStagedTargetConfig = expr . targetConfigStage =<< getStage -- | Path to the directory containing the final artifact in a given 'Context'. libPath :: Context -> Action FilePath @@ -95,7 +96,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile context at Context {..} = do +pkgHaddockFile Context {..} = do root <- buildRoot version <- pkgUnitId stage package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" @@ -136,7 +137,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile context at Context {..} = do +pkgConfFile Context {..} = do pid <- pkgUnitId stage package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -31,7 +31,6 @@ import Way import Packages import Development.Shake.Classes import Control.Monad -import Utilities import Base import Context import System.Directory.Extra (listFilesRecursive) ===================================== hadrian/src/Hadrian/Oracles/TextFile.hs ===================================== @@ -91,6 +91,7 @@ getTargetConfig :: FilePath -> Action Toolchain.Target getTargetConfig file = askOracle $ TargetFile file -- | Get the host's target configuration through 'getTarget' +-- ROMES:TODO: Rename HOST to BUILD getHostTargetConfig :: Action Toolchain.Target getHostTargetConfig = getTargetConfig hostTargetFile -- where @@ -163,5 +164,5 @@ instance Hashable Toolchain.Target where hashWithSalt s = hashWithSalt s . show instance NFData Toolchain.Target where - rnf = flip seq () -- ROMES:TODO: Is this a good enough instance? + rnf = flip seq () -- ROMES:TODO: Would be better to do this well, but it isn't easy to make instances for Target ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -1,13 +1,12 @@ module Oracles.Setting ( configFile, -- * Settings - Setting (..), SettingList (..), setting, settingList, getSetting, - getSettingList, + Setting (..), setting, getSetting, ToolchainSetting (..), settingsFileSetting, -- * Helpers ghcCanonVersion, cmdLineLengthLimit, hostSupportsRPaths, topDirectory, - libsuf, ghcVersionStage, bashPath, + libsuf, ghcVersionStage, bashPath, targetConfigStage, -- ** Target platform things anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs, @@ -85,23 +84,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). --- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, --- generated by the @configure@ script from the input file --- @hadrian/cfg/system.config.in at . For example, the line --- --- > hs-cpp-args = -E -undef -traditional --- --- sets the value of 'HsCppArgs'. The action 'settingList' 'HsCppArgs' looks up --- the value of the setting and returns the list of strings --- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. -data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage - | ConfGccLinkerArgs Stage - | ConfLdLinkerArgs Stage - | ConfMergeObjectsArgs Stage - | HsCppArgs - -- TODO compute solely in Hadrian, removing these variables' definitions -- from aclocal.m4 whenever they can be calculated from other variables -- already fed into Hadrian. @@ -135,6 +117,8 @@ data ToolchainSetting -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the -- result. +-- ROMES:TODO: Things that are gotten from the toolchain configs will no longer +-- be part of settings, so they should be moved out setting :: Setting -> Action String setting key = case key of BuildArch -> systemConf "build-arch" @@ -153,7 +137,6 @@ setting key = case key of GhcSourcePath -> systemConf "ghc-source-path" GmpIncludeDir -> systemConf "gmp-include-dir" GmpLibDir -> systemConf "gmp-lib-dir" - -- ROMES:TODO: What's the difference between hostArch and hostArchHaskell? HostArch -> systemConf "host-arch" HostOs -> systemConf "host-os" HostPlatform -> systemConf "host-platform" @@ -193,21 +176,6 @@ setting key = case key of archStr = stringEncodeArch . archOS_arch . tgtArchOs osStr = stringEncodeOS . archOS_OS . tgtArchOs -bootIsStage0 :: Stage -> Stage -bootIsStage0 (Stage0 {}) = Stage0 InTreeLibs -bootIsStage0 s = s - --- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the --- result. -settingList :: SettingList -> Action [String] -settingList key = fmap words $ lookupSystemConfig $ case key of - ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) - ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) - ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) - ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) - HsCppArgs -> "hs-cpp-args" - -- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the -- result. -- See Note [tooldir: How GHC finds mingw on Windows] @@ -251,11 +219,6 @@ getSetting = expr . setting bashPath :: Action FilePath bashPath = setting BourneShell --- | An expression that looks up the value of a 'SettingList' in --- @cfg/system.config@, tracking the result. -getSettingList :: SettingList -> Args c b -getSettingList = expr . settingList - -- | Check whether the value of a 'Setting' matches one of the given strings. matchSetting :: Setting -> [String] -> Action Bool matchSetting key values = (`elem` values) <$> setting key @@ -370,3 +333,11 @@ libsuf st way version <- ghcVersionStage st -- e.g. 8.4.4 or 8.9.xxxx let suffix = waySuffix (removeWayUnit Dynamic way) return (suffix ++ "-ghc" ++ version ++ extension) + +targetConfigStage :: Stage -> Action Target +-- ROMES:TODO: First iteration, only make it work for BUILD=HOST=TARGET +targetConfigStage (Stage0 {}) = getHostTargetConfig +targetConfigStage (Stage1 {}) = getHostTargetConfig +targetConfigStage (Stage2 {}) = getHostTargetConfig +targetConfigStage (Stage3 {}) = getHostTargetConfig + ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -15,6 +15,8 @@ import Target import Utilities import qualified System.Directory.Extra as IO import Data.Either +import GHC.Toolchain (ccProgram, tgtCCompiler, ccLinkProgram, tgtCCompilerLink) +import GHC.Toolchain.Program (prgFlags) {- Note [Binary distributions] @@ -418,11 +420,11 @@ commonWrapper = pure $ "exec \"$executablename\" ${1+\"$@\"}\n" -- echo 'HSC2HS_EXTRA="$(addprefix --cflag=,$(CONF_CC_OPTS_STAGE1)) $(addprefix --lflag=,$(CONF_GCC_LINKER_OPTS_STAGE1))"' >> "$(WRAPPER)" hsc2hsWrapper :: Action String hsc2hsWrapper = do - ccArgs <- map ("--cflag=" <>) <$> settingList (ConfCcArgs Stage1) - ldFlags <- map ("--lflag=" <>) <$> settingList (ConfGccLinkerArgs Stage1) + ccArgs <- map ("--cflag=" <>) . prgFlags . ccProgram . tgtCCompiler <$> targetConfigStage Stage1 + linkFlags <- map ("--lflag=" <>) . prgFlags . ccLinkProgram . tgtCCompilerLink <$> targetConfigStage Stage1 wrapper <- drop 4 . lines <$> liftIO (readFile "utils/hsc2hs/hsc2hs.wrapper") return $ unlines - ( "HSC2HS_EXTRA=\"" <> unwords (ccArgs ++ ldFlags) <> "\"" + ( "HSC2HS_EXTRA=\"" <> unwords (ccArgs ++ linkFlags) <> "\"" : "tflag=\"--template=$libdir/template-hsc.h\"" : "Iflag=\"-I$includedir/\"" : wrapper ) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -362,6 +362,9 @@ cppify :: String -> String cppify = replaceEq '-' '_' . replaceEq '.' '_' -- | Generate @ghcplatform.h@ header. +-- ROMES:TODO: These will eventually have to be determined at runtime, and no +-- longer hardcoded to a file (passed as -D flags to the preprocessor, +-- probably) generateGhcPlatformH :: Expr String generateGhcPlatformH = do trackGenerateHs ===================================== hadrian/src/Rules/Gmp.hs ===================================== @@ -12,6 +12,8 @@ import Utilities import Hadrian.BuildPath import Hadrian.Expression import Settings.Builders.Common (cArgs) +import GHC.Toolchain (ccProgram, tgtCCompiler) +import GHC.Toolchain.Program -- | Build in-tree GMP library objects (if GmpInTree flag is set) and return -- their paths. @@ -122,7 +124,7 @@ gmpRules = do let gmpBuildP = takeDirectory mk gmpP = takeDirectory gmpBuildP ctx <- makeGmpPathContext gmpP - cFlags <- interpretInContext ctx $ mconcat [ cArgs, getStagedSettingList ConfCcArgs ] + cFlags <- interpretInContext ctx $ mconcat [ cArgs, prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig ] env <- sequence [ builderEnvironment "CC" $ Cc CompileC (stage ctx) , return . AddEnv "CFLAGS" $ unwords cFlags ===================================== hadrian/src/Rules/Libffi.hs ===================================== @@ -12,6 +12,8 @@ import Packages import Settings.Builders.Common import Target import Utilities +import GHC.Toolchain (ccProgram, tgtCCompiler) +import GHC.Toolchain.Program {- Note [Libffi indicating inputs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -131,7 +133,7 @@ configureEnvironment stage = do context <- libffiContext stage cFlags <- interpretInContext context $ mconcat [ cArgs - , getStagedSettingList ConfCcArgs ] + , prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig ] ldFlags <- interpretInContext context ldArgs sequence [ builderEnvironment "CC" $ Cc CompileC stage , builderEnvironment "CXX" $ Cc CompileC stage ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -13,6 +13,8 @@ import Control.Exception (assert) import qualified Data.Set as Set import System.Directory import Settings.Program (programContext) +import GHC.Toolchain (ccProgram, tgtCCompiler, ccLinkProgram, tgtCCompilerLink) +import GHC.Toolchain.Program (prgFlags) cabalBuilderArgs :: Args cabalBuilderArgs = cabalSetupArgs <> cabalInstallArgs @@ -166,9 +168,9 @@ libraryArgs = do -- | Configure args with stage/lib specific include directories and settings configureStageArgs :: Args configureStageArgs = do - let cFlags = getStagedSettingList ConfCcArgs - ldFlags = getStagedSettingList ConfGccLinkerArgs - mconcat [ configureArgs cFlags ldFlags + let cFlags = prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig + linkFlags = prgFlags . ccLinkProgram . tgtCCompilerLink <$> getStagedTargetConfig + mconcat [ configureArgs cFlags linkFlags , notStage0 ? arg "--ghc-option=-ghcversion-file=rts/include/ghcversion.h" ] @@ -184,7 +186,7 @@ configureArgs cFlags' ldFlags' = do not (null values) ? arg ("--configure-option=" ++ key ++ "=" ++ values) cFlags = mconcat [ remove ["-Werror"] cArgs - , getStagedSettingList ConfCcArgs + , prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig -- See https://github.com/snowleopard/hadrian/issues/523 , arg $ "-iquote" ===================================== hadrian/src/Settings/Builders/Cc.hs ===================================== @@ -2,13 +2,15 @@ module Settings.Builders.Cc (ccBuilderArgs) where import Hadrian.Haskell.Cabal.Type import Settings.Builders.Common +import GHC.Toolchain (tgtCCompiler, ccProgram) +import GHC.Toolchain.Program ccBuilderArgs :: Args ccBuilderArgs = do way <- getWay builder Cc ? mconcat [ getContextData ccOpts - , getStagedSettingList ConfCcArgs + , prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig , builder (Cc CompileC) ? mconcat [ arg "-Wall" ===================================== hadrian/src/Settings/Builders/DeriveConstants.hs ===================================== @@ -5,6 +5,8 @@ module Settings.Builders.DeriveConstants ( import Builder import Packages import Settings.Builders.Common +import GHC.Toolchain (tgtCCompiler, ccProgram) +import GHC.Toolchain.Program deriveConstantsPairs :: [(String, String)] deriveConstantsPairs = @@ -41,7 +43,7 @@ includeCcArgs = do rtsPath <- expr $ rtsBuildPath stage mconcat [ cArgs , cWarnings - , getSettingList $ ConfCcArgs Stage1 + , prgFlags . ccProgram . tgtCCompiler <$> expr (targetConfigStage Stage1) , flag GhcUnregisterised ? arg "-DUSE_MINIINTERPRETER" , arg "-Irts" , arg "-Irts/include" ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -14,6 +14,8 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra +import GHC.Toolchain (ccProgram, tgtCCompiler, cppProgram, tgtCPreprocessor) +import GHC.Toolchain.Program ghcBuilderArgs :: Args ghcBuilderArgs = mconcat @@ -36,8 +38,8 @@ toolArgs = do builder (Ghc ToolArgs) ? mconcat [ packageGhcArgs , includeGhcArgs - , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs + , map ("-optc" ++) <$> getStagedCCFlags + , map ("-optP" ++) <$> getStagedCPPFlags , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -69,7 +71,7 @@ compileC :: Args compileC = builder (Ghc CompileCWithGhc) ? do way <- getWay let ccArgs = [ getContextData ccOpts - , getStagedSettingList ConfCcArgs + , getStagedCCFlags , cIncludeArgs , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ] mconcat [ arg "-Wall" @@ -86,7 +88,7 @@ compileCxx :: Args compileCxx = builder (Ghc CompileCppWithGhc) ? do way <- getWay let ccArgs = [ getContextData cxxOpts - , getStagedSettingList ConfCcArgs + , getStagedCCFlags , cIncludeArgs , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ] mconcat [ arg "-Wall" @@ -216,8 +218,8 @@ commonGhcArgs = do -- to the @ghc-version@ file, to prevent GHC from trying to open the -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" - , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs + , map ("-optc" ++) <$> getStagedCCFlags + , map ("-optP" ++) <$> getStagedCPPFlags , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is @@ -290,3 +292,10 @@ includeGhcArgs = do , pure [ "-i" ++ d | d <- abSrcDirs ] , cIncludeArgs , pure ["-optP-include", "-optP" ++ cabalMacros] ] + +-- Utilities +getStagedCCFlags :: Args +getStagedCCFlags = prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig + +getStagedCPPFlags :: Args +getStagedCPPFlags = prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig ===================================== hadrian/src/Settings/Builders/HsCpp.hs ===================================== @@ -2,12 +2,14 @@ module Settings.Builders.HsCpp (hsCppBuilderArgs) where import Packages import Settings.Builders.Common +import GHC.Toolchain +import GHC.Toolchain.Program hsCppBuilderArgs :: Args hsCppBuilderArgs = builder HsCpp ? do stage <- getStage ghcPath <- expr $ buildPath (vanillaContext stage compiler) - mconcat [ getSettingList HsCppArgs + mconcat [ prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig -- ROMES:TODO: HsCppArgs, not CppArgs, make sure this is the case , arg "-P" , arg "-Irts/include" , arg $ "-I" ++ ghcPath ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -5,6 +5,8 @@ import Hadrian.Haskell.Cabal.Type import Builder import Packages import Settings.Builders.Common +import GHC.Toolchain (tgtCCompiler, ccProgram, tgtCPreprocessor, cppProgram, tgtCCompilerLink, ccLinkProgram) +import GHC.Toolchain.Program hsc2hsBuilderArgs :: Args hsc2hsBuilderArgs = builder Hsc2Hs ? do @@ -49,8 +51,8 @@ getCFlags = do autogen <- expr $ autogenPath context let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] - mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs + mconcat [ remove ["-O"] (cArgs <> (prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig)) + , prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig -- ROMES:TODO: CppArgs, not HsCppArgs, make sure this is the case , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. @@ -61,7 +63,7 @@ getCFlags = do getLFlags :: Expr [String] getLFlags = - mconcat [ getStagedSettingList ConfGccLinkerArgs + mconcat [ prgFlags . ccLinkProgram . tgtCCompilerLink <$> getStagedTargetConfig , ldArgs , getContextData ldOpts , getContextData depLdOpts ] ===================================== hadrian/src/Settings/Builders/Ld.hs ===================================== @@ -1,8 +1,10 @@ module Settings.Builders.Ld (ldBuilderArgs) where import Settings.Builders.Common +import GHC.Toolchain +import GHC.Toolchain.Program ldBuilderArgs :: Args -ldBuilderArgs = builder Ld ? mconcat [ getStagedSettingList ConfLdLinkerArgs +ldBuilderArgs = builder Ld ? mconcat [ prgFlags . ccLinkProgram . tgtCCompilerLink <$> getStagedTargetConfig , arg "-o", arg =<< getOutput , getInputs ] ===================================== hadrian/src/Settings/Builders/MergeObjects.hs ===================================== @@ -1,9 +1,11 @@ module Settings.Builders.MergeObjects (mergeObjectsBuilderArgs) where import Settings.Builders.Common +import GHC.Toolchain +import GHC.Toolchain.Program mergeObjectsBuilderArgs :: Args mergeObjectsBuilderArgs = builder MergeObjects ? mconcat - [ getStagedSettingList ConfMergeObjectsArgs + [ (maybe [] (prgFlags . mergeObjsProgram) . tgtMergeObjs) <$> getStagedTargetConfig , arg "-o", arg =<< getOutput , getInputs ] ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -40,4 +40,7 @@ AC_DEFUN([GHC_SUBSECTIONS_VIA_SYMBOLS], AC_MSG_RESULT(no)]) ]) -# ROMES:TODO: We can't still remove this because of the DEFINE HAVE_SUBSECTIONS_VIA_SYMBOLS 1, which is used in the rts +# ROMES:TODO: We can't still remove this because of the #DEFINE HAVE_SUBSECTIONS_VIA_SYMBOLS 1, which is used in the rts +# We might have to generate a bunch of -D CPP flags to satisfy these dependencies (future work). + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0cc52a47ffb63f6e3dfd79d48cf1100e383e32cc...f83f08a950d6f3a8bcf04289402e51d89c04bc4f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0cc52a47ffb63f6e3dfd79d48cf1100e383e32cc...f83f08a950d6f3a8bcf04289402e51d89c04bc4f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 18:01:46 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 15 May 2023 14:01:46 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Fix host-[os|arch] vs host-haskell-[os|arch] Message-ID: <6462738aefb41_171ad97568a24882357a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f9272173 by Rodrigo Mesquita at 2023-05-15T19:01:41+01:00 Fix host-[os|arch] vs host-haskell-[os|arch] - - - - - 4 changed files: - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - m4/fptools_set_platform_vars.m4 Changes: ===================================== configure.ac ===================================== @@ -482,10 +482,8 @@ AC_ARG_WITH(hs-cpp-flags, AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +dnl ROMES:TODO: Are we setting the C99 flags in ghc-toolchain already? FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) -FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) dnl ** Which ld to use dnl -------------------------------------------------------------- ===================================== hadrian/cfg/system.config.in ===================================== @@ -52,27 +52,13 @@ leading-underscore = @LeadingUnderscore@ # ROMES:TODO: Deal with vendor build-platform = @BuildPlatform@ - -build-arch = @BuildArch_CPP@ -build-os = @BuildOS_CPP@ - build-vendor = @BuildVendor_CPP@ host-platform = @HostPlatform@ - -# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name. -host-arch = @HostArch_CPP@ -host-os = @HostOS_CPP@ - host-vendor = @HostVendor_CPP@ target-platform = @TargetPlatform@ target-platform-full = @TargetPlatformFull@ - -# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name. -target-arch = @TargetArch_CPP@ -target-os = @TargetOS_CPP@ - target-vendor = @TargetVendor_CPP@ llvm-target = @LLVMTarget_CPP@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -137,12 +137,12 @@ setting key = case key of GhcSourcePath -> systemConf "ghc-source-path" GmpIncludeDir -> systemConf "gmp-include-dir" GmpLibDir -> systemConf "gmp-lib-dir" - HostArch -> systemConf "host-arch" - HostOs -> systemConf "host-os" + HostArch -> hostConf archStr + HostOs -> hostConf osStr HostPlatform -> systemConf "host-platform" HostVendor -> systemConf "host-vendor" - HostArchHaskell -> hostConf archStr - HostOsHaskell -> hostConf osStr + HostArchHaskell -> hostConf (show . archHaskell) + HostOsHaskell -> hostConf (show . osHaskell) IconvIncludeDir -> systemConf "iconv-include-dir" IconvLibDir -> systemConf "iconv-lib-dir" LibdwIncludeDir -> systemConf "libdw-include-dir" @@ -159,22 +159,24 @@ setting key = case key of ProjectPatchLevel1 -> systemConf "project-patch-level1" ProjectPatchLevel2 -> systemConf "project-patch-level2" SystemGhc -> systemConf "system-ghc" - TargetArch -> systemConf "target-arch" + TargetArch -> targetConf archStr TargetArmVersion -> systemConf "target-arm-version" - TargetOs -> systemConf "target-os" + TargetOs -> targetConf osStr TargetPlatform -> systemConf "target-platform" TargetPlatformFull -> systemConf "target-platform-full" TargetVendor -> systemConf "target-vendor" - TargetArchHaskell -> targetConf archStr - TargetOsHaskell -> targetConf osStr + TargetArchHaskell -> targetConf (show . archHaskell) + TargetOsHaskell -> targetConf (show . osHaskell) TargetWordSize -> systemConf "target-word-size" -- targetConf tgtWordSize BourneShell -> systemConf "bourne-shell" where systemConf = lookupSystemConfig targetConf = queryTargetTargetConfig hostConf = queryHostTargetConfig - archStr = stringEncodeArch . archOS_arch . tgtArchOs - osStr = stringEncodeOS . archOS_OS . tgtArchOs + archStr = stringEncodeArch . archHaskell + osStr = stringEncodeOS . osHaskell + archHaskell = archOS_arch . tgtArchOs + osHaskell = archOS_OS . tgtArchOs -- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the -- result. ===================================== m4/fptools_set_platform_vars.m4 ===================================== @@ -1,3 +1,5 @@ +# ROMES:TODO: We no longer use these e.g. BuildArch_CPP variables. +# Delete this file but do so carefully... # FPTOOLS_SET_PLATFORMS_VARS # ---------------------------------- # Set all the platform variables. First massage the default autoconf View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9272173a968f9141bed09aab4391693aa17d02a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9272173a968f9141bed09aab4391693aa17d02a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 18:02:04 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 15 May 2023 14:02:04 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Message-ID: <6462739c22510_171ad973071f0c8240f2@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 5fd71a5b by Rodrigo Mesquita at 2023-05-15T19:01:47+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - 4 changed files: - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - m4/fptools_set_platform_vars.m4 Changes: ===================================== configure.ac ===================================== @@ -482,10 +482,8 @@ AC_ARG_WITH(hs-cpp-flags, AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +dnl ROMES:TODO: Are we setting the C99 flags in ghc-toolchain already? FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) -FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) dnl ** Which ld to use dnl -------------------------------------------------------------- ===================================== hadrian/cfg/system.config.in ===================================== @@ -52,27 +52,13 @@ leading-underscore = @LeadingUnderscore@ # ROMES:TODO: Deal with vendor build-platform = @BuildPlatform@ - -build-arch = @BuildArch_CPP@ -build-os = @BuildOS_CPP@ - build-vendor = @BuildVendor_CPP@ host-platform = @HostPlatform@ - -# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name. -host-arch = @HostArch_CPP@ -host-os = @HostOS_CPP@ - host-vendor = @HostVendor_CPP@ target-platform = @TargetPlatform@ target-platform-full = @TargetPlatformFull@ - -# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name. -target-arch = @TargetArch_CPP@ -target-os = @TargetOS_CPP@ - target-vendor = @TargetVendor_CPP@ llvm-target = @LLVMTarget_CPP@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -137,12 +137,12 @@ setting key = case key of GhcSourcePath -> systemConf "ghc-source-path" GmpIncludeDir -> systemConf "gmp-include-dir" GmpLibDir -> systemConf "gmp-lib-dir" - HostArch -> systemConf "host-arch" - HostOs -> systemConf "host-os" + HostArch -> hostConf archStr + HostOs -> hostConf osStr HostPlatform -> systemConf "host-platform" HostVendor -> systemConf "host-vendor" - HostArchHaskell -> hostConf archStr - HostOsHaskell -> hostConf osStr + HostArchHaskell -> hostConf (show . archHaskell) + HostOsHaskell -> hostConf (show . osHaskell) IconvIncludeDir -> systemConf "iconv-include-dir" IconvLibDir -> systemConf "iconv-lib-dir" LibdwIncludeDir -> systemConf "libdw-include-dir" @@ -159,22 +159,24 @@ setting key = case key of ProjectPatchLevel1 -> systemConf "project-patch-level1" ProjectPatchLevel2 -> systemConf "project-patch-level2" SystemGhc -> systemConf "system-ghc" - TargetArch -> systemConf "target-arch" + TargetArch -> targetConf archStr TargetArmVersion -> systemConf "target-arm-version" - TargetOs -> systemConf "target-os" + TargetOs -> targetConf osStr TargetPlatform -> systemConf "target-platform" TargetPlatformFull -> systemConf "target-platform-full" TargetVendor -> systemConf "target-vendor" - TargetArchHaskell -> targetConf archStr - TargetOsHaskell -> targetConf osStr + TargetArchHaskell -> targetConf (show . archHaskell) + TargetOsHaskell -> targetConf (show . osHaskell) TargetWordSize -> systemConf "target-word-size" -- targetConf tgtWordSize BourneShell -> systemConf "bourne-shell" where systemConf = lookupSystemConfig targetConf = queryTargetTargetConfig hostConf = queryHostTargetConfig - archStr = stringEncodeArch . archOS_arch . tgtArchOs - osStr = stringEncodeOS . archOS_OS . tgtArchOs + archStr = stringEncodeArch . archHaskell + osStr = stringEncodeOS . osHaskell + archHaskell = archOS_arch . tgtArchOs + osHaskell = archOS_OS . tgtArchOs -- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the -- result. ===================================== m4/fptools_set_platform_vars.m4 ===================================== @@ -1,3 +1,5 @@ +# ROMES:TODO: We no longer use these e.g. BuildArch_CPP variables. +# Delete this file but do so carefully... # FPTOOLS_SET_PLATFORMS_VARS # ---------------------------------- # Set all the platform variables. First massage the default autoconf View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5fd71a5b3192b3c54315739fc72800f98a7c5153 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5fd71a5b3192b3c54315739fc72800f98a7c5153 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 18:49:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 14:49:35 -0400 Subject: [Git][ghc/ghc][master] Improve "ambiguous occurrence" error messages Message-ID: <64627ebf357eb_171ad97709ceec837475@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 30 changed files: - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Utils/Outputable.hs - testsuite/tests/module/mod110.stderr - testsuite/tests/module/mod151.stderr - testsuite/tests/module/mod152.stderr - testsuite/tests/module/mod153.stderr - testsuite/tests/module/mod164.stderr - testsuite/tests/module/mod165.stderr - testsuite/tests/overloadedrecflds/ghci/GHCiDRF.stdout - testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout - testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr - testsuite/tests/overloadedrecflds/should_fail/DRFUnused.stderr - testsuite/tests/overloadedrecflds/should_fail/NoFieldSelectorsFail.stderr - testsuite/tests/overloadedrecflds/should_fail/T11167_ambiguous_fixity.stderr - testsuite/tests/overloadedrecflds/should_fail/T13132_duplicaterecflds.stderr - testsuite/tests/overloadedrecflds/should_fail/T16745.stderr - testsuite/tests/overloadedrecflds/should_fail/T17420.stderr - testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr - testsuite/tests/overloadedrecflds/should_fail/T23010_fail.stderr - testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr - testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr - testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr - testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr - testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail13.stderr - testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldswasrunnowfail06.stderr - testsuite/tests/rename/should_fail/T11167_ambig.stderr - testsuite/tests/rename/should_fail/T15487.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ae81842d36a6091b406bfce98c60e8a7fa24240 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ae81842d36a6091b406bfce98c60e8a7fa24240 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 18:50:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 14:50:26 -0400 Subject: [Git][ghc/ghc][master] Fix GHCJS OS platform (fix #23346) Message-ID: <64627ef28ceef_171ad97780f8148425a9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 6 changed files: - compiler/GHC/Platform.hs - libraries/ghc-boot/GHC/Platform/ArchOS.hs - m4/fptools_set_haskell_platform_vars.m4 - + testsuite/tests/javascript/T23346.hs - + testsuite/tests/javascript/T23346.stdout - testsuite/tests/javascript/all.T Changes: ===================================== compiler/GHC/Platform.hs ===================================== @@ -208,6 +208,7 @@ osElfTarget OSQNXNTO = False osElfTarget OSAIX = False osElfTarget OSHurd = True osElfTarget OSWasi = False +osElfTarget OSGhcjs = False osElfTarget OSUnknown = False -- Defaulting to False is safe; it means don't rely on any -- ELF-specific functionality. It is important to have a default for ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs ===================================== @@ -98,6 +98,7 @@ data OS | OSAIX | OSHurd | OSWasi + | OSGhcjs deriving (Read, Show, Eq, Ord) @@ -157,3 +158,4 @@ stringEncodeOS = \case OSAIX -> "aix" OSHurd -> "hurd" OSWasi -> "wasi" + OSGhcjs -> "ghcjs" ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -119,7 +119,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS], test -z "[$]2" || eval "[$]2=OSHurd" ;; ghcjs|js) - test -z "[$]2" || eval "[$]2=OSUnknown" + test -z "[$]2" || eval "[$]2=OSGhcjs" ;; *) echo "Unknown OS '[$]1'" ===================================== testsuite/tests/javascript/T23346.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} + +module Main where + +main :: IO () +main = print (correct_host && correct_arch) + +#ifdef ghcjs_HOST_OS +correct_host = True +#else +correct_host = False +#endif + +#ifdef javascript_HOST_ARCH +correct_arch = True +#else +correct_arch = False +#endif ===================================== testsuite/tests/javascript/T23346.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/javascript/all.T ===================================== @@ -15,3 +15,5 @@ test('js-callback02', normal, compile_and_run, ['']) test('js-callback03', normal, compile_and_run, ['']) test('js-callback04', js_skip, compile_and_run, ['']) test('js-callback05', js_skip, compile_and_run, ['']) + +test('T23346', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f571afe1c2aeb3f4dfca2012bc6b713144fd234 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f571afe1c2aeb3f4dfca2012bc6b713144fd234 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 18:51:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 14:51:31 -0400 Subject: [Git][ghc/ghc][master] Split DynFlags structure into own module Message-ID: <64627f334379a_171ad9771569c88459f5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 27 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/State.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -26,7 +26,7 @@ import qualified Text.ParserCombinators.ReadP as P import GHC.Prelude import GHC.Utils.Outputable as Outputable -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.CostCentre import GHC.Types.CostCentre.State import GHC.Types.Name hiding (varName) ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Core.Opt.Monad ( import GHC.Prelude hiding ( read ) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv ) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Unit.Module.Env import GHC.Unit.Module.ModGuts( ModGuts(..) ) import GHC.Unit.Module.Deps( Dependencies(..) ) -import GHC.Driver.Session( DynFlags ) +import GHC.Driver.DynFlags( DynFlags ) import GHC.Driver.Ppr( showSDoc ) import GHC.Core -- All of it ===================================== compiler/GHC/Data/IOEnv.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Data.IOEnv ( import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Hooks import GHC.IO (catchException) import GHC.Utils.Exception ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Driver.Config.Diagnostic where import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Prelude import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Config/Logger.hs ===================================== @@ -5,7 +5,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Logger (LogFlags (..)) import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -0,0 +1,1531 @@ +{-# LANGUAGE LambdaCase #-} +module GHC.Driver.DynFlags ( + -- * Dynamic flags and associated configuration types + DumpFlag(..), + GeneralFlag(..), + WarningFlag(..), DiagnosticReason(..), + Language(..), + FatalMessager, FlushOut(..), + ProfAuto(..), + hasPprDebug, hasNoDebugOutput, hasNoStateHack, hasNoOptCoercion, + dopt, dopt_set, dopt_unset, + gopt, gopt_set, gopt_unset, + wopt, wopt_set, wopt_unset, + wopt_fatal, wopt_set_fatal, wopt_unset_fatal, + wopt_set_all_custom, wopt_unset_all_custom, + wopt_set_all_fatal_custom, wopt_unset_all_fatal_custom, + wopt_set_custom, wopt_unset_custom, + wopt_set_fatal_custom, wopt_unset_fatal_custom, + wopt_any_custom, + xopt, xopt_set, xopt_unset, + xopt_set_unlessExplSpec, + xopt_DuplicateRecordFields, + xopt_FieldSelectors, + lang_set, + DynamicTooState(..), dynamicTooState, setDynamicNow, + OnOff(..), + DynFlags(..), + ParMakeCount(..), + ways, + HasDynFlags(..), ContainsDynFlags(..), + RtsOptsEnabled(..), + GhcMode(..), isOneShot, + GhcLink(..), isNoLink, + PackageFlag(..), PackageArg(..), ModRenaming(..), + packageFlagsChanged, + IgnorePackageFlag(..), TrustFlag(..), + PackageDBFlag(..), PkgDbRef(..), + Option(..), showOpt, + DynLibLoader(..), + positionIndependent, + optimisationFlags, + + -- ** Manipulating DynFlags + defaultDynFlags, -- Settings -> DynFlags + initDynFlags, -- DynFlags -> IO DynFlags + defaultFatalMessager, + defaultFlushOut, + optLevelFlags, + languageExtensions, + + TurnOnFlag, + turnOn, + turnOff, + + -- ** System tool settings and locations + programName, projectVersion, + ghcUsagePath, ghciUsagePath, topDir, toolDir, + versionedAppDir, versionedFilePath, + extraGccViaCFlags, globalPackageDatabasePath, + + -- * Linker/compiler information + LinkerInfo(..), + CompilerInfo(..), + + -- * Include specifications + IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes, + addImplicitQuoteInclude, + + -- * SDoc + initSDocContext, initDefaultSDocContext, + initPromotionTickContext, +) where + +import GHC.Prelude + +import GHC.Platform +import GHC.Platform.Ways + +import GHC.CmmToAsm.CFG.Weight +import GHC.Core.Unfold +import GHC.Data.Bool +import GHC.Data.EnumSet (EnumSet) +import GHC.Data.Maybe +import GHC.Builtin.Names ( mAIN_NAME ) +import GHC.Driver.Backend +import GHC.Driver.Flags +import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.Plugins.External +import GHC.Settings +import GHC.Settings.Constants +import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) +import GHC.Types.Error (DiagnosticReason(..)) +import GHC.Types.ProfAuto +import GHC.Types.SafeHaskell +import GHC.Types.SrcLoc +import GHC.Unit.Module +import GHC.Unit.Module.Warnings +import GHC.Utils.CliOption +import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) +import GHC.UniqueSubdir (uniqueSubdir) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.TmpFs + +import qualified GHC.Types.FieldLabel as FieldLabel +import qualified GHC.Utils.Ppr.Colour as Col +import qualified GHC.Data.EnumSet as EnumSet + +import {-# SOURCE #-} GHC.Core.Opt.CallerCC + +import Control.Monad (msum, (<=<)) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.Writer (WriterT) +import Data.IORef +import System.IO +import System.IO.Error (catchIOError) +import System.Environment (lookupEnv) +import System.FilePath (normalise, ()) +import System.Directory +import GHC.Foreign (withCString, peekCString) + +import qualified Data.Set as Set + +import qualified GHC.LanguageExtensions as LangExt + +-- ----------------------------------------------------------------------------- +-- DynFlags + +-- | Contains not only a collection of 'GeneralFlag's but also a plethora of +-- information relating to the compilation of a single file or GHC session +data DynFlags = DynFlags { + ghcMode :: GhcMode, + ghcLink :: GhcLink, + backend :: !Backend, + -- ^ The backend to use (if any). + -- + -- Whenever you change the backend, also make sure to set 'ghcLink' to + -- something sensible. + -- + -- 'NoBackend' can be used to avoid generating any output, however, note that: + -- + -- * If a program uses Template Haskell the typechecker may need to run code + -- from an imported module. To facilitate this, code generation is enabled + -- for modules imported by modules that use template haskell, using the + -- default backend for the platform. + -- See Note [-fno-code mode]. + + + -- formerly Settings + ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, + fileSettings :: {-# UNPACK #-} !FileSettings, + targetPlatform :: Platform, -- Filled in by SysTools + toolSettings :: {-# UNPACK #-} !ToolSettings, + platformMisc :: {-# UNPACK #-} !PlatformMisc, + rawSettings :: [(String, String)], + tmpDir :: TempDir, + + llvmOptLevel :: Int, -- ^ LLVM optimisation level + verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] + debugLevel :: Int, -- ^ How much debug information to produce + simplPhases :: Int, -- ^ Number of simplifier phases + maxSimplIterations :: Int, -- ^ Max simplifier iterations + ruleCheck :: Maybe String, + strictnessBefore :: [Int], -- ^ Additional demand analysis + + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. + + enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? + ghcHeapSize :: Maybe Int, -- ^ The heap size to set. + + maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt + -- to show in type error messages + maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show + -- in typed hole error messages + maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole + -- fits to show in typed hole error + -- messages + refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for + -- refinement hole fits in typed hole + -- error messages + maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show + -- in non-exhaustiveness warnings + maxPmCheckModels :: Int, -- ^ Soft limit on the number of models + -- the pattern match checker checks + -- a pattern against. A safe guard + -- against exponential blow-up. + simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks + dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an + -- Unboxed demand on returned products with at most + -- this number of fields + specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr + specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function + specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types + -- Not optional; otherwise ForceSpecConstr can diverge. + binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above + -- this threshold will be dumped in a binary file + -- by the assembler code generator. 0 and Nothing disables + -- this feature. See 'GHC.StgToCmm.Config'. + liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase + floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating + -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' + + liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- recursive function. + liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a + -- non-recursive function. + liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call + -- into an unknown call. + + cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. + + historySize :: Int, -- ^ Simplification history size + + importPaths :: [FilePath], + mainModuleNameIs :: ModuleName, + mainFunIs :: Maybe String, + reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth + solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver + -- Typically only 1 is needed + givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + homeUnitId_ :: UnitId, -- ^ Target home unit-id + homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate + homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations + + -- Note [Filepaths and Multiple Home Units] + workingDirectory :: Maybe FilePath, + thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units + hiddenModules :: Set.Set ModuleName, + reexportedModules :: Set.Set ModuleName, + + -- ways + targetWays_ :: Ways, -- ^ Target way flags from the command line + + -- For object splitting + splitInfo :: Maybe (String,Int), + + -- paths etc. + objectDir :: Maybe String, + dylibInstallName :: Maybe String, + hiDir :: Maybe String, + hieDir :: Maybe String, + stubDir :: Maybe String, + dumpDir :: Maybe String, + + objectSuf_ :: String, + hcSuf :: String, + hiSuf_ :: String, + hieSuf :: String, + + dynObjectSuf_ :: String, + dynHiSuf_ :: String, + + outputFile_ :: Maybe String, + dynOutputFile_ :: Maybe String, + outputHi :: Maybe String, + dynOutputHi :: Maybe String, + dynLibLoader :: DynLibLoader, + + dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output + -- because of -dynamic-too. This predicate is + -- used to query the appropriate fields + -- (outputFile/dynOutputFile, ways, etc.) + + -- | This defaults to 'non-module'. It can be set by + -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on + -- where its output is going. + dumpPrefix :: FilePath, + + -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' + -- or 'ghc.GHCi.UI.runStmt'. + -- Set by @-ddump-file-prefix@ + dumpPrefixForce :: Maybe FilePath, + + ldInputs :: [Option], + + includePaths :: IncludeSpecs, + libraryPaths :: [String], + frameworkPaths :: [String], -- used on darwin only + cmdlineFrameworks :: [String], -- ditto + + rtsOpts :: Maybe String, + rtsOptsEnabled :: RtsOptsEnabled, + rtsOptsSuggestions :: Bool, + + hpcDir :: String, -- ^ Path to store the .mix files + + -- Plugins + pluginModNames :: [ModuleName], + -- ^ the @-fplugin@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + pluginModNameOpts :: [(ModuleName,String)], + frontendPluginOpts :: [String], + -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* + -- order that they're specified on the command line. + + externalPluginSpecs :: [ExternalPluginSpec], + -- ^ External plugins loaded from shared libraries + + -- For ghc -M + depMakefile :: FilePath, + depIncludePkgDeps :: Bool, + depIncludeCppDeps :: Bool, + depExcludeMods :: [ModuleName], + depSuffixes :: [String], + + -- Package flags + packageDBFlags :: [PackageDBFlag], + -- ^ The @-package-db@ flags given on the command line, In + -- *reverse* order that they're specified on the command line. + -- This is intended to be applied with the list of "initial" + -- package databases derived from @GHC_PACKAGE_PATH@; see + -- 'getUnitDbRefs'. + + ignorePackageFlags :: [IgnorePackageFlag], + -- ^ The @-ignore-package@ flags from the command line. + -- In *reverse* order that they're specified on the command line. + packageFlags :: [PackageFlag], + -- ^ The @-package@ and @-hide-package@ flags from the command-line. + -- In *reverse* order that they're specified on the command line. + pluginPackageFlags :: [PackageFlag], + -- ^ The @-plugin-package-id@ flags from command line. + -- In *reverse* order that they're specified on the command line. + trustFlags :: [TrustFlag], + -- ^ The @-trust@ and @-distrust@ flags. + -- In *reverse* order that they're specified on the command line. + packageEnv :: Maybe FilePath, + -- ^ Filepath to the package environment file (if overriding default) + + + -- hsc dynamic flags + dumpFlags :: EnumSet DumpFlag, + generalFlags :: EnumSet GeneralFlag, + warningFlags :: EnumSet WarningFlag, + fatalWarningFlags :: EnumSet WarningFlag, + customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] + fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings + -- Don't change this without updating extensionFlags: + language :: Maybe Language, + -- | Safe Haskell mode + safeHaskell :: SafeHaskellMode, + safeInfer :: Bool, + safeInferred :: Bool, + -- We store the location of where some extension and flags were turned on so + -- we can produce accurate error messages when Safe Haskell fails due to + -- them. + thOnLoc :: SrcSpan, + newDerivOnLoc :: SrcSpan, + deriveViaOnLoc :: SrcSpan, + overlapInstLoc :: SrcSpan, + incoherentOnLoc :: SrcSpan, + pkgTrustOnLoc :: SrcSpan, + warnSafeOnLoc :: SrcSpan, + warnUnsafeOnLoc :: SrcSpan, + trustworthyOnLoc :: SrcSpan, + -- Don't change this without updating extensionFlags: + -- Here we collect the settings of the language extensions + -- from the command line, the ghci config file and + -- from interactive :set / :seti commands. + extensions :: [OnOff LangExt.Extension], + -- extensionFlags should always be equal to + -- flattenExtensionFlags language extensions + -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used + -- by template-haskell + extensionFlags :: EnumSet LangExt.Extension, + + -- | Unfolding control + -- See Note [Discounts and thresholds] in GHC.Core.Unfold + unfoldingOpts :: !UnfoldingOpts, + + maxWorkerArgs :: Int, + + ghciHistSize :: Int, + + flushOut :: FlushOut, + + ghcVersionFile :: Maybe FilePath, + haddockOptions :: Maybe String, + + -- | GHCi scripts specified by -ghci-script, in reverse order + ghciScripts :: [String], + + -- Output style options + pprUserLength :: Int, + pprCols :: Int, + + useUnicode :: Bool, + useColor :: OverridingBool, + canUseColor :: Bool, + colScheme :: Col.Scheme, + + -- | what kind of {-# SCC #-} to add automatically + profAuto :: ProfAuto, + callerCcFilters :: [CallerCcFilter], + + interactivePrint :: Maybe String, + + -- | Machine dependent flags (-m\ stuff) + sseVersion :: Maybe SseVersion, + bmiVersion :: Maybe BmiVersion, + avx :: Bool, + avx2 :: Bool, + avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. + avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. + avx512f :: Bool, -- Enable AVX-512 instructions. + avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. + fma :: Bool, -- ^ Enable FMA instructions. + + -- | Run-time linker information (what options we need, etc.) + rtldInfo :: IORef (Maybe LinkerInfo), + + -- | Run-time C compiler information + rtccInfo :: IORef (Maybe CompilerInfo), + + -- | Run-time assembler information + rtasmInfo :: IORef (Maybe CompilerInfo), + + -- Constants used to control the amount of optimization done. + + -- | Max size, in bytes, of inline array allocations. + maxInlineAllocSize :: Int, + + -- | Only inline memcpy if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemcpyInsns :: Int, + + -- | Only inline memset if it generates no more than this many + -- pseudo (roughly: Cmm) instructions. + maxInlineMemsetInsns :: Int, + + -- | Reverse the order of error messages in GHC/GHCi + reverseErrors :: Bool, + + -- | Limit the maximum number of errors to show + maxErrors :: Maybe Int, + + -- | Unique supply configuration for testing build determinism + initialUnique :: Word, + uniqueIncrement :: Int, + -- 'Int' because it can be used to test uniques in decreasing order. + + -- | Temporary: CFG Edge weights for fast iterations + cfgWeights :: Weights +} + +class HasDynFlags m where + getDynFlags :: m DynFlags + +{- It would be desirable to have the more generalised + + instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where + getDynFlags = lift getDynFlags + +instance definition. However, that definition would overlap with the +`HasDynFlags (GhcT m)` instance. Instead we define instances for a +couple of common Monad transformers explicitly. -} + +instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where + getDynFlags = lift getDynFlags + +instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where + getDynFlags = lift getDynFlags + +class ContainsDynFlags t where + extractDynFlags :: t -> DynFlags + +----------------------------------------------------------------------------- + +-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value +initDynFlags :: DynFlags -> IO DynFlags +initDynFlags dflags = do + let + refRtldInfo <- newIORef Nothing + refRtccInfo <- newIORef Nothing + refRtasmInfo <- newIORef Nothing + canUseUnicode <- do let enc = localeEncoding + str = "‘’" + (withCString enc str $ \cstr -> + do str' <- peekCString enc cstr + return (str == str')) + `catchIOError` \_ -> return False + ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" + let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode + maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" + maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" + let adjustCols (Just env) = Col.parseScheme env + adjustCols Nothing = id + let (useColor', colScheme') = + (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) + (useColor dflags, colScheme dflags) + tmp_dir <- normalise <$> getTemporaryDirectory + return dflags{ + useUnicode = useUnicode', + useColor = useColor', + canUseColor = stderrSupportsAnsiColors, + colScheme = colScheme', + rtldInfo = refRtldInfo, + rtccInfo = refRtccInfo, + rtasmInfo = refRtasmInfo, + tmpDir = TempDir tmp_dir + } + +-- | The normal 'DynFlags'. Note that they are not suitable for use in this form +-- and must be fully initialized by 'GHC.runGhc' first. +defaultDynFlags :: Settings -> DynFlags +defaultDynFlags mySettings = +-- See Note [Updating flag description in the User's Guide] + DynFlags { + ghcMode = CompManager, + ghcLink = LinkBinary, + backend = platformDefaultBackend (sTargetPlatform mySettings), + verbosity = 0, + debugLevel = 0, + simplPhases = 2, + maxSimplIterations = 4, + ruleCheck = Nothing, + binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) + maxRelevantBinds = Just 6, + maxValidHoleFits = Just 6, + maxRefHoleFits = Just 6, + refLevelHoleFits = Nothing, + maxUncoveredPatterns = 4, + maxPmCheckModels = 30, + simplTickFactor = 100, + dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple + specConstrThreshold = Just 2000, + specConstrCount = Just 3, + specConstrRecursive = 3, + liberateCaseThreshold = Just 2000, + floatLamArgs = Just 0, -- Default: float only if no fvs + liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 + liftLamsKnown = False, -- Default: don't turn known calls into unknown ones + cmmProcAlignment = Nothing, + + historySize = 20, + strictnessBefore = [], + + parMakeCount = Nothing, + + enableTimeStats = False, + ghcHeapSize = Nothing, + + importPaths = ["."], + mainModuleNameIs = mAIN_NAME, + mainFunIs = Nothing, + reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, + solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, + + homeUnitId_ = mainUnitId, + homeUnitInstanceOf_ = Nothing, + homeUnitInstantiations_ = [], + + workingDirectory = Nothing, + thisPackageName = Nothing, + hiddenModules = Set.empty, + reexportedModules = Set.empty, + + objectDir = Nothing, + dylibInstallName = Nothing, + hiDir = Nothing, + hieDir = Nothing, + stubDir = Nothing, + dumpDir = Nothing, + + objectSuf_ = phaseInputExt StopLn, + hcSuf = phaseInputExt HCc, + hiSuf_ = "hi", + hieSuf = "hie", + + dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, + dynHiSuf_ = "dyn_hi", + dynamicNow = False, + + pluginModNames = [], + pluginModNameOpts = [], + frontendPluginOpts = [], + + externalPluginSpecs = [], + + outputFile_ = Nothing, + dynOutputFile_ = Nothing, + outputHi = Nothing, + dynOutputHi = Nothing, + dynLibLoader = SystemDependent, + dumpPrefix = "non-module.", + dumpPrefixForce = Nothing, + ldInputs = [], + includePaths = IncludeSpecs [] [] [], + libraryPaths = [], + frameworkPaths = [], + cmdlineFrameworks = [], + rtsOpts = Nothing, + rtsOptsEnabled = RtsOptsSafeOnly, + rtsOptsSuggestions = True, + + hpcDir = ".hpc", + + packageDBFlags = [], + packageFlags = [], + pluginPackageFlags = [], + ignorePackageFlags = [], + trustFlags = [], + packageEnv = Nothing, + targetWays_ = Set.empty, + splitInfo = Nothing, + + ghcNameVersion = sGhcNameVersion mySettings, + fileSettings = sFileSettings mySettings, + toolSettings = sToolSettings mySettings, + targetPlatform = sTargetPlatform mySettings, + platformMisc = sPlatformMisc mySettings, + rawSettings = sRawSettings mySettings, + + tmpDir = panic "defaultDynFlags: uninitialized tmpDir", + + llvmOptLevel = 0, + + -- ghc -M values + depMakefile = "Makefile", + depIncludePkgDeps = False, + depIncludeCppDeps = False, + depExcludeMods = [], + depSuffixes = [], + -- end of ghc -M values + ghcVersionFile = Nothing, + haddockOptions = Nothing, + dumpFlags = EnumSet.empty, + generalFlags = EnumSet.fromList (defaultFlags mySettings), + warningFlags = EnumSet.fromList standardWarnings, + fatalWarningFlags = EnumSet.empty, + customWarningCategories = completeWarningCategorySet, + fatalCustomWarningCategories = emptyWarningCategorySet, + ghciScripts = [], + language = Nothing, + safeHaskell = Sf_None, + safeInfer = True, + safeInferred = True, + thOnLoc = noSrcSpan, + newDerivOnLoc = noSrcSpan, + deriveViaOnLoc = noSrcSpan, + overlapInstLoc = noSrcSpan, + incoherentOnLoc = noSrcSpan, + pkgTrustOnLoc = noSrcSpan, + warnSafeOnLoc = noSrcSpan, + warnUnsafeOnLoc = noSrcSpan, + trustworthyOnLoc = noSrcSpan, + extensions = [], + extensionFlags = flattenExtensionFlags Nothing [], + + unfoldingOpts = defaultUnfoldingOpts, + maxWorkerArgs = 10, + + ghciHistSize = 50, -- keep a log of length 50 by default + + flushOut = defaultFlushOut, + pprUserLength = 5, + pprCols = 100, + useUnicode = False, + useColor = Auto, + canUseColor = False, + colScheme = Col.defaultScheme, + profAuto = NoProfAuto, + callerCcFilters = [], + interactivePrint = Nothing, + sseVersion = Nothing, + bmiVersion = Nothing, + avx = False, + avx2 = False, + avx512cd = False, + avx512er = False, + avx512f = False, + avx512pf = False, + fma = False, + rtldInfo = panic "defaultDynFlags: no rtldInfo", + rtccInfo = panic "defaultDynFlags: no rtccInfo", + rtasmInfo = panic "defaultDynFlags: no rtasmInfo", + + maxInlineAllocSize = 128, + maxInlineMemcpyInsns = 32, + maxInlineMemsetInsns = 32, + + initialUnique = 0, + uniqueIncrement = 1, + + reverseErrors = False, + maxErrors = Nothing, + cfgWeights = defaultWeights + } + +type FatalMessager = String -> IO () + +defaultFatalMessager :: FatalMessager +defaultFatalMessager = hPutStrLn stderr + + +newtype FlushOut = FlushOut (IO ()) + +defaultFlushOut :: FlushOut +defaultFlushOut = FlushOut $ hFlush stdout + + + +data OnOff a = On a + | Off a + deriving (Eq, Show) + +instance Outputable a => Outputable (OnOff a) where + ppr (On x) = text "On" <+> ppr x + ppr (Off x) = text "Off" <+> ppr x + +-- OnOffs accumulate in reverse order, so we use foldr in order to +-- process them in the right order +flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension +flattenExtensionFlags ml = foldr g defaultExtensionFlags + where g (On f) flags = EnumSet.insert f flags + g (Off f) flags = EnumSet.delete f flags + defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) + +-- ----------------------------------------------------------------------------- +-- -jN + +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + -- | Use this many processors (@-j@ flag). + = ParMakeThisMany Int + -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). + | ParMakeNumProcessors + -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). + | ParMakeSemaphore FilePath + +-- ----------------------------------------------------------------------------- +-- Linker/compiler information + +-- LinkerInfo contains any extra options needed by the system linker. +data LinkerInfo + = GnuLD [Option] + | Mold [Option] + | GnuGold [Option] + | LlvmLLD [Option] + | DarwinLD [Option] + | SolarisLD [Option] + | AixLD [Option] + | UnknownLD + deriving Eq + +-- CompilerInfo tells us which C compiler we're using +data CompilerInfo + = GCC + | Clang + | AppleClang + | AppleClang51 + | Emscripten + | UnknownCC + deriving Eq + +-- | The 'GhcMode' tells us whether we're doing multi-module +-- compilation (controlled via the "GHC" API) or one-shot +-- (single-module) compilation. This makes a difference primarily to +-- the "GHC.Unit.Finder": in one-shot mode we look for interface files for +-- imported modules, but in multi-module mode we look for source files +-- in order to check whether they need to be recompiled. +data GhcMode + = CompManager -- ^ @\-\-make@, GHCi, etc. + | OneShot -- ^ @ghc -c Foo.hs@ + | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this + deriving Eq + +instance Outputable GhcMode where + ppr CompManager = text "CompManager" + ppr OneShot = text "OneShot" + ppr MkDepend = text "MkDepend" + +isOneShot :: GhcMode -> Bool +isOneShot OneShot = True +isOneShot _other = False + +-- | What to do in the link step, if there is one. +data GhcLink + = NoLink -- ^ Don't link at all + | LinkBinary -- ^ Link object code into a binary + | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both + -- bytecode and object code). + | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) + | LinkStaticLib -- ^ Link objects into a static lib + | LinkMergedObj -- ^ Link objects into a merged "GHCi object" + deriving (Eq, Show) + +isNoLink :: GhcLink -> Bool +isNoLink NoLink = True +isNoLink _ = False + +-- | We accept flags which make packages visible, but how they select +-- the package varies; this data type reflects what selection criterion +-- is used. +data PackageArg = + PackageArg String -- ^ @-package@, by 'PackageName' + | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' + deriving (Eq, Show) + +instance Outputable PackageArg where + ppr (PackageArg pn) = text "package" <+> text pn + ppr (UnitIdArg uid) = text "unit" <+> ppr uid + +-- | Represents the renaming that may be associated with an exposed +-- package, e.g. the @rns@ part of @-package "foo (rns)"@. +-- +-- Here are some example parsings of the package flags (where +-- a string literal is punned to be a 'ModuleName': +-- +-- * @-package foo@ is @ModRenaming True []@ +-- * @-package foo ()@ is @ModRenaming False []@ +-- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ +-- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ +-- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ +data ModRenaming = ModRenaming { + modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? + modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope + -- under name @n at . + } deriving (Eq) +instance Outputable ModRenaming where + ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) + +-- | Flags for manipulating the set of non-broken packages. +newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ + deriving (Eq) + +-- | Flags for manipulating package trust. +data TrustFlag + = TrustPackage String -- ^ @-trust@ + | DistrustPackage String -- ^ @-distrust@ + deriving (Eq) + +-- | Flags for manipulating packages visibility. +data PackageFlag + = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ + | HidePackage String -- ^ @-hide-package@ + deriving (Eq) -- NB: equality instance is used by packageFlagsChanged + +data PackageDBFlag + = PackageDB PkgDbRef + | NoUserPackageDB + | NoGlobalPackageDB + | ClearPackageDBs + deriving (Eq) + +packageFlagsChanged :: DynFlags -> DynFlags -> Bool +packageFlagsChanged idflags1 idflags0 = + packageFlags idflags1 /= packageFlags idflags0 || + ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || + pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || + trustFlags idflags1 /= trustFlags idflags0 || + packageDBFlags idflags1 /= packageDBFlags idflags0 || + packageGFlags idflags1 /= packageGFlags idflags0 + where + packageGFlags dflags = map (`gopt` dflags) + [ Opt_HideAllPackages + , Opt_HideAllPluginPackages + , Opt_AutoLinkPackages ] + +instance Outputable PackageFlag where + ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) + ppr (HidePackage str) = text "-hide-package" <+> text str + +data DynLibLoader + = Deployable + | SystemDependent + deriving Eq + +data RtsOptsEnabled + = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly + | RtsOptsAll + deriving (Show) + +-- | Are we building with @-fPIE@ or @-fPIC@ enabled? +positionIndependent :: DynFlags -> Bool +positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags + +-- Note [-dynamic-too business] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- With -dynamic-too flag, we try to build both the non-dynamic and dynamic +-- objects in a single run of the compiler: the pipeline is the same down to +-- Core optimisation, then the backend (from Core to object code) is executed +-- twice. +-- +-- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic +-- and dynamic loaded interfaces (#9176). +-- +-- To make matters worse, we automatically enable -dynamic-too when some modules +-- need Template-Haskell and GHC is dynamically linked (cf +-- GHC.Driver.Pipeline.compileOne'). +-- +-- We used to try and fall back from a dynamic-too failure but this feature +-- didn't work as expected (#20446) so it was removed to simplify the +-- implementation and not obscure latent bugs. + +data DynamicTooState + = DT_Dont -- ^ Don't try to build dynamic objects too + | DT_OK -- ^ Will still try to generate dynamic objects + | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) + deriving (Eq,Show,Ord) + +dynamicTooState :: DynFlags -> DynamicTooState +dynamicTooState dflags + | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont + | dynamicNow dflags = DT_Dyn + | otherwise = DT_OK + +setDynamicNow :: DynFlags -> DynFlags +setDynamicNow dflags0 = + dflags0 + { dynamicNow = True + } + +data PkgDbRef + = GlobalPkgDb + | UserPkgDb + | PkgDbPath FilePath + deriving Eq + +-- | Used to differentiate the scope an include needs to apply to. +-- We have to split the include paths to avoid accidentally forcing recursive +-- includes since -I overrides the system search paths. See #14312. +data IncludeSpecs + = IncludeSpecs { includePathsQuote :: [String] + , includePathsGlobal :: [String] + -- | See Note [Implicit include paths] + , includePathsQuoteImplicit :: [String] + } + deriving Show + +-- | Append to the list of includes a path that shall be included using `-I` +-- when the C compiler is called. These paths override system search paths. +addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addGlobalInclude spec paths = let f = includePathsGlobal spec + in spec { includePathsGlobal = f ++ paths } + +-- | Append to the list of includes a path that shall be included using +-- `-iquote` when the C compiler is called. These paths only apply when quoted +-- includes are used. e.g. #include "foo.h" +addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addQuoteInclude spec paths = let f = includePathsQuote spec + in spec { includePathsQuote = f ++ paths } + +-- | These includes are not considered while fingerprinting the flags for iface +-- | See Note [Implicit include paths] +addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec + in spec { includePathsQuoteImplicit = f ++ paths } + + +-- | Concatenate and flatten the list of global and quoted includes returning +-- just a flat list of paths. +flattenIncludes :: IncludeSpecs -> [String] +flattenIncludes specs = + includePathsQuote specs ++ + includePathsQuoteImplicit specs ++ + includePathsGlobal specs + +{- Note [Implicit include paths] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The compile driver adds the path to the folder containing the source file being + compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' + that are used later to compute the interface file. Because of this, + the flags fingerprint derived from these 'DynFlags' and recorded in the + interface file will end up containing the absolute path to the source folder. + + Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) + store the build artifacts produced by a build BA for reuse in subsequent builds. + + Embedding source paths in interface fingerprints will thwart these attempts and + lead to unnecessary recompilations when the source paths in BA differ from the + source paths in subsequent builds. + -} + +hasPprDebug :: DynFlags -> Bool +hasPprDebug = dopt Opt_D_ppr_debug + +hasNoDebugOutput :: DynFlags -> Bool +hasNoDebugOutput = dopt Opt_D_no_debug_output + +hasNoStateHack :: DynFlags -> Bool +hasNoStateHack = gopt Opt_G_NoStateHack + +hasNoOptCoercion :: DynFlags -> Bool +hasNoOptCoercion = gopt Opt_G_NoOptCoercion + +-- | Test whether a 'DumpFlag' is set +dopt :: DumpFlag -> DynFlags -> Bool +dopt = getDumpFlagFrom verbosity dumpFlags + +-- | Set a 'DumpFlag' +dopt_set :: DynFlags -> DumpFlag -> DynFlags +dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } + +-- | Unset a 'DumpFlag' +dopt_unset :: DynFlags -> DumpFlag -> DynFlags +dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } + +-- | Test whether a 'GeneralFlag' is set +-- +-- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) +-- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables +-- Opt_SplitSections. +-- +gopt :: GeneralFlag -> DynFlags -> Bool +gopt Opt_PIC dflags + | dynamicNow dflags = True +gopt Opt_ExternalDynamicRefs dflags + | dynamicNow dflags = True +gopt Opt_SplitSections dflags + | dynamicNow dflags = False +gopt f dflags = f `EnumSet.member` generalFlags dflags + +-- | Set a 'GeneralFlag' +gopt_set :: DynFlags -> GeneralFlag -> DynFlags +gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } + +-- | Unset a 'GeneralFlag' +gopt_unset :: DynFlags -> GeneralFlag -> DynFlags +gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } + +-- | Test whether a 'WarningFlag' is set +wopt :: WarningFlag -> DynFlags -> Bool +wopt f dflags = f `EnumSet.member` warningFlags dflags + +-- | Set a 'WarningFlag' +wopt_set :: DynFlags -> WarningFlag -> DynFlags +wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } + +-- | Unset a 'WarningFlag' +wopt_unset :: DynFlags -> WarningFlag -> DynFlags +wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } + +-- | Test whether a 'WarningFlag' is set as fatal +wopt_fatal :: WarningFlag -> DynFlags -> Bool +wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags + +-- | Mark a 'WarningFlag' as fatal (do not set the flag) +wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_set_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } + +-- | Mark a 'WarningFlag' as not fatal +wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags +wopt_unset_fatal dfs f + = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } + + +-- | Enable all custom warning categories. +wopt_set_all_custom :: DynFlags -> DynFlags +wopt_set_all_custom dfs + = dfs{ customWarningCategories = completeWarningCategorySet } + +-- | Disable all custom warning categories. +wopt_unset_all_custom :: DynFlags -> DynFlags +wopt_unset_all_custom dfs + = dfs{ customWarningCategories = emptyWarningCategorySet } + +-- | Mark all custom warning categories as fatal (do not set the flags). +wopt_set_all_fatal_custom :: DynFlags -> DynFlags +wopt_set_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = completeWarningCategorySet } + +-- | Mark all custom warning categories as non-fatal. +wopt_unset_all_fatal_custom :: DynFlags -> DynFlags +wopt_unset_all_fatal_custom dfs + = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } + +-- | Set a custom 'WarningCategory' +wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } + +-- | Unset a custom 'WarningCategory' +wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as fatal (do not set the flag) +wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_set_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Mark a custom 'WarningCategory' as not fatal +wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags +wopt_unset_fatal_custom dfs f + = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } + +-- | Are there any custom warning categories enabled? +wopt_any_custom :: DynFlags -> Bool +wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) + + +-- | Test whether a 'LangExt.Extension' is set +xopt :: LangExt.Extension -> DynFlags -> Bool +xopt f dflags = f `EnumSet.member` extensionFlags dflags + +-- | Set a 'LangExt.Extension' +xopt_set :: DynFlags -> LangExt.Extension -> DynFlags +xopt_set dfs f + = let onoffs = On f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Unset a 'LangExt.Extension' +xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags +xopt_unset dfs f + = let onoffs = Off f : extensions dfs + in dfs { extensions = onoffs, + extensionFlags = flattenExtensionFlags (language dfs) onoffs } + +-- | Set or unset a 'LangExt.Extension', unless it has been explicitly +-- set or unset before. +xopt_set_unlessExplSpec + :: LangExt.Extension + -> (DynFlags -> LangExt.Extension -> DynFlags) + -> DynFlags -> DynFlags +xopt_set_unlessExplSpec ext setUnset dflags = + let referedExts = stripOnOff <$> extensions dflags + stripOnOff (On x) = x + stripOnOff (Off x) = x + in + if ext `elem` referedExts then dflags else setUnset dflags ext + +xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields +xopt_DuplicateRecordFields dfs + | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields + | otherwise = FieldLabel.NoDuplicateRecordFields + +xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors +xopt_FieldSelectors dfs + | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors + | otherwise = FieldLabel.NoFieldSelectors + +lang_set :: DynFlags -> Maybe Language -> DynFlags +lang_set dflags lang = + dflags { + language = lang, + extensionFlags = flattenExtensionFlags lang (extensions dflags) + } + +defaultFlags :: Settings -> [GeneralFlag] +defaultFlags settings +-- See Note [Updating flag description in the User's Guide] + = [ Opt_AutoLinkPackages, + Opt_DiagnosticsShowCaret, + Opt_EmbedManifest, + Opt_FamAppCache, + Opt_GenManifest, + Opt_GhciHistory, + Opt_GhciSandbox, + Opt_HelpfulErrors, + Opt_KeepHiFiles, + Opt_KeepOFiles, + Opt_OmitYields, + Opt_PrintBindContents, + Opt_ProfCountEntries, + Opt_SharedImplib, + Opt_SimplPreInlining, + Opt_VersionMacros, + Opt_RPath, + Opt_DumpWithWays, + Opt_CompactUnwind, + Opt_ShowErrorContext, + Opt_SuppressStgReps, + Opt_UnoptimizedCoreForInterpreter + ] + + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + + -- Default floating flags (see Note [RHS Floating]) + ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] + + + ++ default_PIC platform + + ++ validHoleFitDefaults + + + where platform = sTargetPlatform settings + +-- | These are the default settings for the display and sorting of valid hole +-- fits in typed-hole error messages. See Note [Valid hole fits include ...] + -- in the "GHC.Tc.Errors.Hole" module. +validHoleFitDefaults :: [GeneralFlag] +validHoleFitDefaults + = [ Opt_ShowTypeAppOfHoleFits + , Opt_ShowTypeOfHoleFits + , Opt_ShowProvOfHoleFits + , Opt_ShowMatchesOfHoleFits + , Opt_ShowValidHoleFits + , Opt_SortValidHoleFits + , Opt_SortBySizeHoleFits + , Opt_ShowHoleConstraints ] + +-- Note [When is StarIsType enabled] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- The StarIsType extension determines whether to treat '*' as a regular type +-- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType +-- programs expect '*' to be synonymous with 'Type', so by default StarIsType is +-- enabled. +-- +-- Programs that use TypeOperators might expect to repurpose '*' for +-- multiplication or another binary operation, but making TypeOperators imply +-- NoStarIsType caused too much breakage on Hackage. +-- + +-- +-- Note [Documenting optimisation flags] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- If you change the list of flags enabled for particular optimisation levels +-- please remember to update the User's Guide. The relevant file is: +-- +-- docs/users_guide/using-optimisation.rst +-- +-- Make sure to note whether a flag is implied by -O0, -O or -O2. + +optLevelFlags :: [([Int], GeneralFlag)] +-- Default settings of flags, before any command-line overrides +optLevelFlags -- see Note [Documenting optimisation flags] + = [ ([0,1,2], Opt_DoLambdaEtaExpansion) + , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] + , ([0,1,2], Opt_LlvmTBAA) + , ([0,1,2], Opt_ProfManualCcs ) + , ([2], Opt_DictsStrict) + + , ([0], Opt_IgnoreInterfacePragmas) + , ([0], Opt_OmitInterfacePragmas) + + , ([1,2], Opt_CoreConstantFolding) + + , ([1,2], Opt_CallArity) + , ([1,2], Opt_Exitification) + , ([1,2], Opt_CaseMerge) + , ([1,2], Opt_CaseFolding) + , ([1,2], Opt_CmmElimCommonBlocks) + , ([2], Opt_AsmShortcutting) + , ([1,2], Opt_CmmSink) + , ([1,2], Opt_CmmStaticPred) + , ([1,2], Opt_CSE) + , ([1,2], Opt_StgCSE) + , ([2], Opt_StgLiftLams) + , ([1,2], Opt_CmmControlFlow) + + , ([1,2], Opt_EnableRewriteRules) + -- Off for -O0. Otherwise we desugar list literals + -- to 'build' but don't run the simplifier passes that + -- would rewrite them back to cons cells! This seems + -- silly, and matters for the GHCi debugger. + + , ([1,2], Opt_FloatIn) + , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_IgnoreAsserts) + , ([1,2], Opt_Loopification) + , ([1,2], Opt_CfgBlocklayout) -- Experimental + + , ([1,2], Opt_Specialise) + , ([1,2], Opt_CrossModuleSpecialise) + , ([1,2], Opt_InlineGenerics) + , ([1,2], Opt_Strictness) + , ([1,2], Opt_UnboxSmallStrictFields) + , ([1,2], Opt_CprAnal) + , ([1,2], Opt_WorkerWrapper) + , ([1,2], Opt_SolveConstantDicts) + , ([1,2], Opt_NumConstantFolding) + + , ([2], Opt_LiberateCase) + , ([2], Opt_SpecConstr) + , ([2], Opt_FastPAPCalls) +-- , ([2], Opt_RegsGraph) +-- RegsGraph suffers performance regression. See #7679 +-- , ([2], Opt_StaticArgumentTransformation) +-- Static Argument Transformation needs investigation. See #9374 + ] + +type TurnOnFlag = Bool -- True <=> we are turning the flag on + -- False <=> we are turning the flag off +turnOn :: TurnOnFlag; turnOn = True +turnOff :: TurnOnFlag; turnOff = False + +default_PIC :: Platform -> [GeneralFlag] +default_PIC platform = + case (platformOS platform, platformArch platform) of + -- Darwin always requires PIC. Especially on more recent macOS releases + -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses + -- while we could work around this on x86_64 (like WINE does), we won't be + -- able on aarch64, where this is enforced. + (OSDarwin, ArchX86_64) -> [Opt_PIC] + -- For AArch64, we need to always have PIC enabled. The relocation model + -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't + -- control much how far apart symbols are in memory for our in-memory static + -- linker; and thus need to ensure we get sufficiently capable relocations. + -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top + -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to + -- be built with -fPIC. + (OSDarwin, ArchAArch64) -> [Opt_PIC] + (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] + (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in + -- OpenBSD since 5.3 release + -- (1 May 2013) we need to + -- always generate PIC. See + -- #10597 for more + -- information. + _ -> [] + +-- | The language extensions implied by the various language variants. +-- When updating this be sure to update the flag documentation in +-- @docs/users_guide/exts at . +languageExtensions :: Maybe Language -> [LangExt.Extension] + +-- Nothing: the default case +languageExtensions Nothing = languageExtensions (Just GHC2021) + +languageExtensions (Just Haskell98) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.NPlusKPatterns, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.FieldSelectors, + LangExt.NondecreasingIndentation, + -- strictly speaking non-standard, but we always had this + -- on implicitly before the option was added in 7.1, and + -- turning it off breaks code, so we're keeping it on for + -- backwards compatibility. Cabal uses -XHaskell98 by + -- default unless you specify another language. + LangExt.DeepSubsumption + -- Non-standard but enabled for backwards compatability (see GHC proposal #511) + ] + +languageExtensions (Just Haskell2010) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.CUSKs, + LangExt.MonomorphismRestriction, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + LangExt.DeepSubsumption ] + +languageExtensions (Just GHC2021) + = [LangExt.ImplicitPrelude, + -- See Note [When is StarIsType enabled] + LangExt.StarIsType, + LangExt.MonomorphismRestriction, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.FieldSelectors, + LangExt.RelaxedPolyRec, + -- Now the new extensions (not in Haskell2010) + LangExt.BangPatterns, + LangExt.BinaryLiterals, + LangExt.ConstrainedClassMethods, + LangExt.ConstraintKinds, + LangExt.DeriveDataTypeable, + LangExt.DeriveFoldable, + LangExt.DeriveFunctor, + LangExt.DeriveGeneric, + LangExt.DeriveLift, + LangExt.DeriveTraversable, + LangExt.EmptyCase, + LangExt.EmptyDataDeriving, + LangExt.ExistentialQuantification, + LangExt.ExplicitForAll, + LangExt.FlexibleContexts, + LangExt.FlexibleInstances, + LangExt.GADTSyntax, + LangExt.GeneralizedNewtypeDeriving, + LangExt.HexFloatLiterals, + LangExt.ImportQualifiedPost, + LangExt.InstanceSigs, + LangExt.KindSignatures, + LangExt.MultiParamTypeClasses, + LangExt.NamedFieldPuns, + LangExt.NamedWildCards, + LangExt.NumericUnderscores, + LangExt.PolyKinds, + LangExt.PostfixOperators, + LangExt.RankNTypes, + LangExt.ScopedTypeVariables, + LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.StandaloneDeriving, + LangExt.StandaloneKindSignatures, + LangExt.TupleSections, + LangExt.TypeApplications, + LangExt.TypeOperators, + LangExt.TypeSynonymInstances] + + +ways :: DynFlags -> Ways +ways dflags + | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) + | otherwise = targetWays_ dflags +-- +-- System tool settings and locations + +programName :: DynFlags -> String +programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags +projectVersion :: DynFlags -> String +projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) +ghcUsagePath :: DynFlags -> FilePath +ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags +ghciUsagePath :: DynFlags -> FilePath +ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags +topDir :: DynFlags -> FilePath +topDir dflags = fileSettings_topDir $ fileSettings dflags +toolDir :: DynFlags -> Maybe FilePath +toolDir dflags = fileSettings_toolDir $ fileSettings dflags +extraGccViaCFlags :: DynFlags -> [String] +extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags +globalPackageDatabasePath :: DynFlags -> FilePath +globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags + +-- | The directory for this version of ghc in the user's app directory +-- The appdir used to be in ~/.ghc but to respect the XDG specification +-- we want to move it under $XDG_DATA_HOME/ +-- However, old tooling (like cabal) might still write package environments +-- to the old directory, so we prefer that if a subdirectory of ~/.ghc +-- with the correct target and GHC version suffix exists. +-- +-- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that +-- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR +-- +-- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version +versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath +versionedAppDir appname platform = do + -- Make sure we handle the case the HOME isn't set (see #11678) + -- We need to fallback to the old scheme if the subdirectory exists. + msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) + [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ + , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ + ] + where + checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case + True -> pure dir + False -> MaybeT (pure Nothing) + +versionedFilePath :: ArchOS -> FilePath +versionedFilePath platform = uniqueSubdir platform + +-- SDoc +------------------------------------------- + +-- | Initialize the pretty-printing options +initSDocContext :: DynFlags -> PprStyle -> SDocContext +initSDocContext dflags style = SDC + { sdocStyle = style + , sdocColScheme = colScheme dflags + , sdocLastColour = Col.colReset + , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) + , sdocDefaultDepth = pprUserLength dflags + , sdocLineLength = pprCols dflags + , sdocCanUseUnicode = useUnicode dflags + , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags + , sdocPprDebug = dopt Opt_D_ppr_debug dflags + , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags + , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags + , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags + , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags + , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags + , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags + , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags + , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags + , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags + , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags + , sdocSuppressTicks = gopt Opt_SuppressTicks dflags + , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags + , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags + , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags + , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags + , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags + , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags + , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags + , sdocSuppressUniques = gopt Opt_SuppressUniques dflags + , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags + , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags + , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags + , sdocErrorSpans = gopt Opt_ErrorSpans dflags + , sdocStarIsType = xopt LangExt.StarIsType dflags + , sdocLinearTypes = xopt LangExt.LinearTypes dflags + , sdocListTuplePuns = True + , sdocPrintTypeAbbreviations = True + , sdocUnitIdForUser = ftext + } + +-- | Initialize the pretty-printing options using the default user style +initDefaultSDocContext :: DynFlags -> SDocContext +initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle + +initPromotionTickContext :: DynFlags -> PromotionTickContext +initPromotionTickContext dflags = + PromTickCtx { + ptcListTuplePuns = True, + ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags + } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -41,7 +41,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Errors ( printOrThrowDiagnostics ) import GHC.Driver.Errors.Types ( GhcMessage ) import GHC.Driver.Config.Logger (initLogFlags) ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -7,7 +7,7 @@ module GHC.Driver.Env.Types import GHC.Driver.Errors.Types ( GhcMessage ) import {-# SOURCE #-} GHC.Driver.Hooks -import GHC.Driver.Session ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) +import GHC.Driver.DynFlags ( ContainsDynFlags(..), HasDynFlags(..), DynFlags ) import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Prelude ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Prelude import GHC.Driver.Errors.Types import GHC.Driver.Flags -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () import GHC.Types.Error ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Prelude import Data.Bifunctor import Data.Typeable -import GHC.Driver.Session (DynFlags, PackageArg, gopt) +import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt) import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage)) import GHC.Types.Error import GHC.Unit.Module @@ -384,4 +384,4 @@ checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage checkBuildingCabalPackage dflags = if gopt Opt_BuildingCabalPackage dflags then YesBuildingCabalPackage - else NoBuildingCabalPackage \ No newline at end of file + else NoBuildingCabalPackage ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -32,7 +32,7 @@ where import GHC.Prelude import GHC.Driver.Env -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Driver.Pipeline.Phases import GHC.Hs.Decls ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -11,7 +11,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.State import GHC.Utils.Outputable ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -230,53 +230,40 @@ import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile -import GHC.UniqueSubdir (uniqueSubdir) import GHC.Unit.Types import GHC.Unit.Parser import GHC.Unit.Module import GHC.Unit.Module.Warnings -import GHC.Builtin.Names ( mAIN_NAME ) -import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.DynFlags import GHC.Driver.Flags import GHC.Driver.Backend import GHC.Driver.Plugins.External import GHC.Settings.Config -import GHC.Utils.CliOption import GHC.Core.Unfold import GHC.Driver.CmdLine -import GHC.Settings.Constants import GHC.Utils.Panic -import qualified GHC.Utils.Ppr.Colour as Col import GHC.Utils.Misc import GHC.Utils.Constants (debugIsOn) import GHC.Utils.GlobalVars import GHC.Data.Maybe import GHC.Data.Bool import GHC.Utils.Monad -import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.SrcLoc import GHC.Types.SafeHaskell -import GHC.Types.Basic ( IntWithInf, treatZeroAsInf ) -import GHC.Types.ProfAuto -import qualified GHC.Types.FieldLabel as FieldLabel +import GHC.Types.Basic ( treatZeroAsInf ) import GHC.Data.FastString import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable import GHC.Settings import GHC.CmmToAsm.CFG.Weight -import {-# SOURCE #-} GHC.Core.Opt.CallerCC +import GHC.Core.Opt.CallerCC -import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) import Data.IORef import Control.Arrow ((&&&)) import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.Writer -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Except import Control.Monad.Trans.State as State import Data.Functor.Identity @@ -287,17 +274,11 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set import System.FilePath -import System.Directory -import System.Environment (lookupEnv) -import System.IO -import System.IO.Error import Text.ParserCombinators.ReadP hiding (char) import Text.ParserCombinators.ReadP as R -import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet -import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -- Note [Updating flag description in the User's Guide] @@ -376,387 +357,6 @@ import qualified GHC.LanguageExtensions as LangExt -- ----------------------------------------------------------------------------- -- DynFlags --- | Used to differentiate the scope an include needs to apply to. --- We have to split the include paths to avoid accidentally forcing recursive --- includes since -I overrides the system search paths. See #14312. -data IncludeSpecs - = IncludeSpecs { includePathsQuote :: [String] - , includePathsGlobal :: [String] - -- | See Note [Implicit include paths] - , includePathsQuoteImplicit :: [String] - } - deriving Show - --- | Append to the list of includes a path that shall be included using `-I` --- when the C compiler is called. These paths override system search paths. -addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addGlobalInclude spec paths = let f = includePathsGlobal spec - in spec { includePathsGlobal = f ++ paths } - --- | Append to the list of includes a path that shall be included using --- `-iquote` when the C compiler is called. These paths only apply when quoted --- includes are used. e.g. #include "foo.h" -addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addQuoteInclude spec paths = let f = includePathsQuote spec - in spec { includePathsQuote = f ++ paths } - --- | These includes are not considered while fingerprinting the flags for iface --- | See Note [Implicit include paths] -addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec - in spec { includePathsQuoteImplicit = f ++ paths } - - --- | Concatenate and flatten the list of global and quoted includes returning --- just a flat list of paths. -flattenIncludes :: IncludeSpecs -> [String] -flattenIncludes specs = - includePathsQuote specs ++ - includePathsQuoteImplicit specs ++ - includePathsGlobal specs - -{- Note [Implicit include paths] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - The compile driver adds the path to the folder containing the source file being - compiled to the 'IncludeSpecs', and this change gets recorded in the 'DynFlags' - that are used later to compute the interface file. Because of this, - the flags fingerprint derived from these 'DynFlags' and recorded in the - interface file will end up containing the absolute path to the source folder. - - Build systems with a remote cache like Bazel or Buck (or Shake, see #16956) - store the build artifacts produced by a build BA for reuse in subsequent builds. - - Embedding source paths in interface fingerprints will thwart these attempts and - lead to unnecessary recompilations when the source paths in BA differ from the - source paths in subsequent builds. - -} - - --- | Contains not only a collection of 'GeneralFlag's but also a plethora of --- information relating to the compilation of a single file or GHC session -data DynFlags = DynFlags { - ghcMode :: GhcMode, - ghcLink :: GhcLink, - backend :: !Backend, - -- ^ The backend to use (if any). - -- - -- Whenever you change the backend, also make sure to set 'ghcLink' to - -- something sensible. - -- - -- 'NoBackend' can be used to avoid generating any output, however, note that: - -- - -- * If a program uses Template Haskell the typechecker may need to run code - -- from an imported module. To facilitate this, code generation is enabled - -- for modules imported by modules that use template haskell, using the - -- default backend for the platform. - -- See Note [-fno-code mode]. - - - -- formerly Settings - ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, - fileSettings :: {-# UNPACK #-} !FileSettings, - targetPlatform :: Platform, -- Filled in by SysTools - toolSettings :: {-# UNPACK #-} !ToolSettings, - platformMisc :: {-# UNPACK #-} !PlatformMisc, - rawSettings :: [(String, String)], - tmpDir :: TempDir, - - llvmOptLevel :: Int, -- ^ LLVM optimisation level - verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] - debugLevel :: Int, -- ^ How much debug information to produce - simplPhases :: Int, -- ^ Number of simplifier phases - maxSimplIterations :: Int, -- ^ Max simplifier iterations - ruleCheck :: Maybe String, - strictnessBefore :: [Int], -- ^ Additional demand analysis - - parMakeCount :: Maybe ParMakeCount, - -- ^ The number of modules to compile in parallel - -- If unspecified, compile with a single job. - - enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? - ghcHeapSize :: Maybe Int, -- ^ The heap size to set. - - maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt - -- to show in type error messages - maxValidHoleFits :: Maybe Int, -- ^ Maximum number of hole fits to show - -- in typed hole error messages - maxRefHoleFits :: Maybe Int, -- ^ Maximum number of refinement hole - -- fits to show in typed hole error - -- messages - refLevelHoleFits :: Maybe Int, -- ^ Maximum level of refinement for - -- refinement hole fits in typed hole - -- error messages - maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show - -- in non-exhaustiveness warnings - maxPmCheckModels :: Int, -- ^ Soft limit on the number of models - -- the pattern match checker checks - -- a pattern against. A safe guard - -- against exponential blow-up. - simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks - dmdUnboxWidth :: !Int, -- ^ Whether DmdAnal should optimistically put an - -- Unboxed demand on returned products with at most - -- this number of fields - specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr - specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function - specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types - -- Not optional; otherwise ForceSpecConstr can diverge. - binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above - -- this threshold will be dumped in a binary file - -- by the assembler code generator. 0 and Nothing disables - -- this feature. See 'GHC.StgToCmm.Config'. - liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase - floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating - -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' - - liftLamsRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- recursive function. - liftLamsNonRecArgs :: Maybe Int, -- ^ Maximum number of arguments after lambda lifting a - -- non-recursive function. - liftLamsKnown :: Bool, -- ^ Lambda lift even when this turns a known call - -- into an unknown call. - - cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundary or use default. - - historySize :: Int, -- ^ Simplification history size - - importPaths :: [FilePath], - mainModuleNameIs :: ModuleName, - mainFunIs :: Maybe String, - reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth - solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver - -- Typically only 1 is needed - givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens - -- Should be < solverIterations - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints - -- Should be < givensFuel - -- See Note [Expanding Recursive Superclasses and ExpansionFuel] - homeUnitId_ :: UnitId, -- ^ Target home unit-id - homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate - homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations - - -- Note [Filepaths and Multiple Home Units] - workingDirectory :: Maybe FilePath, - thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units - hiddenModules :: Set.Set ModuleName, - reexportedModules :: Set.Set ModuleName, - - -- ways - targetWays_ :: Ways, -- ^ Target way flags from the command line - - -- For object splitting - splitInfo :: Maybe (String,Int), - - -- paths etc. - objectDir :: Maybe String, - dylibInstallName :: Maybe String, - hiDir :: Maybe String, - hieDir :: Maybe String, - stubDir :: Maybe String, - dumpDir :: Maybe String, - - objectSuf_ :: String, - hcSuf :: String, - hiSuf_ :: String, - hieSuf :: String, - - dynObjectSuf_ :: String, - dynHiSuf_ :: String, - - outputFile_ :: Maybe String, - dynOutputFile_ :: Maybe String, - outputHi :: Maybe String, - dynOutputHi :: Maybe String, - dynLibLoader :: DynLibLoader, - - dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output - -- because of -dynamic-too. This predicate is - -- used to query the appropriate fields - -- (outputFile/dynOutputFile, ways, etc.) - - -- | This defaults to 'non-module'. It can be set by - -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on - -- where its output is going. - dumpPrefix :: FilePath, - - -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' - -- or 'ghc.GHCi.UI.runStmt'. - -- Set by @-ddump-file-prefix@ - dumpPrefixForce :: Maybe FilePath, - - ldInputs :: [Option], - - includePaths :: IncludeSpecs, - libraryPaths :: [String], - frameworkPaths :: [String], -- used on darwin only - cmdlineFrameworks :: [String], -- ditto - - rtsOpts :: Maybe String, - rtsOptsEnabled :: RtsOptsEnabled, - rtsOptsSuggestions :: Bool, - - hpcDir :: String, -- ^ Path to store the .mix files - - -- Plugins - pluginModNames :: [ModuleName], - -- ^ the @-fplugin@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - pluginModNameOpts :: [(ModuleName,String)], - frontendPluginOpts :: [String], - -- ^ the @-ffrontend-opt@ flags given on the command line, in *reverse* - -- order that they're specified on the command line. - - externalPluginSpecs :: [ExternalPluginSpec], - -- ^ External plugins loaded from shared libraries - - -- For ghc -M - depMakefile :: FilePath, - depIncludePkgDeps :: Bool, - depIncludeCppDeps :: Bool, - depExcludeMods :: [ModuleName], - depSuffixes :: [String], - - -- Package flags - packageDBFlags :: [PackageDBFlag], - -- ^ The @-package-db@ flags given on the command line, In - -- *reverse* order that they're specified on the command line. - -- This is intended to be applied with the list of "initial" - -- package databases derived from @GHC_PACKAGE_PATH@; see - -- 'getUnitDbRefs'. - - ignorePackageFlags :: [IgnorePackageFlag], - -- ^ The @-ignore-package@ flags from the command line. - -- In *reverse* order that they're specified on the command line. - packageFlags :: [PackageFlag], - -- ^ The @-package@ and @-hide-package@ flags from the command-line. - -- In *reverse* order that they're specified on the command line. - pluginPackageFlags :: [PackageFlag], - -- ^ The @-plugin-package-id@ flags from command line. - -- In *reverse* order that they're specified on the command line. - trustFlags :: [TrustFlag], - -- ^ The @-trust@ and @-distrust@ flags. - -- In *reverse* order that they're specified on the command line. - packageEnv :: Maybe FilePath, - -- ^ Filepath to the package environment file (if overriding default) - - - -- hsc dynamic flags - dumpFlags :: EnumSet DumpFlag, - generalFlags :: EnumSet GeneralFlag, - warningFlags :: EnumSet WarningFlag, - fatalWarningFlags :: EnumSet WarningFlag, - customWarningCategories :: WarningCategorySet, -- See Note [Warning categories] - fatalCustomWarningCategories :: WarningCategorySet, -- in GHC.Unit.Module.Warnings - -- Don't change this without updating extensionFlags: - language :: Maybe Language, - -- | Safe Haskell mode - safeHaskell :: SafeHaskellMode, - safeInfer :: Bool, - safeInferred :: Bool, - -- We store the location of where some extension and flags were turned on so - -- we can produce accurate error messages when Safe Haskell fails due to - -- them. - thOnLoc :: SrcSpan, - newDerivOnLoc :: SrcSpan, - deriveViaOnLoc :: SrcSpan, - overlapInstLoc :: SrcSpan, - incoherentOnLoc :: SrcSpan, - pkgTrustOnLoc :: SrcSpan, - warnSafeOnLoc :: SrcSpan, - warnUnsafeOnLoc :: SrcSpan, - trustworthyOnLoc :: SrcSpan, - -- Don't change this without updating extensionFlags: - -- Here we collect the settings of the language extensions - -- from the command line, the ghci config file and - -- from interactive :set / :seti commands. - extensions :: [OnOff LangExt.Extension], - -- extensionFlags should always be equal to - -- flattenExtensionFlags language extensions - -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used - -- by template-haskell - extensionFlags :: EnumSet LangExt.Extension, - - -- | Unfolding control - -- See Note [Discounts and thresholds] in GHC.Core.Unfold - unfoldingOpts :: !UnfoldingOpts, - - maxWorkerArgs :: Int, - - ghciHistSize :: Int, - - flushOut :: FlushOut, - - ghcVersionFile :: Maybe FilePath, - haddockOptions :: Maybe String, - - -- | GHCi scripts specified by -ghci-script, in reverse order - ghciScripts :: [String], - - -- Output style options - pprUserLength :: Int, - pprCols :: Int, - - useUnicode :: Bool, - useColor :: OverridingBool, - canUseColor :: Bool, - colScheme :: Col.Scheme, - - -- | what kind of {-# SCC #-} to add automatically - profAuto :: ProfAuto, - callerCcFilters :: [CallerCcFilter], - - interactivePrint :: Maybe String, - - -- | Machine dependent flags (-m\ stuff) - sseVersion :: Maybe SseVersion, - bmiVersion :: Maybe BmiVersion, - avx :: Bool, - avx2 :: Bool, - avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. - avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. - avx512f :: Bool, -- Enable AVX-512 instructions. - avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. - fma :: Bool, -- ^ Enable FMA instructions. - - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - - -- Constants used to control the amount of optimization done. - - -- | Max size, in bytes, of inline array allocations. - maxInlineAllocSize :: Int, - - -- | Only inline memcpy if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemcpyInsns :: Int, - - -- | Only inline memset if it generates no more than this many - -- pseudo (roughly: Cmm) instructions. - maxInlineMemsetInsns :: Int, - - -- | Reverse the order of error messages in GHC/GHCi - reverseErrors :: Bool, - - -- | Limit the maximum number of errors to show - maxErrors :: Maybe Int, - - -- | Unique supply configuration for testing build determinism - initialUnique :: Word, - uniqueIncrement :: Int, - -- 'Int' because it can be used to test uniques in decreasing order. - - -- | Temporary: CFG Edge weights for fast iterations - cfgWeights :: Weights -} {- Note [RHS Floating] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -767,43 +367,6 @@ data DynFlags = DynFlags { allows for experimentation. -} -class HasDynFlags m where - getDynFlags :: m DynFlags - -{- It would be desirable to have the more generalised - - instance (MonadTrans t, Monad m, HasDynFlags m) => HasDynFlags (t m) where - getDynFlags = lift getDynFlags - -instance definition. However, that definition would overlap with the -`HasDynFlags (GhcT m)` instance. Instead we define instances for a -couple of common Monad transformers explicitly. -} - -instance (Monoid a, Monad m, HasDynFlags m) => HasDynFlags (WriterT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ReaderT a m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (MaybeT m) where - getDynFlags = lift getDynFlags - -instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where - getDynFlags = lift getDynFlags - -class ContainsDynFlags t where - extractDynFlags :: t -> DynFlags - --- | The type for the -jN argument, specifying that -j on its own represents --- using the number of machine processors. -data ParMakeCount - -- | Use this many processors (@-j@ flag). - = ParMakeThisMany Int - -- | Use parallelism with as many processors as possible (@-j@ flag without an argument). - | ParMakeNumProcessors - -- | Use the specific semaphore @@ to control parallelism (@-jsem @ flag). - | ParMakeSemaphore FilePath - ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -820,22 +383,6 @@ settings dflags = Settings , sRawSettings = rawSettings dflags } -programName :: DynFlags -> String -programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags -projectVersion :: DynFlags -> String -projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags) -ghcUsagePath :: DynFlags -> FilePath -ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags -ghciUsagePath :: DynFlags -> FilePath -ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags -toolDir :: DynFlags -> Maybe FilePath -toolDir dflags = fileSettings_toolDir $ fileSettings dflags -topDir :: DynFlags -> FilePath -topDir dflags = fileSettings_topDir $ fileSettings dflags -extraGccViaCFlags :: DynFlags -> [String] -extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags -globalPackageDatabasePath :: DynFlags -> FilePath -globalPackageDatabasePath dflags = fileSettings_globalPackageDatabase $ fileSettings dflags pgm_L :: DynFlags -> String pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags pgm_P :: DynFlags -> (String,[Option]) @@ -909,430 +456,8 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags opt_i :: DynFlags -> [String] opt_i dflags= toolSettings_opt_i $ toolSettings dflags --- | The directory for this version of ghc in the user's app directory --- The appdir used to be in ~/.ghc but to respect the XDG specification --- we want to move it under $XDG_DATA_HOME/ --- However, old tooling (like cabal) might still write package environments --- to the old directory, so we prefer that if a subdirectory of ~/.ghc --- with the correct target and GHC version suffix exists. --- --- i.e. if ~/.ghc/$UNIQUE_SUBDIR exists we use that --- otherwise we use $XDG_DATA_HOME/$UNIQUE_SUBDIR --- --- UNIQUE_SUBDIR is typically a combination of the target platform and GHC version -versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath -versionedAppDir appname platform = do - -- Make sure we handle the case the HOME isn't set (see #11678) - -- We need to fallback to the old scheme if the subdirectory exists. - msum $ map (checkIfExists <=< fmap ( versionedFilePath platform)) - [ tryMaybeT $ getAppUserDataDirectory appname -- this is ~/.ghc/ - , tryMaybeT $ getXdgDirectory XdgData appname -- this is $XDG_DATA_HOME/ - ] - where - checkIfExists dir = tryMaybeT (doesDirectoryExist dir) >>= \case - True -> pure dir - False -> MaybeT (pure Nothing) - -versionedFilePath :: ArchOS -> FilePath -versionedFilePath platform = uniqueSubdir platform - --- | The 'GhcMode' tells us whether we're doing multi-module --- compilation (controlled via the "GHC" API) or one-shot --- (single-module) compilation. This makes a difference primarily to --- the "GHC.Unit.Finder": in one-shot mode we look for interface files for --- imported modules, but in multi-module mode we look for source files --- in order to check whether they need to be recompiled. -data GhcMode - = CompManager -- ^ @\-\-make@, GHCi, etc. - | OneShot -- ^ @ghc -c Foo.hs@ - | MkDepend -- ^ @ghc -M@, see "GHC.Unit.Finder" for why we need this - deriving Eq - -instance Outputable GhcMode where - ppr CompManager = text "CompManager" - ppr OneShot = text "OneShot" - ppr MkDepend = text "MkDepend" - -isOneShot :: GhcMode -> Bool -isOneShot OneShot = True -isOneShot _other = False - --- | What to do in the link step, if there is one. -data GhcLink - = NoLink -- ^ Don't link at all - | LinkBinary -- ^ Link object code into a binary - | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both - -- bytecode and object code). - | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) - | LinkStaticLib -- ^ Link objects into a static lib - | LinkMergedObj -- ^ Link objects into a merged "GHCi object" - deriving (Eq, Show) - -isNoLink :: GhcLink -> Bool -isNoLink NoLink = True -isNoLink _ = False - --- | We accept flags which make packages visible, but how they select --- the package varies; this data type reflects what selection criterion --- is used. -data PackageArg = - PackageArg String -- ^ @-package@, by 'PackageName' - | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' - deriving (Eq, Show) - -instance Outputable PackageArg where - ppr (PackageArg pn) = text "package" <+> text pn - ppr (UnitIdArg uid) = text "unit" <+> ppr uid - --- | Represents the renaming that may be associated with an exposed --- package, e.g. the @rns@ part of @-package "foo (rns)"@. --- --- Here are some example parsings of the package flags (where --- a string literal is punned to be a 'ModuleName': --- --- * @-package foo@ is @ModRenaming True []@ --- * @-package foo ()@ is @ModRenaming False []@ --- * @-package foo (A)@ is @ModRenaming False [("A", "A")]@ --- * @-package foo (A as B)@ is @ModRenaming False [("A", "B")]@ --- * @-package foo with (A as B)@ is @ModRenaming True [("A", "B")]@ -data ModRenaming = ModRenaming { - modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? - modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope - -- under name @n at . - } deriving (Eq) -instance Outputable ModRenaming where - ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) - --- | Flags for manipulating the set of non-broken packages. -newtype IgnorePackageFlag = IgnorePackage String -- ^ @-ignore-package@ - deriving (Eq) - --- | Flags for manipulating package trust. -data TrustFlag - = TrustPackage String -- ^ @-trust@ - | DistrustPackage String -- ^ @-distrust@ - deriving (Eq) - --- | Flags for manipulating packages visibility. -data PackageFlag - = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ - | HidePackage String -- ^ @-hide-package@ - deriving (Eq) -- NB: equality instance is used by packageFlagsChanged - -data PackageDBFlag - = PackageDB PkgDbRef - | NoUserPackageDB - | NoGlobalPackageDB - | ClearPackageDBs - deriving (Eq) - -packageFlagsChanged :: DynFlags -> DynFlags -> Bool -packageFlagsChanged idflags1 idflags0 = - packageFlags idflags1 /= packageFlags idflags0 || - ignorePackageFlags idflags1 /= ignorePackageFlags idflags0 || - pluginPackageFlags idflags1 /= pluginPackageFlags idflags0 || - trustFlags idflags1 /= trustFlags idflags0 || - packageDBFlags idflags1 /= packageDBFlags idflags0 || - packageGFlags idflags1 /= packageGFlags idflags0 - where - packageGFlags dflags = map (`gopt` dflags) - [ Opt_HideAllPackages - , Opt_HideAllPluginPackages - , Opt_AutoLinkPackages ] - -instance Outputable PackageFlag where - ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn) - ppr (HidePackage str) = text "-hide-package" <+> text str - -data DynLibLoader - = Deployable - | SystemDependent - deriving Eq - -data RtsOptsEnabled - = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly - | RtsOptsAll - deriving (Show) - --- | Are we building with @-fPIE@ or @-fPIC@ enabled? -positionIndependent :: DynFlags -> Bool -positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags - --- Note [-dynamic-too business] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- With -dynamic-too flag, we try to build both the non-dynamic and dynamic --- objects in a single run of the compiler: the pipeline is the same down to --- Core optimisation, then the backend (from Core to object code) is executed --- twice. --- --- The implementation is currently rather hacky, for example, we don't clearly separate non-dynamic --- and dynamic loaded interfaces (#9176). --- --- To make matters worse, we automatically enable -dynamic-too when some modules --- need Template-Haskell and GHC is dynamically linked (cf --- GHC.Driver.Pipeline.compileOne'). --- --- We used to try and fall back from a dynamic-too failure but this feature --- didn't work as expected (#20446) so it was removed to simplify the --- implementation and not obscure latent bugs. - -data DynamicTooState - = DT_Dont -- ^ Don't try to build dynamic objects too - | DT_OK -- ^ Will still try to generate dynamic objects - | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) - deriving (Eq,Show,Ord) - -dynamicTooState :: DynFlags -> DynamicTooState -dynamicTooState dflags - | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont - | dynamicNow dflags = DT_Dyn - | otherwise = DT_OK - -setDynamicNow :: DynFlags -> DynFlags -setDynamicNow dflags0 = - dflags0 - { dynamicNow = True - } - ----------------------------------------------------------------------------- --- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value -initDynFlags :: DynFlags -> IO DynFlags -initDynFlags dflags = do - let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing - canUseUnicode <- do let enc = localeEncoding - str = "‘’" - (withCString enc str $ \cstr -> - do str' <- peekCString enc cstr - return (str == str')) - `catchIOError` \_ -> return False - ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" - let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode - maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" - maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" - let adjustCols (Just env) = Col.parseScheme env - adjustCols Nothing = id - let (useColor', colScheme') = - (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) - (useColor dflags, colScheme dflags) - tmp_dir <- normalise <$> getTemporaryDirectory - return dflags{ - useUnicode = useUnicode', - useColor = useColor', - canUseColor = stderrSupportsAnsiColors, - colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, - tmpDir = TempDir tmp_dir - } - --- | The normal 'DynFlags'. Note that they are not suitable for use in this form --- and must be fully initialized by 'GHC.runGhc' first. -defaultDynFlags :: Settings -> DynFlags -defaultDynFlags mySettings = --- See Note [Updating flag description in the User's Guide] - DynFlags { - ghcMode = CompManager, - ghcLink = LinkBinary, - backend = platformDefaultBackend (sTargetPlatform mySettings), - verbosity = 0, - debugLevel = 0, - simplPhases = 2, - maxSimplIterations = 4, - ruleCheck = Nothing, - binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) - maxRelevantBinds = Just 6, - maxValidHoleFits = Just 6, - maxRefHoleFits = Just 6, - refLevelHoleFits = Nothing, - maxUncoveredPatterns = 4, - maxPmCheckModels = 30, - simplTickFactor = 100, - dmdUnboxWidth = 3, -- Default: Assume an unboxed demand on function bodies returning a triple - specConstrThreshold = Just 2000, - specConstrCount = Just 3, - specConstrRecursive = 3, - liberateCaseThreshold = Just 2000, - floatLamArgs = Just 0, -- Default: float only if no fvs - liftLamsRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsNonRecArgs = Just 5, -- Default: the number of available argument hardware registers on x86_64 - liftLamsKnown = False, -- Default: don't turn known calls into unknown ones - cmmProcAlignment = Nothing, - - historySize = 20, - strictnessBefore = [], - - parMakeCount = Nothing, - - enableTimeStats = False, - ghcHeapSize = Nothing, - - importPaths = ["."], - mainModuleNameIs = mAIN_NAME, - mainFunIs = Nothing, - reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, - solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, - givensFuel = mAX_GIVENS_FUEL, - wantedsFuel = mAX_WANTEDS_FUEL, - qcsFuel = mAX_QC_FUEL, - - homeUnitId_ = mainUnitId, - homeUnitInstanceOf_ = Nothing, - homeUnitInstantiations_ = [], - - workingDirectory = Nothing, - thisPackageName = Nothing, - hiddenModules = Set.empty, - reexportedModules = Set.empty, - - objectDir = Nothing, - dylibInstallName = Nothing, - hiDir = Nothing, - hieDir = Nothing, - stubDir = Nothing, - dumpDir = Nothing, - - objectSuf_ = phaseInputExt StopLn, - hcSuf = phaseInputExt HCc, - hiSuf_ = "hi", - hieSuf = "hie", - - dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, - dynHiSuf_ = "dyn_hi", - dynamicNow = False, - - pluginModNames = [], - pluginModNameOpts = [], - frontendPluginOpts = [], - - externalPluginSpecs = [], - - outputFile_ = Nothing, - dynOutputFile_ = Nothing, - outputHi = Nothing, - dynOutputHi = Nothing, - dynLibLoader = SystemDependent, - dumpPrefix = "non-module.", - dumpPrefixForce = Nothing, - ldInputs = [], - includePaths = IncludeSpecs [] [] [], - libraryPaths = [], - frameworkPaths = [], - cmdlineFrameworks = [], - rtsOpts = Nothing, - rtsOptsEnabled = RtsOptsSafeOnly, - rtsOptsSuggestions = True, - - hpcDir = ".hpc", - - packageDBFlags = [], - packageFlags = [], - pluginPackageFlags = [], - ignorePackageFlags = [], - trustFlags = [], - packageEnv = Nothing, - targetWays_ = Set.empty, - splitInfo = Nothing, - - ghcNameVersion = sGhcNameVersion mySettings, - fileSettings = sFileSettings mySettings, - toolSettings = sToolSettings mySettings, - targetPlatform = sTargetPlatform mySettings, - platformMisc = sPlatformMisc mySettings, - rawSettings = sRawSettings mySettings, - - tmpDir = panic "defaultDynFlags: uninitialized tmpDir", - - llvmOptLevel = 0, - - -- ghc -M values - depMakefile = "Makefile", - depIncludePkgDeps = False, - depIncludeCppDeps = False, - depExcludeMods = [], - depSuffixes = [], - -- end of ghc -M values - ghcVersionFile = Nothing, - haddockOptions = Nothing, - dumpFlags = EnumSet.empty, - generalFlags = EnumSet.fromList (defaultFlags mySettings), - warningFlags = EnumSet.fromList standardWarnings, - fatalWarningFlags = EnumSet.empty, - customWarningCategories = completeWarningCategorySet, - fatalCustomWarningCategories = emptyWarningCategorySet, - ghciScripts = [], - language = Nothing, - safeHaskell = Sf_None, - safeInfer = True, - safeInferred = True, - thOnLoc = noSrcSpan, - newDerivOnLoc = noSrcSpan, - deriveViaOnLoc = noSrcSpan, - overlapInstLoc = noSrcSpan, - incoherentOnLoc = noSrcSpan, - pkgTrustOnLoc = noSrcSpan, - warnSafeOnLoc = noSrcSpan, - warnUnsafeOnLoc = noSrcSpan, - trustworthyOnLoc = noSrcSpan, - extensions = [], - extensionFlags = flattenExtensionFlags Nothing [], - - unfoldingOpts = defaultUnfoldingOpts, - maxWorkerArgs = 10, - - ghciHistSize = 50, -- keep a log of length 50 by default - - flushOut = defaultFlushOut, - pprUserLength = 5, - pprCols = 100, - useUnicode = False, - useColor = Auto, - canUseColor = False, - colScheme = Col.defaultScheme, - profAuto = NoProfAuto, - callerCcFilters = [], - interactivePrint = Nothing, - sseVersion = Nothing, - bmiVersion = Nothing, - avx = False, - avx2 = False, - avx512cd = False, - avx512er = False, - avx512f = False, - avx512pf = False, - fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", - - maxInlineAllocSize = 128, - maxInlineMemcpyInsns = 32, - maxInlineMemsetInsns = 32, - - initialUnique = 0, - uniqueIncrement = 1, - - reverseErrors = False, - maxErrors = Nothing, - cfgWeights = defaultWeights - } - -type FatalMessager = String -> IO () - -defaultFatalMessager :: FatalMessager -defaultFatalMessager = hPutStrLn stderr - - -newtype FlushOut = FlushOut (IO ()) - -defaultFlushOut :: FlushOut -defaultFlushOut = FlushOut $ hFlush stdout - {- Note [Verbosity levels] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -1344,283 +469,6 @@ Note [Verbosity levels] 5 | "ghc -v -ddump-all" -} -data OnOff a = On a - | Off a - deriving (Eq, Show) - -instance Outputable a => Outputable (OnOff a) where - ppr (On x) = text "On" <+> ppr x - ppr (Off x) = text "Off" <+> ppr x - --- OnOffs accumulate in reverse order, so we use foldr in order to --- process them in the right order -flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension -flattenExtensionFlags ml = foldr f defaultExtensionFlags - where f (On f) flags = EnumSet.insert f flags - f (Off f) flags = EnumSet.delete f flags - defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) - --- | The language extensions implied by the various language variants. --- When updating this be sure to update the flag documentation in --- @docs/users_guide/exts at . -languageExtensions :: Maybe Language -> [LangExt.Extension] - --- Nothing: the default case -languageExtensions Nothing = languageExtensions (Just GHC2021) - -languageExtensions (Just Haskell98) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.NPlusKPatterns, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.FieldSelectors, - LangExt.NondecreasingIndentation, - -- strictly speaking non-standard, but we always had this - -- on implicitly before the option was added in 7.1, and - -- turning it off breaks code, so we're keeping it on for - -- backwards compatibility. Cabal uses -XHaskell98 by - -- default unless you specify another language. - LangExt.DeepSubsumption - -- Non-standard but enabled for backwards compatability (see GHC proposal #511) - ] - -languageExtensions (Just Haskell2010) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.CUSKs, - LangExt.MonomorphismRestriction, - LangExt.DatatypeContexts, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - LangExt.DeepSubsumption ] - -languageExtensions (Just GHC2021) - = [LangExt.ImplicitPrelude, - -- See Note [When is StarIsType enabled] - LangExt.StarIsType, - LangExt.MonomorphismRestriction, - LangExt.TraditionalRecordSyntax, - LangExt.EmptyDataDecls, - LangExt.ForeignFunctionInterface, - LangExt.PatternGuards, - LangExt.DoAndIfThenElse, - LangExt.FieldSelectors, - LangExt.RelaxedPolyRec, - -- Now the new extensions (not in Haskell2010) - LangExt.BangPatterns, - LangExt.BinaryLiterals, - LangExt.ConstrainedClassMethods, - LangExt.ConstraintKinds, - LangExt.DeriveDataTypeable, - LangExt.DeriveFoldable, - LangExt.DeriveFunctor, - LangExt.DeriveGeneric, - LangExt.DeriveLift, - LangExt.DeriveTraversable, - LangExt.EmptyCase, - LangExt.EmptyDataDeriving, - LangExt.ExistentialQuantification, - LangExt.ExplicitForAll, - LangExt.FlexibleContexts, - LangExt.FlexibleInstances, - LangExt.GADTSyntax, - LangExt.GeneralizedNewtypeDeriving, - LangExt.HexFloatLiterals, - LangExt.ImportQualifiedPost, - LangExt.InstanceSigs, - LangExt.KindSignatures, - LangExt.MultiParamTypeClasses, - LangExt.NamedFieldPuns, - LangExt.NamedWildCards, - LangExt.NumericUnderscores, - LangExt.PolyKinds, - LangExt.PostfixOperators, - LangExt.RankNTypes, - LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" - LangExt.StandaloneDeriving, - LangExt.StandaloneKindSignatures, - LangExt.TupleSections, - LangExt.TypeApplications, - LangExt.TypeOperators, - LangExt.TypeSynonymInstances] - -hasPprDebug :: DynFlags -> Bool -hasPprDebug = dopt Opt_D_ppr_debug - -hasNoDebugOutput :: DynFlags -> Bool -hasNoDebugOutput = dopt Opt_D_no_debug_output - -hasNoStateHack :: DynFlags -> Bool -hasNoStateHack = gopt Opt_G_NoStateHack - -hasNoOptCoercion :: DynFlags -> Bool -hasNoOptCoercion = gopt Opt_G_NoOptCoercion - - --- | Test whether a 'DumpFlag' is set -dopt :: DumpFlag -> DynFlags -> Bool -dopt = getDumpFlagFrom verbosity dumpFlags - --- | Set a 'DumpFlag' -dopt_set :: DynFlags -> DumpFlag -> DynFlags -dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) } - --- | Unset a 'DumpFlag' -dopt_unset :: DynFlags -> DumpFlag -> DynFlags -dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } - --- | Test whether a 'GeneralFlag' is set --- --- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) --- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables --- Opt_SplitSections. --- -gopt :: GeneralFlag -> DynFlags -> Bool -gopt Opt_PIC dflags - | dynamicNow dflags = True -gopt Opt_ExternalDynamicRefs dflags - | dynamicNow dflags = True -gopt Opt_SplitSections dflags - | dynamicNow dflags = False -gopt f dflags = f `EnumSet.member` generalFlags dflags - --- | Set a 'GeneralFlag' -gopt_set :: DynFlags -> GeneralFlag -> DynFlags -gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) } - --- | Unset a 'GeneralFlag' -gopt_unset :: DynFlags -> GeneralFlag -> DynFlags -gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) } - --- | Test whether a 'WarningFlag' is set -wopt :: WarningFlag -> DynFlags -> Bool -wopt f dflags = f `EnumSet.member` warningFlags dflags - --- | Set a 'WarningFlag' -wopt_set :: DynFlags -> WarningFlag -> DynFlags -wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) } - --- | Unset a 'WarningFlag' -wopt_unset :: DynFlags -> WarningFlag -> DynFlags -wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) } - --- | Test whether a 'WarningFlag' is set as fatal -wopt_fatal :: WarningFlag -> DynFlags -> Bool -wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags - --- | Mark a 'WarningFlag' as fatal (do not set the flag) -wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_set_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) } - --- | Mark a 'WarningFlag' as not fatal -wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags -wopt_unset_fatal dfs f - = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) } - - --- | Enable all custom warning categories. -wopt_set_all_custom :: DynFlags -> DynFlags -wopt_set_all_custom dfs - = dfs{ customWarningCategories = completeWarningCategorySet } - --- | Disable all custom warning categories. -wopt_unset_all_custom :: DynFlags -> DynFlags -wopt_unset_all_custom dfs - = dfs{ customWarningCategories = emptyWarningCategorySet } - --- | Mark all custom warning categories as fatal (do not set the flags). -wopt_set_all_fatal_custom :: DynFlags -> DynFlags -wopt_set_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = completeWarningCategorySet } - --- | Mark all custom warning categories as non-fatal. -wopt_unset_all_fatal_custom :: DynFlags -> DynFlags -wopt_unset_all_fatal_custom dfs - = dfs { fatalCustomWarningCategories = emptyWarningCategorySet } - --- | Set a custom 'WarningCategory' -wopt_set_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_custom dfs f = dfs{ customWarningCategories = insertWarningCategorySet f (customWarningCategories dfs) } - --- | Unset a custom 'WarningCategory' -wopt_unset_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_custom dfs f = dfs{ customWarningCategories = deleteWarningCategorySet f (customWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as fatal (do not set the flag) -wopt_set_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_set_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = insertWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Mark a custom 'WarningCategory' as not fatal -wopt_unset_fatal_custom :: DynFlags -> WarningCategory -> DynFlags -wopt_unset_fatal_custom dfs f - = dfs { fatalCustomWarningCategories = deleteWarningCategorySet f (fatalCustomWarningCategories dfs) } - --- | Are there any custom warning categories enabled? -wopt_any_custom :: DynFlags -> Bool -wopt_any_custom dfs = not (nullWarningCategorySet (customWarningCategories dfs)) - - --- | Test whether a 'LangExt.Extension' is set -xopt :: LangExt.Extension -> DynFlags -> Bool -xopt f dflags = f `EnumSet.member` extensionFlags dflags - --- | Set a 'LangExt.Extension' -xopt_set :: DynFlags -> LangExt.Extension -> DynFlags -xopt_set dfs f - = let onoffs = On f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Unset a 'LangExt.Extension' -xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags -xopt_unset dfs f - = let onoffs = Off f : extensions dfs - in dfs { extensions = onoffs, - extensionFlags = flattenExtensionFlags (language dfs) onoffs } - --- | Set or unset a 'LangExt.Extension', unless it has been explicitly --- set or unset before. -xopt_set_unlessExplSpec - :: LangExt.Extension - -> (DynFlags -> LangExt.Extension -> DynFlags) - -> DynFlags -> DynFlags -xopt_set_unlessExplSpec ext setUnset dflags = - let referedExts = stripOnOff <$> extensions dflags - stripOnOff (On x) = x - stripOnOff (Off x) = x - in - if ext `elem` referedExts then dflags else setUnset dflags ext - -xopt_DuplicateRecordFields :: DynFlags -> FieldLabel.DuplicateRecordFields -xopt_DuplicateRecordFields dfs - | xopt LangExt.DuplicateRecordFields dfs = FieldLabel.DuplicateRecordFields - | otherwise = FieldLabel.NoDuplicateRecordFields - -xopt_FieldSelectors :: DynFlags -> FieldLabel.FieldSelectors -xopt_FieldSelectors dfs - | xopt LangExt.FieldSelectors dfs = FieldLabel.FieldSelectors - | otherwise = FieldLabel.NoFieldSelectors - -lang_set :: DynFlags -> Maybe Language -> DynFlags -lang_set dflags lang = - dflags { - language = lang, - extensionFlags = flattenExtensionFlags lang (extensions dflags) - } - -- | Set the Haskell language standard to use setLanguage :: Language -> DynP () setLanguage l = upd (`lang_set` Just l) @@ -3119,11 +1967,6 @@ flagsForCompletion isInteractive modeFilter OnlyGhc = not isInteractive modeFilter HiddenFlag = False -type TurnOnFlag = Bool -- True <=> we are turning the flag on - -- False <=> we are turning the flag off -turnOn :: TurnOnFlag; turnOn = True -turnOff :: TurnOnFlag; turnOff = False - data FlagSpec flag = FlagSpec { flagSpecName :: String -- ^ Flag in string form @@ -3874,62 +2717,6 @@ xFlagsDeps = [ flagSpec "ViewPatterns" LangExt.ViewPatterns ] -defaultFlags :: Settings -> [GeneralFlag] -defaultFlags settings --- See Note [Updating flag description in the User's Guide] - = [ Opt_AutoLinkPackages, - Opt_DiagnosticsShowCaret, - Opt_EmbedManifest, - Opt_FamAppCache, - Opt_GenManifest, - Opt_GhciHistory, - Opt_GhciSandbox, - Opt_HelpfulErrors, - Opt_KeepHiFiles, - Opt_KeepOFiles, - Opt_OmitYields, - Opt_PrintBindContents, - Opt_ProfCountEntries, - Opt_SharedImplib, - Opt_SimplPreInlining, - Opt_VersionMacros, - Opt_RPath, - Opt_DumpWithWays, - Opt_CompactUnwind, - Opt_ShowErrorContext, - Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter - ] - - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - - -- Default floating flags (see Note [RHS Floating]) - ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ] - - - ++ default_PIC platform - - ++ validHoleFitDefaults - - - where platform = sTargetPlatform settings - --- | These are the default settings for the display and sorting of valid hole --- fits in typed-hole error messages. See Note [Valid hole fits include ...] - -- in the "GHC.Tc.Errors.Hole" module. -validHoleFitDefaults :: [GeneralFlag] -validHoleFitDefaults - = [ Opt_ShowTypeAppOfHoleFits - , Opt_ShowTypeOfHoleFits - , Opt_ShowProvOfHoleFits - , Opt_ShowMatchesOfHoleFits - , Opt_ShowValidHoleFits - , Opt_SortValidHoleFits - , Opt_SortBySizeHoleFits - , Opt_ShowHoleConstraints ] - - validHoleFitsImpliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] validHoleFitsImpliedGFlags = [ (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) @@ -3938,32 +2725,6 @@ validHoleFitsImpliedGFlags , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ] -default_PIC :: Platform -> [GeneralFlag] -default_PIC platform = - case (platformOS platform, platformArch platform) of - -- Darwin always requires PIC. Especially on more recent macOS releases - -- there will be a 4GB __ZEROPAGE that prevents us from using 32bit addresses - -- while we could work around this on x86_64 (like WINE does), we won't be - -- able on aarch64, where this is enforced. - (OSDarwin, ArchX86_64) -> [Opt_PIC] - -- For AArch64, we need to always have PIC enabled. The relocation model - -- on AArch64 does not permit arbitrary relocations. Under ASLR, we can't - -- control much how far apart symbols are in memory for our in-memory static - -- linker; and thus need to ensure we get sufficiently capable relocations. - -- This requires PIC on AArch64, and ExternalDynamicRefs on Linux as on top - -- of that. Subsequently we expect all code on aarch64/linux (and macOS) to - -- be built with -fPIC. - (OSDarwin, ArchAArch64) -> [Opt_PIC] - (OSLinux, ArchAArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSLinux, ArchARM {}) -> [Opt_PIC, Opt_ExternalDynamicRefs] - (OSOpenBSD, ArchX86_64) -> [Opt_PIC] -- Due to PIE support in - -- OpenBSD since 5.3 release - -- (1 May 2013) we need to - -- always generate PIC. See - -- #10597 for more - -- information. - _ -> [] - -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] @@ -4053,85 +2814,6 @@ impliedXFlags , (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures) ] --- Note [When is StarIsType enabled] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- The StarIsType extension determines whether to treat '*' as a regular type --- operator or as a synonym for 'Data.Kind.Type'. Many existing pre-TypeInType --- programs expect '*' to be synonymous with 'Type', so by default StarIsType is --- enabled. --- --- Programs that use TypeOperators might expect to repurpose '*' for --- multiplication or another binary operation, but making TypeOperators imply --- NoStarIsType caused too much breakage on Hackage. --- - --- Note [Documenting optimisation flags] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- If you change the list of flags enabled for particular optimisation levels --- please remember to update the User's Guide. The relevant file is: --- --- docs/users_guide/using-optimisation.rst --- --- Make sure to note whether a flag is implied by -O0, -O or -O2. - -optLevelFlags :: [([Int], GeneralFlag)] --- Default settings of flags, before any command-line overrides -optLevelFlags -- see Note [Documenting optimisation flags] - = [ ([0,1,2], Opt_DoLambdaEtaExpansion) - , ([0,1,2], Opt_DoEtaReduction) -- See Note [Eta-reduction in -O0] - , ([0,1,2], Opt_LlvmTBAA) - , ([0,1,2], Opt_ProfManualCcs ) - , ([2], Opt_DictsStrict) - - , ([0], Opt_IgnoreInterfacePragmas) - , ([0], Opt_OmitInterfacePragmas) - - , ([1,2], Opt_CoreConstantFolding) - - , ([1,2], Opt_CallArity) - , ([1,2], Opt_Exitification) - , ([1,2], Opt_CaseMerge) - , ([1,2], Opt_CaseFolding) - , ([1,2], Opt_CmmElimCommonBlocks) - , ([2], Opt_AsmShortcutting) - , ([1,2], Opt_CmmSink) - , ([1,2], Opt_CmmStaticPred) - , ([1,2], Opt_CSE) - , ([1,2], Opt_StgCSE) - , ([2], Opt_StgLiftLams) - , ([1,2], Opt_CmmControlFlow) - - , ([1,2], Opt_EnableRewriteRules) - -- Off for -O0. Otherwise we desugar list literals - -- to 'build' but don't run the simplifier passes that - -- would rewrite them back to cons cells! This seems - -- silly, and matters for the GHCi debugger. - - , ([1,2], Opt_FloatIn) - , ([1,2], Opt_FullLaziness) - , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_Loopification) - , ([1,2], Opt_CfgBlocklayout) -- Experimental - - , ([1,2], Opt_Specialise) - , ([1,2], Opt_CrossModuleSpecialise) - , ([1,2], Opt_InlineGenerics) - , ([1,2], Opt_Strictness) - , ([1,2], Opt_UnboxSmallStrictFields) - , ([1,2], Opt_CprAnal) - , ([1,2], Opt_WorkerWrapper) - , ([1,2], Opt_SolveConstantDicts) - , ([1,2], Opt_NumConstantFolding) - - , ([2], Opt_LiberateCase) - , ([2], Opt_SpecConstr) - , ([2], Opt_FastPAPCalls) --- , ([2], Opt_RegsGraph) --- RegsGraph suffers performance regression. See #7679 --- , ([2], Opt_StaticArgumentTransformation) --- Static Argument Transformation needs investigation. See #9374 - ] -- | Things you get with `-dlint`. @@ -4439,12 +3121,6 @@ setDebugLevel mb_n = | n > 2 = setGeneralFlag' Opt_ExposeInternalSymbols | otherwise = id -data PkgDbRef - = GlobalPkgDb - | UserPkgDb - | PkgDbPath FilePath - deriving Eq - addPkgDbRef :: PkgDbRef -> DynP () addPkgDbRef p = upd $ \s -> s { packageDBFlags = PackageDB p : packageDBFlags s } @@ -5070,29 +3746,6 @@ needSourceNotes dflags = debugLevel dflags > 0 -- ----------------------------------------------------------------------------- -- Linker/compiler information --- LinkerInfo contains any extra options needed by the system linker. -data LinkerInfo - = GnuLD [Option] - | Mold [Option] - | GnuGold [Option] - | LlvmLLD [Option] - | DarwinLD [Option] - | SolarisLD [Option] - | AixLD [Option] - | UnknownLD - deriving Eq - --- CompilerInfo tells us which C compiler we're using -data CompilerInfo - = GCC - | Clang - | AppleClang - | AppleClang51 - | Emscripten - | UnknownCC - deriving Eq - - -- | Should we use `-XLinker -rpath` when linking or not? -- See Note [-fno-use-rpaths] useXLinkerRPath :: DynFlags -> OS -> Bool @@ -5144,60 +3797,6 @@ decodeSize str foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO () foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO () - --- | Initialize the pretty-printing options -initSDocContext :: DynFlags -> PprStyle -> SDocContext -initSDocContext dflags style = SDC - { sdocStyle = style - , sdocColScheme = colScheme dflags - , sdocLastColour = Col.colReset - , sdocShouldUseColor = overrideWith (canUseColor dflags) (useColor dflags) - , sdocDefaultDepth = pprUserLength dflags - , sdocLineLength = pprCols dflags - , sdocCanUseUnicode = useUnicode dflags - , sdocHexWordLiterals = gopt Opt_HexWordLiterals dflags - , sdocPprDebug = dopt Opt_D_ppr_debug dflags - , sdocPrintUnicodeSyntax = gopt Opt_PrintUnicodeSyntax dflags - , sdocPrintCaseAsLet = gopt Opt_PprCaseAsLet dflags - , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags - , sdocPrintAxiomIncomps = gopt Opt_PrintAxiomIncomps dflags - , sdocPrintExplicitKinds = gopt Opt_PrintExplicitKinds dflags - , sdocPrintExplicitCoercions = gopt Opt_PrintExplicitCoercions dflags - , sdocPrintExplicitRuntimeReps = gopt Opt_PrintExplicitRuntimeReps dflags - , sdocPrintExplicitForalls = gopt Opt_PrintExplicitForalls dflags - , sdocPrintPotentialInstances = gopt Opt_PrintPotentialInstances dflags - , sdocPrintEqualityRelations = gopt Opt_PrintEqualityRelations dflags - , sdocSuppressTicks = gopt Opt_SuppressTicks dflags - , sdocSuppressTypeSignatures = gopt Opt_SuppressTypeSignatures dflags - , sdocSuppressTypeApplications = gopt Opt_SuppressTypeApplications dflags - , sdocSuppressIdInfo = gopt Opt_SuppressIdInfo dflags - , sdocSuppressCoercions = gopt Opt_SuppressCoercions dflags - , sdocSuppressCoercionTypes = gopt Opt_SuppressCoercionTypes dflags - , sdocSuppressUnfoldings = gopt Opt_SuppressUnfoldings dflags - , sdocSuppressVarKinds = gopt Opt_SuppressVarKinds dflags - , sdocSuppressUniques = gopt Opt_SuppressUniques dflags - , sdocSuppressModulePrefixes = gopt Opt_SuppressModulePrefixes dflags - , sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags - , sdocSuppressStgReps = gopt Opt_SuppressStgReps dflags - , sdocErrorSpans = gopt Opt_ErrorSpans dflags - , sdocStarIsType = xopt LangExt.StarIsType dflags - , sdocLinearTypes = xopt LangExt.LinearTypes dflags - , sdocListTuplePuns = True - , sdocPrintTypeAbbreviations = True - , sdocUnitIdForUser = ftext - } - --- | Initialize the pretty-printing options using the default user style -initDefaultSDocContext :: DynFlags -> SDocContext -initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle - -initPromotionTickContext :: DynFlags -> PromotionTickContext -initPromotionTickContext dflags = - PromTickCtx { - ptcListTuplePuns = True, - ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags - } - outputFile :: DynFlags -> Maybe String outputFile dflags | dynamicNow dflags = dynOutputFile_ dflags @@ -5208,11 +3807,6 @@ objectSuf dflags | dynamicNow dflags = dynObjectSuf_ dflags | otherwise = objectSuf_ dflags -ways :: DynFlags -> Ways -ways dflags - | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) - | otherwise = targetWays_ dflags - -- | Pretty-print the difference between 2 DynFlags. -- -- For now only their general flags but it could be extended. ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -82,7 +82,7 @@ import GHC.Types.SrcLoc import GHC.Data.Bag -- collect ev vars from pats import GHC.Data.Maybe import GHC.Types.Name (Name, dataName) -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import qualified GHC.LanguageExtensions as LangExt import Data.Data ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude import GHC.Core (CoreRule, CoreExpr, RuleName) import GHC.Core.DataCon import GHC.Core.Type -import GHC.Driver.Session (DynFlags, xopt) +import GHC.Driver.DynFlags (DynFlags, xopt) import GHC.Driver.Flags (WarningFlag) import GHC.Hs import GHC.HsToCore.Pmc.Solver.Types ===================================== compiler/GHC/Runtime/Context.hs ===================================== @@ -19,7 +19,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import {-# SOURCE #-} GHC.Driver.Plugins import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume ) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -119,7 +119,7 @@ import GHC.Core import GHC.Core.TyCo.Ppr import GHC.Utils.FV import GHC.Types.Var.Set -import GHC.Driver.Session (DynFlags(reductionDepth)) +import GHC.Driver.DynFlags (DynFlags(reductionDepth)) import GHC.Builtin.Names import GHC.Types.Basic import GHC.Types.Unique.Set ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -232,7 +232,7 @@ import {-# SOURCE #-} GHC.Tc.Types.Origin , FixedRuntimeRepOrigin, FixedRuntimeRepContext ) -- others: -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.Name as Name -- We use this to make dictionaries for type literals. -- Perhaps there's a better way to do this? ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -78,7 +78,7 @@ import GHC.Utils.Panic.Plain import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import GHC.Utils.Misc (HasDebugCallStack) -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) import GHC.Unit.Module.ModIface ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -51,7 +51,7 @@ import GHC.Data.Maybe import GHC.Data.Graph.Directed import GHC.Driver.Backend -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Types.SourceFile ( hscSourceString ) ===================================== compiler/GHC/Unit/Module/ModSummary.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Prelude import GHC.Hs -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Unit.Types import GHC.Unit.Module ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -75,7 +75,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Driver.DynFlags import GHC.Platform import GHC.Platform.Ways ===================================== compiler/ghc.cabal.in ===================================== @@ -434,6 +434,7 @@ Library GHC.Driver.Config.StgToCmm GHC.Driver.Config.Tidy GHC.Driver.Config.StgToJS + GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -106,6 +106,7 @@ GHC.Driver.CmdLine GHC.Driver.Config.Core.Lint GHC.Driver.Config.Diagnostic GHC.Driver.Config.Logger +GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -107,6 +107,7 @@ GHC.Driver.CmdLine GHC.Driver.Config.Core.Lint GHC.Driver.Config.Diagnostic GHC.Driver.Config.Logger +GHC.Driver.DynFlags GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -1,21 +1,21 @@ ref compiler/GHC/Core/Coercion/Axiom.hs:463:2: Note [RoughMap and rm_empty] ref compiler/GHC/Core/Opt/OccurAnal.hs:983:7: Note [Loop breaking] ref compiler/GHC/Core/Opt/SetLevels.hs:1574:30: Note [Top level scope] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2825:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4009:8: Note [Lambda-bound unfoldings] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2826:13: Note [Case binder next] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4018:8: Note [Lambda-bound unfoldings] ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] -ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] -ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Core/Opt/Specialise.hs:1765:29: Note [Arity decrease] +ref compiler/GHC/Core/TyCo/Rep.hs:1565:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Driver/DynFlags.hs:1245:49: Note [Eta-reduction in -O0] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:4062:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] -ref compiler/GHC/Hs/Expr.hs:1736:87: Note [Lifecycle of a splice] -ref compiler/GHC/Hs/Expr.hs:1772:7: Note [Pending Splices] +ref compiler/GHC/Hs/Expr.hs:1738:87: Note [Lifecycle of a splice] +ref compiler/GHC/Hs/Expr.hs:1774:7: Note [Pending Splices] ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constraints] ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:206:7: Note [Unsafe JavaScript optimizations] +ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -32,12 +32,12 @@ ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested sp ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1124:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] +ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] -ref compiler/GHC/Tc/Types/Constraint.hs:255:34: Note [NonCanonical Semantics] -ref compiler/GHC/Types/Demand.hs:306:25: Note [Preserving Boxity of results is rarely a win] +ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] +ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:410:34: Note [multiShotIO] ref compiler/Language/Haskell/Syntax/Binds.hs:200:31: Note [fun_id in Match] @@ -46,7 +46,7 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:272:10: Note [WayFlags] +ref testsuite/config/ghc:276:10: Note [WayFlags] ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86aae5702d09db2f50c42a3f43ef72df1e3a710b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86aae5702d09db2f50c42a3f43ef72df1e3a710b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 19:21:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 15:21:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: Improve "ambiguous occurrence" error messages Message-ID: <64628645d10c0_171ad978bcf534854854@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - bcf8f5b5 by Josh Meredith at 2023-05-15T15:21:33-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - a2c482f6 by Josh Meredith at 2023-05-15T15:21:33-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 8f8a6de6 by Ben Gamari at 2023-05-15T15:21:33-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - a8dcc15f by Ben Gamari at 2023-05-15T15:21:33-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - c645436a by Ben Gamari at 2023-05-15T15:21:34-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - a3b80361 by Ben Gamari at 2023-05-15T15:21:34-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 8664aa6c by Ben Gamari at 2023-05-15T15:21:34-04:00 rts: Introduce printGlobalThreads - - - - - 68b7e139 by Ben Gamari at 2023-05-15T15:21:34-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - 2645d451 by sheaf at 2023-05-15T15:21:36-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 9bcc9738 by sheaf at 2023-05-15T15:21:36-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - 23 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Errors/Types.hs - + compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36e08885da884a924b05fecd3f4badb5c8cc75ed...9bcc97386291df4f52b4310dda425ea885613737 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36e08885da884a924b05fecd3f4badb5c8cc75ed...9bcc97386291df4f52b4310dda425ea885613737 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 20:21:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 16:21:24 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 2 commits: compiler: Rework ShowSome Message-ID: <64629444362f1_171ad979d7d5b0876656@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 35ed53fd by Ben Gamari at 2023-05-15T16:21:15-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc. - - - - - d9987c15 by Ben Gamari at 2023-05-15T16:21:15-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 12 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -759,13 +759,9 @@ newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) data ShowHowMuch = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment + | ShowSome (OccName -> Bool) AltPpr + -- ^ Show only those sub-components for which the given predicate is 'True'. + -- All others will be elided with @... at . | ShowIface -- ^Everything including GHC-internal information (used in --show-iface) @@ -783,9 +779,9 @@ everything unqualified, so we can just print the OccName directly. -} instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome _ _) = text "ShowSome" showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing @@ -801,18 +797,18 @@ ppShowIface _ _ = Outputable.empty -- show if all sub-components or the complete interface is shown ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- See Note [Minimal complete definition] -ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc -ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowAllSubs _ _ = Outputable.empty +ppShowAllSubs (ShowSub { ss_how_much = ShowSome _ _ }) doc = doc +ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc +ppShowAllSubs _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool -showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False -showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing -showSub (ShowSub { ss_how_much = _ }) _ = True +showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False +showSub (ShowSub { ss_how_much = ShowSome f _ }) thing = f (occName thing) +showSub (ShowSub { ss_how_much = _ }) _ = True ppr_trim :: [Maybe SDoc] -> [SDoc] -- Collapse a group of Nothings to a single "..." ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -145,12 +145,12 @@ pprTyThingHdr = pprTyThing showToHeader -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing - = go [] thing + = go (const False) thing where go ss thing = case tyThingParent_maybe thing of Just parent -> - go (getOccName thing : ss) parent + go (\occ -> occ == getOccName thing || ss occ) parent Nothing -> pprTyThing (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,177 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, OccSet, mkOccSet, elemOccSet) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc ["-package=" ++ pkg_nm, "-dppr-cols=1000"] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: OccSet + exported_occs = mkOccSet $ map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elemOccSet` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80f05bcd79afc7c926815c099e9b70ad65f04eab...d9987c159fe1c9f35ddfc21680d786582a276588 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80f05bcd79afc7c926815c099e9b70ad65f04eab...d9987c159fe1c9f35ddfc21680d786582a276588 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 20:58:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 16:58:21 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 28 commits: Add fused multiply-add instructions Message-ID: <64629ced97bb6_171ad97b8be464900340@gitlab.mail> Ben Gamari pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 07ec9f6f by Ben Gamari at 2023-05-15T16:57:54-04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b2ca3e4195208507480496600214141542585acb...07ec9f6f5e051b342ce1a5d18da26d5df1840736 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b2ca3e4195208507480496600214141542585acb...07ec9f6f5e051b342ce1a5d18da26d5df1840736 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 21:14:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 17:14:44 -0400 Subject: [Git][ghc/ghc][wip/T23210] 35 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <6462a0c4de7d5_171ad97c938cb89158f6@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 8170b622 by Ben Gamari at 2023-05-15T17:14:23-04:00 rts: Tighten up invariants of PACK - - - - - c4c9eee7 by Ben Gamari at 2023-05-15T17:14:35-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Rules.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f947a665f0523a8195515a1a1ee47f34a61efd84...c4c9eee74095371753323c680ecccb7a50ed9a3e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f947a665f0523a8195515a1a1ee47f34a61efd84...c4c9eee74095371753323c680ecccb7a50ed9a3e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 21:30:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 17:30:03 -0400 Subject: [Git][ghc/ghc][wip/clear-block-info] rts: Clear block_info when unblocking Message-ID: <6462a45b9cff6_171ad97d93d26c930675@gitlab.mail> Ben Gamari pushed to branch wip/clear-block-info at Glasgow Haskell Compiler / GHC Commits: 2530633b by Ben Gamari at 2023-05-15T17:29:42-04:00 rts: Clear block_info when unblocking Otherwise we may end up with dangling pointers which may complicate debugging. Also, introduce more strict checking of block_info in checkTSO. - - - - - 7 changed files: - rts/RaiseAsync.c - rts/Schedule.c - rts/Threads.c - rts/include/rts/storage/TSO.h - rts/posix/Select.c - rts/sm/Sanity.c - rts/win32/AsyncMIO.c Changes: ===================================== rts/RaiseAsync.c ===================================== @@ -729,6 +729,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) done: tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap, tso); } @@ -1092,6 +1093,7 @@ done: // wake it up if (tso->why_blocked != NotBlocked) { tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); } ===================================== rts/Schedule.c ===================================== @@ -2565,7 +2565,8 @@ resumeThread (void *task_) traceEventRunThread(cap, tso); /* Reset blocking status */ - tso->why_blocked = NotBlocked; + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; if ((tso->flags & TSO_BLOCKEX) == 0) { // avoid locking the TSO if we don't have to ===================================== rts/Threads.c ===================================== @@ -334,6 +334,7 @@ unblock: // just run the thread now, if the BH is not really available, // we'll block again. tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); // We used to set the context switch flag here, which would ===================================== rts/include/rts/storage/TSO.h ===================================== @@ -289,8 +289,8 @@ void setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target); void dirty_STACK (Capability *cap, StgStack *stack); /* ----------------------------------------------------------------------------- - Invariants: - + Note [TSO invariants] + ~~~~~~~~~~~~~~~~~~~~~ An active thread has the following properties: tso->stack < tso->sp < tso->stack+tso->stack_size ===================================== rts/posix/Select.c ===================================== @@ -106,6 +106,7 @@ static bool wakeUpSleepingThreads (Capability *cap, LowResTime now) } iomgr->sleeping_queue = tso->_link; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %" FMT_StgThreadID "\n", tso->id)); @@ -437,6 +438,7 @@ awaitEvent(Capability *cap, bool wait) debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap,tso); break; ===================================== rts/sm/Sanity.c ===================================== @@ -737,6 +737,7 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* See Note [TSO invariants] in TSO.h */ void checkTSO(StgTSO *tso) { @@ -750,13 +751,42 @@ checkTSO(StgTSO *tso) info == &stg_WHITEHOLE_info); // used to happen due to STM doing // lockTSO(), might not happen now - if ( tso->why_blocked == BlockedOnMVar - || tso->why_blocked == BlockedOnMVarRead - || tso->why_blocked == BlockedOnBlackHole - || tso->why_blocked == BlockedOnMsgThrowTo - || tso->why_blocked == NotBlocked - ) { - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + switch (tso->why_blocked == NotBlocked) { + case NotBlocked: + ASSERT(tso->block_info.closure == END_TSO_QUEUE); + break; + case BlockedOnMVar: + case BlockedOnMVarRead: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + ASSERT(tso->block_info.closure->header.info == &stg_MVAR_DIRTY_info + || tso->block_info.closure->header.info == &stg_MVAR_CLEAN_info); + break; + case BlockedOnBlackHole: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + ASSERT(tso->block_info.closure->header.info == &stg_MSG_BLACKHOLE_info); + break; + case BlockedOnRead: + case BlockedOnWrite: + case BlockedOnDelay: + case BlockedOnDoProc: + ASSERT(tso->block_info.closure == NULL); + break; + case BlockedOnSTM: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + ASSERT(tso->block_info.closure == END_TSO_QUEUE + || tso->block_info.closure == STM_AWOKEN); + break; + case BlockedOnCCall: + case BlockedOnCCall_Interruptible: + break; + case BlockedOnMsgThrowTo: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + ASSERT(tso->block_info.throwto->header.info == &stg_MSG_THROWTO_info); + break; + case ThreadMigrating: + break; + default: + barf("checkTSO: Invalid why_blocked %x", tso->why_blocked); } ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ===================================== rts/win32/AsyncMIO.c ===================================== @@ -318,14 +318,16 @@ start: : END_TSO_QUEUE; } - // Terminates the run queue + this inner for-loop. - tso->_link = END_TSO_QUEUE; - tso->why_blocked = NotBlocked; // save the StgAsyncIOResult in the // stg_block_async_info stack frame, because // the block_info field will be overwritten by // pushOnRunQueue(). tso->stackobj->sp[1] = (W_)tso->block_info.async_result; + + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; + // Terminates the run queue + this inner for-loop. + tso->_link = END_TSO_QUEUE; pushOnRunQueue(&MainCapability, tso); break; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2530633bee6c5229ea47808d5a8f535edf51d33f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2530633bee6c5229ea47808d5a8f535edf51d33f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 21:33:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 17:33:21 -0400 Subject: [Git][ghc/ghc][wip/T23210] StgToByteCode: Don't assume that data con workers are nullary Message-ID: <6462a521755ce_171ad97d9e4e40935822@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: 6b51e51e by Ben Gamari at 2023-05-15T17:33:14-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - 2 changed files: - compiler/GHC/StgToByteCode.hs - rts/Interpreter.c Changes: ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1820,13 +1820,11 @@ pushAtom d p (StgVarArg var) -- PUSH_G doesn't tag constructors. So we use PACK here -- if we are dealing with nullary constructor. case isDataConWorkId_maybe var of - Just con -> do - massert (isNullaryRepDataCon con) + Just con | isNullaryRepDataCon con -> do return (unitOL (PACK con 0), szb) - Nothing -- see Note [Generating code for top-level string literal bindings] - | isUnliftedType (idType var) -> do + _ | isUnliftedType (idType var) -> do massert (idType var `eqType` addrPrimTy) return (unitOL (PUSH_ADDR (getName var)), szb) ===================================== rts/Interpreter.c ===================================== @@ -1687,7 +1687,6 @@ run_BCO: // n_nptrs=1, n_ptrs=0. ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0)); ASSERT(n_ptrs + n_nptrs > 0); - //ASSERT(n_words > 0); // We shouldn't ever need to allocate nullary constructors for (int i = 0; i < n_words; i++) { con->payload[i] = (StgClosure*)SpW(i); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b51e51e8c2e617ecfcc54957d8cfeda0f62e82c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b51e51e8c2e617ecfcc54957d8cfeda0f62e82c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 21:38:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 17:38:09 -0400 Subject: [Git][ghc/ghc][wip/T23210] 2 commits: StgToByteCode: Don't assume that data con workers are nullary Message-ID: <6462a641b45f0_171ad97dfc2b0093862a@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: 30c45ecf by Ben Gamari at 2023-05-15T17:37:34-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - 204c825f by Ben Gamari at 2023-05-15T17:37:38-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 2 changed files: - compiler/GHC/StgToByteCode.hs - rts/Interpreter.c Changes: ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1820,14 +1820,11 @@ pushAtom d p (StgVarArg var) -- PUSH_G doesn't tag constructors. So we use PACK here -- if we are dealing with nullary constructor. case isDataConWorkId_maybe var of - Just con -> do - massert (isNullaryRepDataCon con) - return (unitOL (PACK con 0), szb) + Just con | isNullaryRepDataCon con -> do + return (unitOL (PACK con 0), szb) - Nothing -- see Note [Generating code for top-level string literal bindings] - | isUnliftedType (idType var) -> do - massert (idType var `eqType` addrPrimTy) + _ | idType var `eqType` addrPrimTy -> return (unitOL (PUSH_ADDR (getName var)), szb) | otherwise -> do ===================================== rts/Interpreter.c ===================================== @@ -1687,7 +1687,6 @@ run_BCO: // n_nptrs=1, n_ptrs=0. ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0)); ASSERT(n_ptrs + n_nptrs > 0); - //ASSERT(n_words > 0); // We shouldn't ever need to allocate nullary constructors for (int i = 0; i < n_words; i++) { con->payload[i] = (StgClosure*)SpW(i); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b51e51e8c2e617ecfcc54957d8cfeda0f62e82c...204c825fdc937c99371c330c6d56d2cf69fa7e42 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b51e51e8c2e617ecfcc54957d8cfeda0f62e82c...204c825fdc937c99371c330c6d56d2cf69fa7e42 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 22:02:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 18:02:16 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Replace the implementation of CodeBuffers with unboxed types Message-ID: <6462abe829b40_171ad97e70a46c95582c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 10 changed files: - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/IO/Encoding/CodePage/API.hs - libraries/base/GHC/IO/Encoding/Failure.hs - libraries/base/GHC/IO/Encoding/Iconv.hs - libraries/base/GHC/IO/Encoding/Latin1.hs - libraries/base/GHC/IO/Encoding/Types.hs - libraries/base/GHC/IO/Encoding/UTF16.hs - libraries/base/GHC/IO/Encoding/UTF32.hs - libraries/base/GHC/IO/Encoding/UTF8.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/IO/Encoding.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} ----------------------------------------------------------------------------- @@ -336,11 +337,13 @@ mkTextEncoding' cfm enc = latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8) -latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8 +latin1_encode input output = IO $ \st -> case Latin1.latin1_encode input output st of + (# st', _why, input', output' #) -> (# st', (input', output') #) -- unchecked, used for char8 --latin1_encode = unsafePerformIO $ do mkTextEncoder Iconv.latin1 >>= return.encode latin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer) -latin1_decode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_decode input output +latin1_decode input output = IO $ \st -> case Latin1.latin1_decode input output st of + (# st', _why, input', output' #) -> (# st', (input',output') #) --latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode unknownEncodingErr :: String -> IO a ===================================== libraries/base/GHC/IO/Encoding/CodePage/API.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, NondecreasingIndentation, - RecordWildCards, ScopedTypeVariables #-} + RecordWildCards, ScopedTypeVariables, + UnboxedTuples #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} module GHC.IO.Encoding.CodePage.API ( @@ -157,11 +158,15 @@ newCP rec fn cp = do utf16_native_encode' :: EncodeBuffer utf16_native_decode' :: DecodeBuffer #if defined(WORDS_BIGENDIAN) -utf16_native_encode' = utf16be_encode -utf16_native_decode' = utf16be_decode +utf16_native_encode' i o = IO $ \st -> case utf16be_encode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) +utf16_native_decode' i o = IO $ \st -> case utf16be_decode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) #else -utf16_native_encode' = utf16le_encode -utf16_native_decode' = utf16le_decode +utf16_native_encode' i o = IO $ \st -> case utf16le_encode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) +utf16_native_decode' i o = IO $ \st -> case utf16le_decode i o st of + (# st', c, i', o' #) -> (# st', (c, i', o') #) #endif saner :: CodeBuffer from to ===================================== libraries/base/GHC/IO/Encoding/Failure.hs ===================================== @@ -1,5 +1,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- | @@ -18,7 +21,8 @@ module GHC.IO.Encoding.Failure ( CodingFailureMode(..), codingFailureModeSuffix, isSurrogate, - recoverDecode, recoverEncode + recoverDecode, recoverEncode, + recoverDecode#, recoverEncode#, ) where import GHC.IO @@ -142,6 +146,12 @@ unescapeRoundtripCharacterSurrogate c | otherwise = Nothing where x = ord c +recoverDecode# :: CodingFailureMode -> Buffer Word8 -> Buffer Char + -> State# RealWorld -> (# State# RealWorld, Buffer Word8, Buffer Char #) +recoverDecode# cfm input output st = + let !(# st', (bIn, bOut) #) = unIO (recoverDecode cfm input output) st + in (# st', bIn, bOut #) + recoverDecode :: CodingFailureMode -> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char) recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } @@ -160,6 +170,12 @@ recoverDecode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } ow' <- writeCharBuf oraw ow (escapeToRoundtripCharacterSurrogate b) return (input { bufL=ir+1 }, output { bufR=ow' }) +recoverEncode# :: CodingFailureMode -> Buffer Char -> Buffer Word8 + -> State# RealWorld -> (# State# RealWorld, Buffer Char, Buffer Word8 #) +recoverEncode# cfm input output st = + let !(# st', (bIn, bOut) #) = unIO (recoverEncode cfm input output) st + in (# st', bIn, bOut #) + recoverEncode :: CodingFailureMode -> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8) recoverEncode cfm input at Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } ===================================== libraries/base/GHC/IO/Encoding/Iconv.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE CPP , NoImplicitPrelude , NondecreasingIndentation + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} @@ -133,19 +135,24 @@ newIConv from to rec fn = withCAString to $ \ to_str -> do iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt - return BufferCodec{ - encode = fn iconvt, - recover = rec, - close = iclose, + fn_iconvt ibuf obuf st = case unIO (fn iconvt ibuf obuf) st of + (# st', (prog, ibuf', obuf') #) -> (# st', prog, ibuf', obuf' #) + return BufferCodec# { + encode# = fn_iconvt, + recover# = rec#, + close# = iclose, -- iconv doesn't supply a way to save/restore the state - getState = return (), - setState = const $ return () + getState# = return (), + setState# = const $ return () } + where + rec# ibuf obuf st = case unIO (rec ibuf obuf) st of + (# st', (ibuf', obuf') #) -> (# st', ibuf', obuf' #) -iconvDecode :: IConv -> DecodeBuffer +iconvDecode :: IConv -> Buffer Word8 -> Buffer Char -> IO (CodingProgress, Buffer Word8, Buffer Char) iconvDecode iconv_t ibuf obuf = iconvRecode iconv_t ibuf 0 obuf char_shift -iconvEncode :: IConv -> EncodeBuffer +iconvEncode :: IConv -> Buffer Char -> Buffer Word8 -> IO (CodingProgress, Buffer Char, Buffer Word8) iconvEncode iconv_t ibuf obuf = iconvRecode iconv_t ibuf char_shift obuf 0 iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int ===================================== libraries/base/GHC/IO/Encoding/Latin1.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE NoImplicitPrelude , BangPatterns , NondecreasingIndentation + , UnboxedTuples + , MagicHash #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -56,22 +58,22 @@ mkLatin1 cfm = TextEncoding { textEncodingName = "ISO-8859-1", latin1_DF :: CodingFailureMode -> IO (TextDecoder ()) latin1_DF cfm = - return (BufferCodec { - encode = latin1_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) latin1_EF :: CodingFailureMode -> IO (TextEncoder ()) latin1_EF cfm = - return (BufferCodec { - encode = latin1_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) latin1_checked :: TextEncoding @@ -85,12 +87,12 @@ mkLatin1_checked cfm = TextEncoding { textEncodingName = "ISO-8859-1", latin1_checked_EF :: CodingFailureMode -> IO (TextEncoder ()) latin1_checked_EF cfm = - return (BufferCodec { - encode = latin1_checked_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = latin1_checked_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -- ----------------------------------------------------------------------------- @@ -108,22 +110,22 @@ mkAscii cfm = TextEncoding { textEncodingName = "ASCII", ascii_DF :: CodingFailureMode -> IO (TextDecoder ()) ascii_DF cfm = - return (BufferCodec { - encode = ascii_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = ascii_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) ascii_EF :: CodingFailureMode -> IO (TextEncoder ()) ascii_EF cfm = - return (BufferCodec { - encode = ascii_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = ascii_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) @@ -134,97 +136,115 @@ ascii_EF cfm = -- TODO: Eliminate code duplication between the checked and unchecked -- versions of the decoder or encoder (but don't change the Core!) -latin1_decode :: DecodeBuffer +latin1_decode :: DecodeBuffer# latin1_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 + !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -ascii_decode :: DecodeBuffer +ascii_decode :: DecodeBuffer# ascii_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - if c0 > 0x7f then invalid else do - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 + if c0 > 0x7f then invalid st1 else do + let !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -latin1_encode :: EncodeBuffer +latin1_encode :: EncodeBuffer# latin1_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - writeWord8Buf oraw ow (fromIntegral (ord c)) - loop ir' (ow+1) + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (ord c))) st1 + loop ir' (ow+1) st2 in - loop ir0 ow0 + loop ir0 ow0 st -latin1_checked_encode :: EncodeBuffer +latin1_checked_encode :: EncodeBuffer# latin1_checked_encode input output = single_byte_checked_encode 0xff input output -ascii_encode :: EncodeBuffer +ascii_encode :: EncodeBuffer# ascii_encode input output = single_byte_checked_encode 0x7f input output -single_byte_checked_encode :: Int -> EncodeBuffer +single_byte_checked_encode :: Int -> EncodeBuffer# single_byte_checked_encode max_legal_char input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if ord c > max_legal_char then invalid else do - writeWord8Buf oraw ow (fromIntegral (ord c)) - loop ir' (ow+1) + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if ord c > max_legal_char then invalid st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (ord c))) st1 + loop ir' (ow+1) st2 where - invalid = done InvalidSequence ir ow + invalid :: EncodingBuffer# + invalid st' = done InvalidSequence ir ow st' in - loop ir0 ow0 + loop ir0 ow0 st {-# INLINE single_byte_checked_encode #-} ===================================== libraries/base/GHC/IO/Encoding/Types.hs ===================================== @@ -1,6 +1,9 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-} {-# OPTIONS_GHC -funbox-strict-fields #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms, ViewPatterns #-} +{-# LANGUAGE UnboxedTuples, MagicHash #-} ----------------------------------------------------------------------------- -- | @@ -17,11 +20,13 @@ ----------------------------------------------------------------------------- module GHC.IO.Encoding.Types ( - BufferCodec(..), + BufferCodec(.., BufferCodec, encode, recover, close, getState, setState), TextEncoding(..), TextEncoder, TextDecoder, CodeBuffer, EncodeBuffer, DecodeBuffer, - CodingProgress(..) + CodingProgress(..), + DecodeBuffer#, EncodeBuffer#, + DecodingBuffer#, EncodingBuffer# ) where import GHC.Base @@ -33,8 +38,8 @@ import GHC.IO.Buffer -- ----------------------------------------------------------------------------- -- Text encoders/decoders -data BufferCodec from to state = BufferCodec { - encode :: CodeBuffer from to, +data BufferCodec from to state = BufferCodec# { + encode# :: CodeBuffer# from to, -- ^ The @encode@ function translates elements of the buffer @from@ -- to the buffer @to at . It should translate as many elements as possible -- given the sizes of the buffers, including translating zero elements @@ -50,7 +55,7 @@ data BufferCodec from to state = BufferCodec { -- library in order to report translation errors at the point they -- actually occur, rather than when the buffer is translated. - recover :: Buffer from -> Buffer to -> IO (Buffer from, Buffer to), + recover# :: Buffer from -> Buffer to -> State# RealWorld -> (# State# RealWorld, Buffer from, Buffer to #), -- ^ The @recover@ function is used to continue decoding -- in the presence of invalid or unrepresentable sequences. This includes -- both those detected by @encode@ returning @InvalidSequence@ and those @@ -69,12 +74,12 @@ data BufferCodec from to state = BufferCodec { -- -- @since 4.4.0.0 - close :: IO (), + close# :: IO (), -- ^ Resources associated with the encoding may now be released. -- The @encode@ function may not be called again after calling -- @close at . - getState :: IO state, + getState# :: IO state, -- ^ Return the current state of the codec. -- -- Many codecs are not stateful, and in these case the state can be @@ -87,14 +92,22 @@ data BufferCodec from to state = BufferCodec { -- beginning), and if not, whether to use the big or little-endian -- encoding. - setState :: state -> IO () + setState# :: state -> IO () -- restore the state of the codec using the state from a previous -- call to 'getState'. } -type CodeBuffer from to = Buffer from -> Buffer to -> IO (CodingProgress, Buffer from, Buffer to) -type DecodeBuffer = CodeBuffer Word8 Char -type EncodeBuffer = CodeBuffer Char Word8 +type CodeBuffer from to = Buffer from -> Buffer to -> IO (CodingProgress, Buffer from, Buffer to) +type DecodeBuffer = CodeBuffer Word8 Char +type EncodeBuffer = CodeBuffer Char Word8 + +type CodeBuffer# from to = Buffer from -> Buffer to -> State# RealWorld -> (# State# RealWorld, CodingProgress, Buffer from, Buffer to #) +type DecodeBuffer# = CodeBuffer# Word8 Char +type EncodeBuffer# = CodeBuffer# Char Word8 + +type CodingBuffer# from to = State# RealWorld -> (# State# RealWorld, CodingProgress, Buffer from, Buffer to #) +type DecodingBuffer# = CodingBuffer# Word8 Char +type EncodingBuffer# = CodingBuffer# Char Word8 type TextDecoder state = BufferCodec Word8 CharBufElem state type TextEncoder state = BufferCodec CharBufElem Word8 state @@ -132,3 +145,29 @@ data CodingProgress = InputUnderflow -- ^ Stopped because the input contains in , Show -- ^ @since 4.4.0.0 ) +pattern BufferCodec :: CodeBuffer from to + -> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to)) + -> IO () + -> IO state + -> (state -> IO ()) + -> BufferCodec from to state +pattern BufferCodec{encode, recover, close, getState, setState} <- + BufferCodec# (getEncode -> encode) (getRecover -> recover) close getState setState + where + BufferCodec e r c g s = BufferCodec# (mkEncode e) (mkRecover r) c g s + +getEncode :: CodeBuffer# from to -> CodeBuffer from to +getEncode e i o = IO $ \st -> + let !(# st', prog, i', o' #) = e i o st in (# st', (prog, i', o') #) + +getRecover :: (Buffer from -> Buffer to -> State# RealWorld -> (# State# RealWorld, Buffer from, Buffer to #)) + -> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to)) +getRecover r i o = IO $ \st -> + let !(# st', i', o' #) = r i o st in (# st', (i', o') #) + +mkEncode :: CodeBuffer from to -> CodeBuffer# from to +mkEncode e i o st = let !(# st', (prog, i', o') #) = unIO (e i o) st in (# st', prog, i', o' #) + +mkRecover :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to)) + -> (Buffer from -> Buffer to -> State# RealWorld -> (# State# RealWorld, Buffer from, Buffer to #)) +mkRecover r i o st = let !(# st', (i', o') #) = unIO (r i o) st in (# st', i', o' #) ===================================== libraries/base/GHC/IO/Encoding/UTF16.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -61,64 +62,66 @@ mkUTF16 cfm = TextEncoding { textEncodingName = "UTF-16", mkTextDecoder = utf16_DF cfm, mkTextEncoder = utf16_EF cfm } -utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) +utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#)) utf16_DF cfm = do seen_bom <- newIORef Nothing - return (BufferCodec { - encode = utf16_decode seen_bom, - recover = recoverDecode cfm, - close = return (), - getState = readIORef seen_bom, - setState = writeIORef seen_bom + return (BufferCodec# { + encode# = utf16_decode seen_bom, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef seen_bom, + setState# = writeIORef seen_bom }) utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf16_EF cfm = do done_bom <- newIORef False - return (BufferCodec { - encode = utf16_encode done_bom, - recover = recoverEncode cfm, - close = return (), - getState = readIORef done_bom, - setState = writeIORef done_bom + return (BufferCodec# { + encode# = utf16_encode done_bom, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef done_bom, + setState# = writeIORef done_bom }) -utf16_encode :: IORef Bool -> EncodeBuffer +utf16_encode :: IORef Bool -> EncodeBuffer# utf16_encode done_bom input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef done_bom - if b then utf16_native_encode input output + let !(# st1, b #) = unIO (readIORef done_bom) st0 + if b then utf16_native_encode input output st1 else if os - ow < 2 - then return (OutputUnderflow,input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef done_bom True - writeWord8Buf oraw ow bom1 - writeWord8Buf oraw (ow+1) bom2 - utf16_native_encode input output{ bufR = ow+2 } + let !(# st2, () #) = unIO (writeIORef done_bom True) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom2) st3 + utf16_native_encode input output{ bufR = ow+2 } st4 -utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer +utf16_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer# utf16_decode seen_bom input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - mb <- readIORef seen_bom + let !(# st1, mb #) = unIO (readIORef seen_bom) st0 case mb of - Just decode -> decode input output + Just decode -> decode input output st1 Nothing -> - if iw - ir < 2 then return (InputUnderflow,input,output) else do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) + if iw - ir < 2 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 case () of - _ | c0 == bomB && c1 == bomL -> do - writeIORef seen_bom (Just utf16be_decode) - utf16be_decode input{ bufL= ir+2 } output - | c0 == bomL && c1 == bomB -> do - writeIORef seen_bom (Just utf16le_decode) - utf16le_decode input{ bufL= ir+2 } output - | otherwise -> do - writeIORef seen_bom (Just utf16_native_decode) - utf16_native_decode input output + _ | c0 == bomB && c1 == bomL -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16be_decode)) st3 + in utf16be_decode input{ bufL= ir+2 } output st4 + | c0 == bomL && c1 == bomB -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16le_decode)) st3 + in utf16le_decode input{ bufL= ir+2 } output st4 + | otherwise -> + let !(# st4, () #) = unIO (writeIORef seen_bom (Just utf16_native_decode)) st3 + in utf16_native_decode input output st4 bomB, bomL, bom1, bom2 :: Word8 @@ -126,10 +129,10 @@ bomB = 0xfe bomL = 0xff -- choose UTF-16BE by default for UTF-16 output -utf16_native_decode :: DecodeBuffer +utf16_native_decode :: DecodeBuffer# utf16_native_decode = utf16be_decode -utf16_native_encode :: EncodeBuffer +utf16_native_encode :: EncodeBuffer# utf16_native_encode = utf16be_encode bom1 = bomB @@ -149,22 +152,22 @@ mkUTF16be cfm = TextEncoding { textEncodingName = "UTF-16BE", utf16be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16be_DF cfm = - return (BufferCodec { - encode = utf16be_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16be_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16be_EF cfm = - return (BufferCodec { - encode = utf16be_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16be_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16le :: TextEncoding @@ -178,114 +181,127 @@ mkUTF16le cfm = TextEncoding { textEncodingName = "UTF16-LE", utf16le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16le_DF cfm = - return (BufferCodec { - encode = utf16le_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16le_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf16le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16le_EF cfm = - return (BufferCodec { - encode = utf16le_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf16le_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -utf16be_decode :: DecodeBuffer +utf16be_decode :: DecodeBuffer# utf16be_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow - | ir + 1 == iw = done InputUnderflow ir ow + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | ir + 1 == iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 let x1 = fromIntegral c0 `shiftL` 8 + fromIntegral c1 if validate1 x1 - then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1)) - loop (ir+2) ow' - else if iw - ir < 4 then done InputUnderflow ir ow else do - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3 - if not (validate2 x1 x2) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 x1 x2) - loop (ir+4) ow' + then let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral x1))) st2 + in loop (ir+2) ow' st3 + else if iw - ir < 4 then done InputUnderflow ir ow st2 else do + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3 + if not (validate2 x1 x2) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr2 x1 x2)) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input { bufL = 0, bufR = 0 } else input { bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf16le_decode :: DecodeBuffer +utf16le_decode :: DecodeBuffer# utf16le_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow - | ir + 1 == iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | ir + 1 == iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0 if validate1 x1 - then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1)) - loop (ir+2) ow' - else if iw - ir < 4 then done InputUnderflow ir ow else do - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 - if not (validate2 x1 x2) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 x1 x2) - loop (ir+4) ow' + then let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral x1))) st2 + in loop (ir+2) ow' st3 + else if iw - ir < 4 then done InputUnderflow ir ow st2 else do + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2 + if not (validate2 x1 x2) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr2 x1 x2)) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf16be_encode :: EncodeBuffer +utf16be_encode :: EncodeBuffer# utf16be_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 2 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 2 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of - x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do - writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8)) - writeWord8Buf oraw (ow+1) (fromIntegral x) - loop ir' (ow+2) + x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8))) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) (fromIntegral x)) st2 + loop ir' (ow+2) st3 | otherwise -> do - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) @@ -294,35 +310,39 @@ utf16be_encode c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 -- - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - writeWord8Buf oraw (ow+3) c4 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c4) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -utf16le_encode :: EncodeBuffer +utf16le_encode :: EncodeBuffer# utf16le_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 2 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 2 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of - x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do - writeWord8Buf oraw ow (fromIntegral x) - writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8)) - loop ir' (ow+2) + x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow st1 else do + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))) st2 + loop ir' (ow+2) st3 | otherwise -> - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) @@ -331,13 +351,13 @@ utf16le_encode c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 -- - writeWord8Buf oraw ow c2 - writeWord8Buf oraw (ow+1) c1 - writeWord8Buf oraw (ow+2) c4 - writeWord8Buf oraw (ow+3) c3 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c2) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c4) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c3) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st chr2 :: Word16 -> Word16 -> Char chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#)) ===================================== libraries/base/GHC/IO/Encoding/UTF32.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -61,68 +62,70 @@ mkUTF32 cfm = TextEncoding { textEncodingName = "UTF-32", mkTextDecoder = utf32_DF cfm, mkTextEncoder = utf32_EF cfm } -utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) +utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer#)) utf32_DF cfm = do seen_bom <- newIORef Nothing - return (BufferCodec { - encode = utf32_decode seen_bom, - recover = recoverDecode cfm, - close = return (), - getState = readIORef seen_bom, - setState = writeIORef seen_bom + return (BufferCodec# { + encode# = utf32_decode seen_bom, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef seen_bom, + setState# = writeIORef seen_bom }) utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf32_EF cfm = do done_bom <- newIORef False - return (BufferCodec { - encode = utf32_encode done_bom, - recover = recoverEncode cfm, - close = return (), - getState = readIORef done_bom, - setState = writeIORef done_bom + return (BufferCodec# { + encode# = utf32_encode done_bom, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef done_bom, + setState# = writeIORef done_bom }) -utf32_encode :: IORef Bool -> EncodeBuffer +utf32_encode :: IORef Bool -> EncodeBuffer# utf32_encode done_bom input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef done_bom - if b then utf32_native_encode input output + let !(# st1, b #) = unIO (readIORef done_bom) st0 + if b then utf32_native_encode input output st1 else if os - ow < 4 - then return (OutputUnderflow, input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef done_bom True - writeWord8Buf oraw ow bom0 - writeWord8Buf oraw (ow+1) bom1 - writeWord8Buf oraw (ow+2) bom2 - writeWord8Buf oraw (ow+3) bom3 - utf32_native_encode input output{ bufR = ow+4 } - -utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer + let !(# st2, () #) = unIO (writeIORef done_bom True) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom0) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+2) bom2) st4 + !(# st6, () #) = unIO (writeWord8Buf oraw (ow+3) bom3) st5 + utf32_native_encode input output{ bufR = ow+4 } st6 + +utf32_decode :: IORef (Maybe DecodeBuffer#) -> DecodeBuffer# utf32_decode seen_bom input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - mb <- readIORef seen_bom + let !(# st1, mb #) = unIO (readIORef seen_bom) st0 case mb of - Just decode -> decode input output + Just decode -> decode input output st1 Nothing -> - if iw - ir < 4 then return (InputUnderflow, input,output) else do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + if iw - ir < 4 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir ) st1 + !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 + !(# st4, c2 #) = unIO (readWord8Buf iraw (ir+2)) st3 + !(# st5, c3 #) = unIO (readWord8Buf iraw (ir+3)) st4 case () of - _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> do - writeIORef seen_bom (Just utf32be_decode) - utf32be_decode input{ bufL= ir+4 } output - _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> do - writeIORef seen_bom (Just utf32le_decode) - utf32le_decode input{ bufL= ir+4 } output - | otherwise -> do - writeIORef seen_bom (Just utf32_native_decode) - utf32_native_decode input output + _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32be_decode)) st5 + in utf32be_decode input{ bufL= ir+4 } output st6 + _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32le_decode)) st5 + in utf32le_decode input{ bufL= ir+4 } output st6 + | otherwise -> + let !(# st6, () #) = unIO (writeIORef seen_bom (Just utf32_native_decode)) st5 + in utf32_native_decode input output st6 bom0, bom1, bom2, bom3 :: Word8 @@ -132,10 +135,10 @@ bom2 = 0xfe bom3 = 0xff -- choose UTF-32BE by default for UTF-32 output -utf32_native_decode :: DecodeBuffer +utf32_native_decode :: DecodeBuffer# utf32_native_decode = utf32be_decode -utf32_native_encode :: EncodeBuffer +utf32_native_encode :: EncodeBuffer# utf32_native_encode = utf32be_encode -- ----------------------------------------------------------------------------- @@ -152,22 +155,22 @@ mkUTF32be cfm = TextEncoding { textEncodingName = "UTF-32BE", utf32be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf32be_DF cfm = - return (BufferCodec { - encode = utf32be_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32be_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf32be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf32be_EF cfm = - return (BufferCodec { - encode = utf32be_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32be_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) @@ -182,128 +185,145 @@ mkUTF32le cfm = TextEncoding { textEncodingName = "UTF-32LE", utf32le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf32le_DF cfm = - return (BufferCodec { - encode = utf32le_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32le_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf32le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf32le_EF cfm = - return (BufferCodec { - encode = utf32le_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf32le_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) -utf32be_decode :: DecodeBuffer +utf32be_decode :: DecodeBuffer# utf32be_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | iw - ir < 4 = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | iw - ir < 4 = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 let x1 = chr4 c0 c1 c2 c3 - if not (validate x1) then invalid else do - ow' <- writeCharBuf oraw ow x1 - loop (ir+4) ow' + if not (validate x1) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf32le_decode :: DecodeBuffer +utf32le_decode :: DecodeBuffer# utf32le_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | iw - ir < 4 = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | iw - ir < 4 = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir ) st0 + !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 let x1 = chr4 c3 c2 c1 c0 - if not (validate x1) then invalid else do - ow' <- writeCharBuf oraw ow x1 - loop (ir+4) ow' + if not (validate x1) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow x1) st4 + loop (ir+4) ow' st5 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf32be_encode :: EncodeBuffer +utf32be_encode :: EncodeBuffer# utf32be_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 4 = done OutputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 4 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if isSurrogate c then done InvalidSequence ir ow else do + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if isSurrogate c then done InvalidSequence ir ow st1 else do let (c0,c1,c2,c3) = ord4 c - writeWord8Buf oraw ow c0 - writeWord8Buf oraw (ow+1) c1 - writeWord8Buf oraw (ow+2) c2 - writeWord8Buf oraw (ow+3) c3 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c0) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c1) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c2) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c3) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -utf32le_encode :: EncodeBuffer +utf32le_encode :: EncodeBuffer# utf32le_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ir >= iw = done InputUnderflow ir ow - | os - ow < 4 = done OutputUnderflow ir ow + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir } + !ro = output{ bufR=ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ir >= iw = done InputUnderflow ir ow st0 + | os - ow < 4 = done OutputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir - if isSurrogate c then done InvalidSequence ir ow else do + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 + if isSurrogate c then done InvalidSequence ir ow st1 else do let (c0,c1,c2,c3) = ord4 c - writeWord8Buf oraw ow c3 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c1 - writeWord8Buf oraw (ow+3) c0 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c3) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c0) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) = ===================================== libraries/base/GHC/IO/Encoding/UTF8.hs ===================================== @@ -3,6 +3,7 @@ , BangPatterns , NondecreasingIndentation , MagicHash + , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -56,22 +57,22 @@ mkUTF8 cfm = TextEncoding { textEncodingName = "UTF-8", utf8_DF :: CodingFailureMode -> IO (TextDecoder ()) utf8_DF cfm = - return (BufferCodec { - encode = utf8_decode, - recover = recoverDecode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf8_decode, + recover# = recoverDecode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf8_EF :: CodingFailureMode -> IO (TextEncoder ()) utf8_EF cfm = - return (BufferCodec { - encode = utf8_encode, - recover = recoverEncode cfm, - close = return (), - getState = return (), - setState = const $ return () + return (BufferCodec# { + encode# = utf8_encode, + recover# = recoverEncode# cfm, + close# = return (), + getState# = return (), + setState# = const $ return () }) utf8_bom :: TextEncoding @@ -85,177 +86,188 @@ mkUTF8_bom cfm = TextEncoding { textEncodingName = "UTF-8BOM", utf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool) utf8_bom_DF cfm = do ref <- newIORef True - return (BufferCodec { - encode = utf8_bom_decode ref, - recover = recoverDecode cfm, - close = return (), - getState = readIORef ref, - setState = writeIORef ref + return (BufferCodec# { + encode# = utf8_bom_decode ref, + recover# = recoverDecode# cfm, + close# = return (), + getState# = readIORef ref, + setState# = writeIORef ref }) utf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf8_bom_EF cfm = do ref <- newIORef True - return (BufferCodec { - encode = utf8_bom_encode ref, - recover = recoverEncode cfm, - close = return (), - getState = readIORef ref, - setState = writeIORef ref + return (BufferCodec# { + encode# = utf8_bom_encode ref, + recover# = recoverEncode# cfm, + close# = return (), + getState# = readIORef ref, + setState# = writeIORef ref }) -utf8_bom_decode :: IORef Bool -> DecodeBuffer +utf8_bom_decode :: IORef Bool -> DecodeBuffer# utf8_bom_decode ref input at Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } output + st0 = do - first <- readIORef ref + let !(# st1, first #) = unIO (readIORef ref) st0 if not first - then utf8_decode input output + then utf8_decode input output st1 else do - let no_bom = do writeIORef ref False; utf8_decode input output - if iw - ir < 1 then return (InputUnderflow,input,output) else do - c0 <- readWord8Buf iraw ir + let no_bom = let !(# st', () #) = unIO (writeIORef ref False) st1 in utf8_decode input output st' + if iw - ir < 1 then (# st1,InputUnderflow,input,output #) else do + let !(# st2, c0 #) = unIO (readWord8Buf iraw ir) st1 if (c0 /= bom0) then no_bom else do - if iw - ir < 2 then return (InputUnderflow,input,output) else do - c1 <- readWord8Buf iraw (ir+1) + if iw - ir < 2 then (# st2,InputUnderflow,input,output #) else do + let !(# st3, c1 #) = unIO (readWord8Buf iraw (ir+1)) st2 if (c1 /= bom1) then no_bom else do - if iw - ir < 3 then return (InputUnderflow,input,output) else do - c2 <- readWord8Buf iraw (ir+2) + if iw - ir < 3 then (# st3,InputUnderflow,input,output #) else do + let !(# st4, c2 #) = unIO (readWord8Buf iraw (ir+2)) st3 if (c2 /= bom2) then no_bom else do -- found a BOM, ignore it and carry on - writeIORef ref False - utf8_decode input{ bufL = ir + 3 } output + let !(# st5, () #) = unIO (writeIORef ref False) st4 + utf8_decode input{ bufL = ir + 3 } output st5 -utf8_bom_encode :: IORef Bool -> EncodeBuffer +utf8_bom_encode :: IORef Bool -> EncodeBuffer# utf8_bom_encode ref input output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } + st0 = do - b <- readIORef ref - if not b then utf8_encode input output + let !(# st1, b #) = unIO (readIORef ref) st0 + if not b then utf8_encode input output st1 else if os - ow < 3 - then return (OutputUnderflow,input,output) + then (# st1,OutputUnderflow,input,output #) else do - writeIORef ref False - writeWord8Buf oraw ow bom0 - writeWord8Buf oraw (ow+1) bom1 - writeWord8Buf oraw (ow+2) bom2 - utf8_encode input output{ bufR = ow+3 } + let !(# st2, () #) = unIO (writeIORef ref False) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw ow bom0) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+1) bom1) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+2) bom2) st4 + utf8_encode input output{ bufR = ow+3 } st5 bom0, bom1, bom2 :: Word8 bom0 = 0xef bom1 = 0xbb bom2 = 0xbf -utf8_decode :: DecodeBuffer +utf8_decode :: DecodeBuffer# utf8_decode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + loop :: Int -> Int -> DecodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - c0 <- readWord8Buf iraw ir + let !(# st1, c0 #) = unIO (readWord8Buf iraw ir) st0 case c0 of _ | c0 <= 0x7f -> do - ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0)) - loop (ir+1) ow' - | c0 >= 0xc0 && c0 <= 0xc1 -> invalid -- Overlong forms + let !(# st2, ow' #) = unIO (writeCharBuf oraw ow (unsafeChr (fromIntegral c0))) st1 + loop (ir+1) ow' st2 + | c0 >= 0xc0 && c0 <= 0xc1 -> invalid st1 -- Overlong forms | c0 >= 0xc2 && c0 <= 0xdf -> - if iw - ir < 2 then done InputUnderflow ir ow else do - c1 <- readWord8Buf iraw (ir+1) - if (c1 < 0x80 || c1 >= 0xc0) then invalid else do - ow' <- writeCharBuf oraw ow (chr2 c0 c1) - loop (ir+2) ow' + if iw - ir < 2 then done InputUnderflow ir ow st1 else do + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + if (c1 < 0x80 || c1 >= 0xc0) then invalid st2 else do + let !(# st3, ow' #) = unIO (writeCharBuf oraw ow (chr2 c0 c1)) st2 + loop (ir+2) ow' st3 | c0 >= 0xe0 && c0 <= 0xef -> case iw - ir of - 1 -> done InputUnderflow ir ow + 1 -> done InputUnderflow ir ow st1 2 -> do -- check for an error even when we don't have -- the full sequence yet (#3341) - c1 <- readWord8Buf iraw (ir+1) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 if not (validate3 c0 c1 0x80) - then invalid else done InputUnderflow ir ow + then invalid st2 else done InputUnderflow ir ow st2 _ -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - if not (validate3 c0 c1 c2) then invalid else do - ow' <- writeCharBuf oraw ow (chr3 c0 c1 c2) - loop (ir+3) ow' + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + let !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + if not (validate3 c0 c1 c2) then invalid st3 else do + let !(# st4, ow' #) = unIO (writeCharBuf oraw ow (chr3 c0 c1 c2)) st3 + loop (ir+3) ow' st4 | c0 >= 0xf0 -> case iw - ir of - 1 -> done InputUnderflow ir ow + 1 -> done InputUnderflow ir ow st1 2 -> do -- check for an error even when we don't have -- the full sequence yet (#3341) - c1 <- readWord8Buf iraw (ir+1) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 if not (validate4 c0 c1 0x80 0x80) - then invalid else done InputUnderflow ir ow + then invalid st2 else done InputUnderflow ir ow st2 3 -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 if not (validate4 c0 c1 c2 0x80) - then invalid else done InputUnderflow ir ow + then invalid st3 else done InputUnderflow ir ow st3 _ -> do - c1 <- readWord8Buf iraw (ir+1) - c2 <- readWord8Buf iraw (ir+2) - c3 <- readWord8Buf iraw (ir+3) - if not (validate4 c0 c1 c2 c3) then invalid else do - ow' <- writeCharBuf oraw ow (chr4 c0 c1 c2 c3) - loop (ir+4) ow' + let !(# st2, c1 #) = unIO (readWord8Buf iraw (ir+1)) st1 + !(# st3, c2 #) = unIO (readWord8Buf iraw (ir+2)) st2 + !(# st4, c3 #) = unIO (readWord8Buf iraw (ir+3)) st3 + if not (validate4 c0 c1 c2 c3) then invalid st4 else do + let !(# st5, ow' #) = unIO (writeCharBuf oraw ow (chr4 c0 c1 c2 c3)) st4 + loop (ir+4) ow' st5 | otherwise -> - invalid + invalid st1 where - invalid = done InvalidSequence ir ow + invalid :: DecodingBuffer# + invalid st' = done InvalidSequence ir ow st' -- lambda-lifted, to avoid thunks being built in the inner-loop: - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> DecodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0} else input{ bufL = ir } + !ro = output { bufR = ow } + in (# st', why, ri, ro #) in - loop ir0 ow0 + loop ir0 ow0 st -utf8_encode :: EncodeBuffer +utf8_encode :: EncodeBuffer# utf8_encode input at Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output at Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } + st = let - done why !ir !ow = return (why, - if ir == iw then input{ bufL=0, bufR=0 } - else input{ bufL=ir }, - output{ bufR=ow }) - loop !ir !ow - | ow >= os = done OutputUnderflow ir ow - | ir >= iw = done InputUnderflow ir ow + {-# NOINLINE done #-} + done :: CodingProgress -> Int -> Int -> EncodingBuffer# + done why !ir !ow st' = + let !ri = if ir == iw then input{ bufL = 0, bufR = 0 } else input{ bufL = ir } + !ro = output{ bufR = ow } + in (# st', why, ri, ro #) + loop :: Int -> Int -> EncodingBuffer# + loop !ir !ow st0 + | ow >= os = done OutputUnderflow ir ow st0 + | ir >= iw = done InputUnderflow ir ow st0 | otherwise = do - (c,ir') <- readCharBuf iraw ir + let !(# st1, (c,ir') #) = unIO (readCharBuf iraw ir) st0 case ord c of x | x <= 0x7F -> do - writeWord8Buf oraw ow (fromIntegral x) - loop ir' (ow+1) + let !(# st2, () #) = unIO (writeWord8Buf oraw ow (fromIntegral x)) st1 + loop ir' (ow+1) st2 | x <= 0x07FF -> - if os - ow < 2 then done OutputUnderflow ir ow else do + if os - ow < 2 then done OutputUnderflow ir ow st1 else do let (c1,c2) = ord2 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - loop ir' (ow+2) - | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow else do - if os - ow < 3 then done OutputUnderflow ir ow else do + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + loop ir' (ow+2) st3 + | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow st1 else do + if os - ow < 3 then done OutputUnderflow ir ow st1 else do let (c1,c2,c3) = ord3 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - loop ir' (ow+3) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + loop ir' (ow+3) st4 | otherwise -> do - if os - ow < 4 then done OutputUnderflow ir ow else do + if os - ow < 4 then done OutputUnderflow ir ow st1 else do let (c1,c2,c3,c4) = ord4 c - writeWord8Buf oraw ow c1 - writeWord8Buf oraw (ow+1) c2 - writeWord8Buf oraw (ow+2) c3 - writeWord8Buf oraw (ow+3) c4 - loop ir' (ow+4) + !(# st2, () #) = unIO (writeWord8Buf oraw ow c1) st1 + !(# st3, () #) = unIO (writeWord8Buf oraw (ow+1) c2) st2 + !(# st4, () #) = unIO (writeWord8Buf oraw (ow+2) c3) st3 + !(# st5, () #) = unIO (writeWord8Buf oraw (ow+3) c4) st4 + loop ir' (ow+4) st5 in - loop ir0 ow0 + loop ir0 ow0 st -- ----------------------------------------------------------------------------- -- UTF-8 primitives, lifted from Data.Text.Fusion.Utf8 ===================================== libraries/base/changelog.md ===================================== @@ -28,6 +28,7 @@ * Add more instances for `Compose`: `Enum`, `Bounded`, `Num`, `Real`, `Integral` ([CLC proposal #160](https://github.com/haskell/core-libraries-committee/issues/160)) * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) + * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86aae5702d09db2f50c42a3f43ef72df1e3a710b...21f3aae7371469beb3950a6170db6c5668379ff3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86aae5702d09db2f50c42a3f43ef72df1e3a710b...21f3aae7371469beb3950a6170db6c5668379ff3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 22:02:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 18:02:42 -0400 Subject: [Git][ghc/ghc][master] 6 commits: rts: Weak pointer cleanups Message-ID: <6462ac0251483_171ad97ed7e03c9611ed@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - 9 changed files: - rts/RtsFlags.c - rts/RtsMessages.c - rts/Threads.c - rts/Threads.h - rts/include/Cmm.h - rts/include/rts/Constants.h - rts/include/rts/storage/ClosureMacros.h - rts/sm/MarkWeak.c - rts/sm/Sanity.c Changes: ===================================== rts/RtsFlags.c ===================================== @@ -2201,13 +2201,14 @@ static void read_debug_flags(const char* arg) } // -Dx also turns on -v. Use -l to direct trace // events to the .eventlog file instead. - RtsFlags.TraceFlags.tracing = TRACE_STDERR; - - // sanity implies zero_on_gc - if(RtsFlags.DebugFlags.sanity){ - RtsFlags.DebugFlags.zero_on_gc = true; - } + if (RtsFlags.TraceFlags.tracing == TRACE_NONE) { + RtsFlags.TraceFlags.tracing = TRACE_STDERR; + } + // sanity implies zero_on_gc + if(RtsFlags.DebugFlags.sanity){ + RtsFlags.DebugFlags.zero_on_gc = true; + } } #endif ===================================== rts/RtsMessages.c ===================================== @@ -186,7 +186,12 @@ rtsFatalInternalErrorFn(const char *s, va_list ap) #endif #if defined(TRACING) - if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG) endEventLogging(); + if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG) { + // Use flushAllCapsEventsBufs rather than endEventLogging here since + // the latter insists on acquiring all capabilities to flush the eventlog; + // this would deadlock if we barfed during a GC. + flushAllCapsEventsBufs(); + } #endif abort(); ===================================== rts/Threads.c ===================================== @@ -1007,6 +1007,20 @@ printAllThreads(void) } } +void +printGlobalThreads(void) +{ + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + debugBelch("\ngen %d\n", g); + for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu)\n", t, t->id); + } + for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { + debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + } + } +} + // useful from gdb void printThreadQueue(StgTSO *t) ===================================== rts/Threads.h ===================================== @@ -46,6 +46,7 @@ bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value); void printThreadBlockage (StgTSO *tso); void printThreadStatus (StgTSO *t); void printAllThreads (void); +void printGlobalThreads(void); void printThreadQueue (StgTSO *t); #endif ===================================== rts/include/Cmm.h ===================================== @@ -607,16 +607,20 @@ #define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK) #define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT) +#define LOOKS_LIKE_PTR(p) ((p) != NULL && (p) != INVALID_GHC_POINTER) + /* Debugging macros */ #define LOOKS_LIKE_INFO_PTR(p) \ - ((p) != NULL && \ + (LOOKS_LIKE_PTR(p) && \ LOOKS_LIKE_INFO_PTR_NOT_NULL(p)) #define LOOKS_LIKE_INFO_PTR_NOT_NULL(p) \ ( (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \ (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES)) -#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) +#define LOOKS_LIKE_CLOSURE_PTR(p) \ + ( LOOKS_LIKE_PTR(p) && \ + LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) /* * The layout of the StgFunInfoExtra part of an info table changes ===================================== rts/include/rts/Constants.h ===================================== @@ -215,6 +215,21 @@ #define LDV_STATE_USE 0x40000000 #endif /* SIZEOF_VOID_P */ +/* See Note [Debugging predicates for pointers] in ClosureMacros.h */ +#if !defined(INVALID_GHC_POINTER) +#if !defined(DEBUG) +#define INVALID_GHC_POINTER 0x0 +#elif SIZEOF_VOID_P== 4 +/* N.B. this may result in false-negatives from LOOKS_LIKE_PTR on some + * platforms since this is a valid user-space address. + */ +#define INVALID_GHC_POINTER 0xaaaaaaaa +#else +/* N.B. this is typically a kernel-mode address on 64-bit platforms */ +#define INVALID_GHC_POINTER 0xaaaaaaaaaaaaaaaa +#endif +#endif + /* ----------------------------------------------------------------------------- TSO related constants -------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -253,22 +253,35 @@ EXTERN_INLINE StgClosure *TAG_CLOSURE(StgWord tag,StgClosure * p) #define MK_FORWARDING_PTR(p) (((StgWord)p) | 1) #define UN_FORWARDING_PTR(p) (((StgWord)p) - 1) -/* ----------------------------------------------------------------------------- - DEBUGGING predicates for pointers - - LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr - LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr - - These macros are complete but not sound. That is, they might - return false positives. Do not rely on them to distinguish info - pointers from closure pointers, for example. +/* + * Note [Debugging predicates for pointers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * LOOKS_LIKE_PTR(p) returns False if p is definitely not a valid pointer + * LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr + * LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr + * + * These macros are complete but not sound. That is, they might + * return false positives. Do not rely on them to distinguish info + * pointers from closure pointers, for example. + * + * We for the most part don't use address-space predicates these days, for + * portability reasons, and the fact that code/data can be scattered about the + * address space in a dynamically-linked environment. Our best option is to + * look at the alleged info table and see whether it seems to make sense. + * + * The one exception here is the use of INVALID_GHC_POINTER, which catches + * the bit-pattern used by `+RTS -DZ` to zero freed memory (that is 0xaaaaa...). + * In the case of most 64-bit platforms, this INVALID_GHC_POINTER is a + * kernel-mode address, making this check free of false-negatives. On the other + * hand, on 32-bit platforms this typically isn't the case. Consequently, we + * only use this check in the DEBUG RTS. + */ - We don't use address-space predicates these days, for portability - reasons, and the fact that code/data can be scattered about the - address space in a dynamically-linked environment. Our best option - is to look at the alleged info table and see whether it seems to - make sense... - -------------------------------------------------------------------------- */ +EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p); +EXTERN_INLINE bool LOOKS_LIKE_PTR (const void* p) +{ + return p && (p != (const void*) INVALID_GHC_POINTER); +} EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) @@ -280,12 +293,13 @@ EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p) EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p); EXTERN_INLINE bool LOOKS_LIKE_INFO_PTR (StgWord p) { - return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); + return LOOKS_LIKE_PTR((const void*) p) && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p)); } EXTERN_INLINE bool LOOKS_LIKE_CLOSURE_PTR (const void *p); EXTERN_INLINE bool LOOKS_LIKE_CLOSURE_PTR (const void *p) { + if (!LOOKS_LIKE_PTR(p)) return false; const StgInfoTable *info = RELAXED_LOAD(&UNTAG_CONST_CLOSURE((const StgClosure *) (p))->header.info); return LOOKS_LIKE_INFO_PTR((StgWord) info); } ===================================== rts/sm/MarkWeak.c ===================================== @@ -251,7 +251,7 @@ static void collectDeadWeakPtrs (generation *gen, StgWeak **dead_weak_ptr_list) */ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_threads) { - StgTSO *t, *tmp, *next; + StgTSO *t, *next; bool flag = false; for (t = gen->old_threads; t != END_TSO_QUEUE; t = next) { @@ -272,12 +272,14 @@ static bool resurrectUnreachableThreads (generation *gen, StgTSO **resurrected_t t->global_link = END_TSO_QUEUE; continue; default: - tmp = t; + { + StgTSO *tmp = t; evacuate((StgClosure **)&tmp); tmp->global_link = *resurrected_threads; *resurrected_threads = tmp; flag = true; } + } } gen->old_threads = END_TSO_QUEUE; @@ -387,18 +389,21 @@ static bool tidyWeakList(generation *gen) } /* - * Walk over the `old_threads` list of the given generation and move any - * reachable threads onto the `threads` list. + * Walk over the given generation's thread list and promote TSOs which are + * reachable via the heap. This will move the TSO from gen->old_threads to + * new_gen->threads. + * + * This has the side-effect of updating the global thread list to account for + * indirections introduced by evacuation. */ static void tidyThreadList (generation *gen) { - StgTSO *t, *tmp, *next, **prev; + StgTSO *next; + StgTSO **prev = &gen->old_threads; - prev = &gen->old_threads; - - for (t = gen->old_threads; t != END_TSO_QUEUE; t = next) { + for (StgTSO *t = gen->old_threads; t != END_TSO_QUEUE; t = next) { - tmp = (StgTSO *)isAlive((StgClosure *)t); + StgTSO *tmp = (StgTSO *)isAlive((StgClosure *)t); if (tmp != NULL) { t = tmp; @@ -426,10 +431,9 @@ static void tidyThreadList (generation *gen) *prev = next; // move this thread onto the correct threads list. - generation *new_gen; - new_gen = Bdescr((P_)t)->gen; + generation *new_gen = Bdescr((P_)t)->gen; t->global_link = new_gen->threads; - new_gen->threads = t; + new_gen->threads = t; } } } ===================================== rts/sm/Sanity.c ===================================== @@ -737,14 +737,45 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* + * Note [Sanity-checking global_link] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * TSOs are a bit odd in that they have a global_link pointer field + * which is not scavenged by the GC. This field is used to track the + * generations[_].[old_]threads lists and is ultimately updated by + * MarkWeak.c:tidyThreadList, which walks the thread lists and updates + * the global_link references of all TSOs that it finds. + * + * Typically the fact that this field is not scavenged is fine as all reachable + * TSOs on the heap are guaranteed to be on some generation's thread list and + * therefore will be scavenged by tidyThreadList. However, the sanity checker + * poses a bit of a challenge here as it walks heap blocks directly and + * therefore may encounter TSOs which aren't reachable via the the global + * thread lists. + * + * How might such orphan TSOs arise? One such way is via racing evacuation. + * Specifically, if two GC threads attempt to simultaneously evacuate a + * TSO, both threads will produce a copy of the TSO in their respective + * to-space. However, only one will succeed in turning the from-space TSO into + * a forwarding pointer. Consequently, tidyThreadList will find and update the + * copy which "won". Meanwhile, the "losing" copy will contain a dangling + * global_link pointer into from-space. + * + * For this reason, checkTSO does not check global_link. Instead, we only do + * so in checkGlobalTSOList, which by definition will only look at + * threads which are reachable via a thread list (and therefore must have won + * the forwarding-pointer race). + * + * See #19146. + */ + void checkTSO(StgTSO *tso) { - StgTSO *next = tso->_link; const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; load_load_barrier(); - ASSERT(next == END_TSO_QUEUE || + ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || info == &stg_TSO_info || info == &stg_WHITEHOLE_info); // used to happen due to STM doing @@ -762,9 +793,12 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && - (tso->global_link == END_TSO_QUEUE || - get_itbl((StgClosure*)tso->global_link)->type == TSO)); + + // This assertion sadly does not always hold. + // See Note [Sanity-checking global_link] for why. + //ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->global_link) && + // (tso->global_link == END_TSO_QUEUE || + // get_itbl((StgClosure*)tso->global_link)->type == TSO)); if (tso->label) { ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->label)); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21f3aae7371469beb3950a6170db6c5668379ff3...451d65a6913d85088a350be8e9b7a6d834453326 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21f3aae7371469beb3950a6170db6c5668379ff3...451d65a6913d85088a350be8e9b7a6d834453326 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 22:03:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 18:03:24 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Split up tyThingToIfaceDecl from GHC.Iface.Make Message-ID: <6462ac2cbce36_171ad97e70a46c9676bb@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - 17 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - + compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Iface/Type.hs-boot - compiler/GHC/Linker/Loader.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/451d65a6913d85088a350be8e9b7a6d834453326...4d29ecdfcc79ad663e066d9f7d6d17b64c8c6c41 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/451d65a6913d85088a350be8e9b7a6d834453326...4d29ecdfcc79ad663e066d9f7d6d17b64c8c6c41 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 22:30:01 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 15 May 2023 18:30:01 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Handle unspecified vs specified flags and commands better Message-ID: <6462b269cc027_171ad98007030c972927@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 1e4e0543 by Rodrigo Mesquita at 2023-05-15T23:02:23+01:00 Handle unspecified vs specified flags and commands better - - - - - 2fff8d82 by Rodrigo Mesquita at 2023-05-15T23:29:53+01:00 ROMES: WIP 4 - - - - - 4 changed files: - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -70,7 +70,7 @@ emptyOpts = Opts , optTablesNextToCode = Nothing , optUseLibFFIForAdjustors = Nothing , optLdOverride = Nothing -- See comment in Link on 'enableOverride'. Shouldn't we set the default here? - , optVerbosity = 0 + , optVerbosity = 1 , optKeepTemp = False } where @@ -145,10 +145,18 @@ options = progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)] progOpts progName description lens = [ Option [] [progName] (ReqArg (set (lens % _poPath) . Just) metavar) ("Path of " ++ description) - , Option [] [progName++"-opt"] (ReqArg (\x -> over (lens % _poFlags) (++[x])) "OPTS") ("Flags to pass to " ++ progName) + , Option [] [progName++"-opt"] (ReqArg (over (lens % _poFlags) . updatePoFlags) "OPTS") ("Flags to pass to " ++ progName) ] where metavar = map toUpper progName + updatePoFlags newOpts existingOpts + = case newOpts of + -- Empty list of flags is as if it was unspecified + "" -> existingOpts + -- Otherwise append specified flags to existing flags or make new + _ -> case existingOpts of + Nothing -> Just [newOpts] + Just eopts -> Just (eopts ++ [newOpts]) enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)] enableDisable optName description lens = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -18,6 +18,7 @@ module GHC.Toolchain.Program import Control.Monad import Control.Monad.IO.Class import Data.List (intercalate) +import Data.Maybe import System.Directory import System.Exit import System.Process hiding (env) @@ -80,18 +81,22 @@ logExecute prog args = -- | Program specifier from the command-line. data ProgOpt = ProgOpt { poPath :: Maybe FilePath - , poFlags :: [String] + , poFlags :: Maybe [String] } _poPath :: Lens ProgOpt (Maybe FilePath) _poPath = Lens poPath (\x o -> o {poPath=x}) -_poFlags :: Lens ProgOpt [String] +_poFlags :: Lens ProgOpt (Maybe [String]) _poFlags = Lens poFlags (\x o -> o {poFlags=x}) emptyProgOpt :: ProgOpt -emptyProgOpt = ProgOpt Nothing [] +emptyProgOpt = ProgOpt Nothing Nothing +-- | Tries to find the user specified program by path or tries to look for one +-- in the given list of candidates. +-- +-- If the 'ProgOpt' program flags are unspecified the program will have an empty list of flags. findProgram :: String -> ProgOpt -- ^ path provided by user -> [FilePath] -- ^ candidate names @@ -117,7 +122,7 @@ findProgram description userSpec candidates ] toProgram <$> oneOf err (map find_it candidates') <|> throwE err where - toProgram path = Program { prgPath = path, prgFlags = poFlags userSpec } + toProgram path = Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) } find_it name = do r <- liftIO $ findExecutable name ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -3,9 +3,11 @@ module GHC.Toolchain.Tools.Cpp (Cpp(..), findCpp) where import Control.Monad +import System.FilePath import GHC.Toolchain.Prelude import GHC.Toolchain.Program +import GHC.Toolchain.Utils (withTempDir) import GHC.Toolchain.Tools.Cc @@ -14,33 +16,38 @@ newtype Cpp = Cpp { cppProgram :: Program deriving (Show, Read, Eq, Ord) findCpp :: ProgOpt -> Cc -> M Cpp -findCpp progOpt cc - | Just _ <- poPath progOpt = checking "for C preprocessor" $ do - -- If the user specified a linker don't second-guess them - cppProgram <- findProgram "C preprocessor" progOpt [] - return Cpp{cppProgram} - | otherwise = checking "for C preprocessor" $ do - let rawCppProgram = over _prgFlags (["-E"]++) (ccProgram cc) - hppArgs <- findHsCppArgs rawCppProgram - let cppProgram = over _prgFlags (++hppArgs) rawCppProgram - return Cpp{cppProgram} +findCpp progOpt cc = checking "for C preprocessor" $ do + -- Use the specified CPP or try to find one (candidate is the c compiler) + foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] + case poFlags progOpt of + -- If the user specified CPP flags don't second-guess them + Just _ -> return Cpp{cppProgram=foundCppProg} + -- Otherwise, configure the CPP flags for this CPP program + Nothing -> do + let rawCppProgram = over _prgFlags (["-E"]++) foundCppProg + hppArgs <- findHsCppArgs rawCppProgram + let cppProgram = over _prgFlags (++hppArgs) rawCppProgram + return Cpp{cppProgram} -- | Given a C preprocessor, figure out how it should be invoked to preprocess -- Haskell source. findHsCppArgs :: Program -> M [String] -findHsCppArgs cpp = - concat <$> sequence - [ ["-traditional"] <$ checkFlag "-traditional" - , tryFlag "-undef" - , tryFlag "-Wno-invalid-pp-token" - , tryFlag "-Wno-unicode" - , tryFlag "-Wno-trigraphs" - ] - where - -- Werror to ensure that unrecognized warnings result in an error - checkFlag flag = - checking ("for "++flag++" support") $ callProgram cpp ["-E", "-Werror", flag, "/dev/null"] - - tryFlag flag = - ([flag] <$ checkFlag flag) <|> return [] +findHsCppArgs cpp = withTempDir $ \dir -> do + let tmp_h = dir "tmp.h" + + -- Werror to ensure that unrecognized warnings result in an error + checkFlag flag = + checking ("for "++flag++" support") $ callProgram cpp ["-Werror", flag, tmp_h] + + tryFlag flag = + ([flag] <$ checkFlag flag) <|> return [] + + writeFile tmp_h "" + concat <$> sequence + [ ["-traditional"] <$ checkFlag "-traditional" + , tryFlag "-undef" + , tryFlag "-Wno-invalid-pp-token" + , tryFlag "-Wno-unicode" + , tryFlag "-Wno-trigraphs" + ] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -27,21 +27,22 @@ data CcLink = CcLink { ccLinkProgram :: Program findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do - ccLinkProgram <- case poPath progOpt of - Just _ -> - -- If the user specified a linker don't second-guess them - findProgram "C compiler for linking" progOpt [] - Nothing -> do - -- If not then try to find a decent linker on our own - rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc] - findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink - ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram - ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram - ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram - ccLinkSupportsResponseFiles <- checkSupportsResponseFiles cc ccLinkProgram - checkBfdCopyBug archOs cc readelf ccLinkProgram - ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram - return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles} + -- Use the specified linker or try to find one + rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc] + ccLinkProgram <- case poFlags progOpt of + Just _ -> + -- If the user specified linker flags don't second-guess them + pure rawCcLink + Nothing -> do + -- If not then try to find decent linker flags + findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink + ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram + ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram + ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram + ccLinkSupportsResponseFiles <- checkSupportsResponseFiles cc ccLinkProgram + checkBfdCopyBug archOs cc readelf ccLinkProgram + ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram + return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles} -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program @@ -99,7 +100,7 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ withTempDir $ \dir -> do - let test_o = dir "o" + let test_o = dir "test.o" test2_o = dir "test2.o" compileC cc test_o "int foo() { return 0; }" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5fd71a5b3192b3c54315739fc72800f98a7c5153...2fff8d824663f128ca31420b1fdcbf50e9af1df4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5fd71a5b3192b3c54315739fc72800f98a7c5153...2fff8d824663f128ca31420b1fdcbf50e9af1df4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 22:34:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 15 May 2023 18:34:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Replace the implementation of CodeBuffers with unboxed types Message-ID: <6462b3584aee5_171ad980915a5c97799c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - 36bca59b by Rodrigo Mesquita at 2023-05-15T18:33:53-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - f01c89d5 by Cheng Shao at 2023-05-15T18:33:54-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - 17 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - + compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Iface/Type.hs-boot - compiler/GHC/Linker/Loader.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bcc97386291df4f52b4310dda425ea885613737...f01c89d582ea6650a53dff88103e46eabbdc38ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bcc97386291df4f52b4310dda425ea885613737...f01c89d582ea6650a53dff88103e46eabbdc38ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 22:34:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 18:34:35 -0400 Subject: [Git][ghc/ghc][wip/backports-9.6] 16 commits: Refactor the simplifier a bit to fix #22761 Message-ID: <6462b37b126ef_171ad980998f389835f1@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: e0f3aec8 by Simon Peyton Jones at 2023-05-15T18:34:25-04:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. (cherry picked from commit e45eb82830d6de4d09abb548e190be980dd001b4) - - - - - 595edd68 by Josh Meredith at 2023-05-15T18:34:25-04:00 JS: Fix implementation of MK_JSVAL (cherry picked from commit bab232795865e9abb82b75c7e72329778e23a345) - - - - - dc291c00 by Josh Meredith at 2023-05-15T18:34:25-04:00 JS: fix implementation of forceBool to use JS backend syntax (cherry picked from commit 047e9d4f10e4124899887449dc52b9e72a7d3ea6) - - - - - 3db2b31b by Sebastian Graf at 2023-05-15T18:34:26-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 (cherry picked from commit 559a480427a841b5189f2e6a84a38b02a7c2b8a1) - - - - - 4532771a by Alexis King at 2023-05-15T18:34:26-04:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 (cherry picked from commit bed3a292df532935426987e1f0c5eaa4f605407e) - - - - - 6be47292 by Cheng Shao at 2023-05-15T18:34:26-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. (cherry picked from commit d9ae24ad3de71e14364665ff1741aa3551e7c526) - - - - - 4d65cd0a by Matthew Pickering at 2023-05-15T18:34:26-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 (cherry picked from commit d7a768a415c3bd575a20b20ae9a3953aa5886ed7) - - - - - c709ce29 by Simon Peyton Jones at 2023-05-15T18:34:26-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 (cherry picked from commit 3b0ea4809d92581a10e0e501a6fbd7339e8922bf) - - - - - e832b103 by Cheng Shao at 2023-05-15T18:34:26-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 (cherry picked from commit b2d14d0b8ebb517139c08934a52791f21fe893f6) - - - - - cde812f8 by Ben Gamari at 2023-05-15T18:34:26-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 (cherry picked from commit d1bb16ed3e18a4f41fcfe31f0bf57dbaf589d6c5) - - - - - 2880f832 by Krzysztof Gogolewski at 2023-05-15T18:34:26-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). (cherry picked from commit 7c16f3be6e1ac92f87d752f12ad6c6e7b7fd6207) - - - - - 3b19832c by Ben Gamari at 2023-05-15T18:34:26-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. (cherry picked from commit b8d783d24b9a617ad1e3038abeb75d322703ef65) - - - - - 769877f1 by Sylvain Henry at 2023-05-15T18:34:26-04:00 JS: fix thread-related primops (cherry picked from commit d442ac053f9ac7dbcc32318802daf686f377fe3d) - - - - - 27ce7a1d by Ben Gamari at 2023-05-15T18:34:26-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 (cherry picked from commit 52d3e9b4189440d26bad9c5a15f9420b67b1ca5b) - - - - - 45188f29 by Ben Gamari at 2023-05-15T18:34:26-04:00 testsuite: Add test for #23071 (cherry picked from commit 1db30fe1dd38dd8ffedfadf3845706fcde02933b) - - - - - c923c1b9 by sheaf at 2023-05-15T18:34:26-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 (cherry picked from commit df1a581188694479a583270548896245fc23b525) - - - - - 30 changed files: - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Types/Id.hs - docs/index.html → docs/index.html.in - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - libraries/base/tests/all.T - + libraries/base/tests/listThreads1.hs - + libraries/base/tests/listThreads1.stdout - rts/HsFFI.c - rts/RtsSymbols.c - rts/Threads.c - rts/include/rts/storage/ClosureMacros.h - rts/js/mem.js - rts/js/thread.js The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24c5e2496a59df5f79fc516975d4cd473cc86c84...c923c1b983c717c7a6e2c16c6fe52ba0923eee20 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24c5e2496a59df5f79fc516975d4cd473cc86c84...c923c1b983c717c7a6e2c16c6fe52ba0923eee20 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 22:57:34 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 15 May 2023 18:57:34 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] After talking to Richard Message-ID: <6462b8de37959_171ad9813e1918986578@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: b9673b56 by Simon Peyton Jones at 2023-05-15T23:56:23+01:00 After talking to Richard * Use SimplifierStage Void when no ContinueWith * Fast path for equality classes - - - - - 8 changed files: - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Utils/Outputable.hs - testsuite/tests/quantified-constraints/T17267b.hs Changes: ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module GHC.Tc.Instance.Class ( - matchGlobalInst, + matchGlobalInst, matchEqualityInst, ClsInstResult(..), safeOverlap, instanceReturnsDictCon, AssocInstInfo(..), isNotAssociated, @@ -127,9 +127,6 @@ matchGlobalInst dflags short_cut clas tys | isCTupleClass clas = matchCTuple clas tys | cls_name == typeableClassName = matchTypeable clas tys | cls_name == withDictClassName = matchWithDict tys - | clas `hasKey` heqTyConKey = matchHeteroEquality tys - | clas `hasKey` eqTyConKey = matchHomoEquality tys - | clas `hasKey` coercibleTyConKey = matchCoercible tys | cls_name == hasFieldClassName = matchHasField dflags short_cut clas tys | cls_name == unsatisfiableClassName = return NoInstance -- See (B) in Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors | otherwise = matchInstEnv dflags short_cut clas tys @@ -798,33 +795,24 @@ if you'd written ***********************************************************************-} -- See also Note [The equality types story] in GHC.Builtin.Types.Prim -matchHeteroEquality :: [Type] -> TcM ClsInstResult --- Solves (t1 ~~ t2) -matchHeteroEquality args - = return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon args ] - , cir_mk_ev = evDataConApp heqDataCon args - , cir_coherence = IsCoherent - , cir_what = BuiltinEqInstance }) +matchEqualityInst :: Class -> [Type] -> (DataCon, Role, Type, Type) -matchHomoEquality :: [Type] -> TcM ClsInstResult --- Solves (t1 ~ t2) -matchHomoEquality args@[k,t1,t2] - = return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon [k,k,t1,t2] ] - , cir_mk_ev = evDataConApp eqDataCon args - , cir_coherence = IsCoherent - , cir_what = BuiltinEqInstance }) -matchHomoEquality args = pprPanic "matchHomoEquality" (ppr args) +matchEqualityInst cls args + | cls `hasKey` eqTyConKey -- Solves (t1 ~ t2) + , [_,t1,t2] <- args + = (eqDataCon, Nominal, t1, t2) + + | cls `hasKey` heqTyConKey -- Solves (t1 ~~ t2) + , [_,_,t1,t2] <- args + = (heqDataCon, Nominal, t1, t2) + + | cls `hasKey` coercibleTyConKey -- Solves (Coercible t1 t2) + , [_, t1, t2] <- args + = (coercibleDataCon, Representational, t1, t2) + + | otherwise + = pprPanic "matchEqualityInst" (ppr (mkClassPred cls args)) --- See also Note [The equality types story] in GHC.Builtin.Types.Prim -matchCoercible :: [Type] -> TcM ClsInstResult -matchCoercible args@[k, t1, t2] - = return (OneInst { cir_new_theta = [ mkTyConApp eqReprPrimTyCon args' ] - , cir_mk_ev = evDataConApp coercibleDataCon args - , cir_coherence = IsCoherent - , cir_what = BuiltinEqInstance }) - where - args' = [k, k, t1, t2] -matchCoercible args = pprPanic "matchLiftedCoercible" (ppr args) {- ******************************************************************** * * ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -10,9 +10,8 @@ module GHC.Tc.Solver.Dict ( import GHC.Prelude import GHC.Tc.Errors.Types -import GHC.Tc.Utils.TcType import GHC.Tc.Instance.FunDeps -import GHC.Tc.Instance.Class( safeOverlap ) +import GHC.Tc.Instance.Class( safeOverlap, matchEqualityInst ) import GHC.Tc.Types.Evidence import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin @@ -20,6 +19,8 @@ import GHC.Tc.Types.EvTerm( evCallStack ) import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad import GHC.Tc.Solver.Types +import GHC.Tc.Utils.TcType +import GHC.Tc.Utils.Unify( uType ) import GHC.Hs.Type( HsIPName(..) ) @@ -53,6 +54,7 @@ import GHC.Driver.Session import qualified GHC.LanguageExtensions as LangExt import Data.Maybe ( listToMaybe, mapMaybe, isJust ) +import Data.Void( Void ) import Control.Monad.Trans.Maybe( MaybeT, runMaybeT ) import Control.Monad.Trans.Class( lift ) @@ -65,15 +67,27 @@ import Control.Monad( mzero, when ) * * ********************************************************************* -} -solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage () +{- Note [Solving equality classes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We have a special solver for the "equality classes" + (t1 ~ t2), (t1 ~~ t2), and (Coercible t1 t2) + + TODO: expand this Note +-} + +solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage Void -- NC: this comes from CNonCanonical or CIrredCan -- Precondition: already rewritten by inert set solveDictNC ev cls tys + | isEqualityClass cls + = solveEqualityDict ev cls tys + + | otherwise = do { simpleStage $ traceTcS "solveDictNC" (ppr (mkClassPred cls tys) $$ ppr ev) ; dict_ct <- canDictCt ev cls tys ; solveDict dict_ct } -solveDict :: DictCt -> SolverStage () +solveDict :: DictCt -> SolverStage Void -- Preconditions: `tys` are already rewritten by the inert set solveDict dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = tys }) = assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ @@ -96,7 +110,7 @@ solveDict dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = tys }) updInertDicts :: DictCt -> TcS () updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev }) - = do { -- See [Kick out existing binding for implicit parameter] + = do { -- See Note [Shadowing of Implicit Parameters] ; when (isGiven ev && isIPClass cls) $ updInertCans (updDicts (delIPDict dict_ct)) @@ -113,19 +127,10 @@ canDictCt ev cls tys do { dflags <- getDynFlags ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + ; emitWork (listToBag sc_cts) - -- For equality classes, /replace/ the current constraint with its - -- superclasses, rather than /adding/ them. - -- See (NC1) in Note [Naturally coherent classes] - ; if isEqualityClass cls - then case sc_cts of - [ct] -> startAgainWith ct - _ -> pprPanic "canDictCt" (ppr cls) - else - - do { emitWork (listToBag sc_cts) ; continueWith (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = doNotExpand }) } } + , di_tys = tys, di_pend_sc = doNotExpand }) } -- doNotExpand: We have already expanded superclasses for /this/ dict -- so set the fuel to doNotExpand to avoid repeating expansion @@ -183,10 +188,17 @@ solveCallStack ev ev_cs ; setEvBindIfWanted ev IsCoherent ev_tm } -{- Note [Kick out existing binding for implicit parameter] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Shadowing of Implicit Parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we add a new /given/ implicit parameter to the inert set, it /replaces/ -any existing givens for the same implicit parameter. +any existing givens for the same implicit parameter. This makes a difference +in two places: + +* In `GHC.Tc.Solver.InertSet.solveOneFromTheOther`, be careful when we have + (?x :: ty) in the inert set and an identical (?x :: ty) as the work item. + +* In `updInertDicts` in this module, when adding [G] (?x :: ty), remove any + existing [G] (?x :: ty'), regardless of ty' Example 1: @@ -263,6 +275,37 @@ I can think of two ways to fix this: -} +{- ****************************************************************************** +* * + solveEqualityDict +* * +****************************************************************************** -} + +solveEqualityDict :: CtEvidence -> Class -> [Type] -> SolverStage Void +-- Precondition: (isEqualityClass cls) True, so cls is (~), (~~), or Coercible +solveEqualityDict ev cls tys + | CtWanted { ctev_dest = dest } <- ev + = Stage $ + do { let (data_con, role, t1, t2) = matchEqualityInst cls tys + -- Unify t1~t2, putting anything that can't be solved + -- immediately into the work list + ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> + uType uenv t1 t2 + -- Set d :: (t1~t2) = Eq# co + ; setWantedEvTerm dest IsCoherent $ + evDataConApp data_con tys [Coercion co] + ; stopWith ev "Solved wanted lifted equality" } + + | CtGiven { ctev_evar = ev_id, ctev_loc = loc } <- ev + , [sel_id] <- classSCSelIds cls -- Equality classes have just one superclass + = Stage $ + do { let sc_pred = classMethodInstTy sel_id tys + ev_expr = EvExpr $ Var sel_id `mkTyApps` tys `App` evId ev_id + ; given_ev <- newGivenEvVar loc (sc_pred, ev_expr) + ; startAgainWith (mkNonCanonical given_ev) } + | otherwise + = pprPanic "solveEqualityDict" (ppr cls) + {- ****************************************************************************** * * interactDict @@ -770,7 +813,6 @@ matchClassInst dflags inerts clas tys loc -- whether top level, or local quantified constraints. -- See Note [Instance and Given overlap] | not (xopt LangExt.IncoherentInstances dflags) - , not (naturallyCoherentClass clas) -- See (NC3) in Note [Naturally coherent classes] , not (noMatchableGivenDicts inerts loc clas tys) = do { traceTcS "Delaying instance application" $ vcat [ text "Work item=" <+> pprClassPred clas tys ] @@ -796,6 +838,7 @@ matchClassInst dflags inerts clas tys loc where pred = mkClassPred clas tys +{- -- | If a class is "naturally coherent", then we needn't worry at all, in any -- way, about overlapping/incoherent instances. Just solve the thing! -- See Note [Naturally coherent classes] @@ -803,6 +846,7 @@ matchClassInst dflags inerts clas tys loc naturallyCoherentClass :: Class -> Bool naturallyCoherentClass cls = isCTupleClass cls || isEqualityClass cls +-} isEqualityClass :: Class -> Bool -- True of (~), (~~), and Coercible @@ -903,14 +947,15 @@ this: (See Note [The equality types story] in GHC.Builtin.Types.Prim.) PS: the term "naturally coherent" doesn't really seem helpful. -Perhaps "invertible" or something? I left it for now though. +Perhaps "invertible" or "bidirectional" or something? I left it for +now though. For naturally coherent classes: -(NC1) For Givens, when expanding superclasses, we /replace/ the constraint - with its superclasses (which, remember, are equally powerful) rather than - /adding/ them. This can make a huge difference. Consider T17836, which - has a constraint like +(NC1) For Givens, when expanding the superclasses of a naturally coherent class, + we can /replace/ the constraint with its superclasses (which, remember, are + equally powerful) rather than /adding/ them. This can make a huge difference. + Consider T17836, which has a constraint like forall b,c. a ~ (b,c) => forall d,e. c ~ (d,e) => ...etc... @@ -923,7 +968,7 @@ For naturally coherent classes: Originally I tried this for all naturally-coherent classes, including tuples. But discarding the tuple Given (which "replacing" does) means that we may have to reconstruct it for a recursive call, and the optimiser isn't - quite clever enought to figure that out: see #10359 and its test case. + quite clever enough to figure that out: see #10359 and its test case. This is less pressing for equality classes because they have to be unpacked strictly, so CSE-ing away the reconstuction works fine. Hence the use of isEqualityClass rather than naturallyCoherentClass in canDictCt. @@ -944,7 +989,7 @@ For naturally coherent classes: so the reduction of the [W] constraint does not risk losing any solutions. On the other hand, it can be fatal to /fail/ to reduce such equalities - on the grounds of Note [Instance and Given overlap], fbecause many good + on the grounds of Note [Instance and Given overlap], because many good things flow from [W] t1 ~# t2. The same reasoning applies to @@ -1923,8 +1968,8 @@ mk_strict_superclasses fuel rec_clss ev@(CtGiven { ctev_evar = evar, ctev_loc = | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; assertFuelPrecondition fuel - $ mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } + ; assertFuelPrecondition fuel $ + mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -1952,7 +1997,7 @@ mk_strict_superclasses fuel rec_clss ev@(CtGiven { ctev_evar = evar, ctev_loc = `App` (evId evar `mkVarApps` (tvs ++ dict_ids)) `mkVarApps` sc_tvs - sc_loc | naturallyCoherentClass cls + sc_loc | isCTupleClass cls = loc -- See (NC2) in Note [Naturally coherent classes] | otherwise = loc { ctl_origin = mk_sc_origin (ctLocOrigin loc) } ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -60,7 +60,7 @@ import Data.List ( zip4 ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) - +import Data.Void( Void ) {- ********************************************************************* * * @@ -102,7 +102,7 @@ indeed they are! -} solveEquality :: CtEvidence -> EqRel -> Type -> Type - -> SolverStage () + -> SolverStage Void solveEquality ev eq_rel ty1 ty2 = do { Pair ty1' ty2' <- zonkEqTypes ev eq_rel ty1 ty2 ; let ev' | debugIsOn = setCtEvPredType ev $ ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -21,9 +21,10 @@ import GHC.Types.Basic( SwapFlag(..) ) import GHC.Utils.Outputable - import GHC.Data.Bag +import Data.Void( Void ) + {- ********************************************************************* * * @@ -31,7 +32,7 @@ import GHC.Data.Bag * * ********************************************************************* -} -solveIrred :: IrredCt -> SolverStage () +solveIrred :: IrredCt -> SolverStage Void solveIrred irred = do { simpleStage $ traceTcS "solveIrred:" (ppr irred) ; tryInertIrreds irred ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -211,8 +211,9 @@ data StopOrContinue a = StartAgain Ct -- Constraint is not solved, but some unifications -- happened, so go back to the beginning of the pipeline - | ContinueWith a -- The constraint was not solved, although it may have - -- been rewritten + | ContinueWith !a -- The constraint was not solved, although it may have + -- been rewritten. It is strict so that + -- ContinueWith Void can't happen | Stop CtEvidence -- The (rewritten) constraint was solved SDoc -- Tells how it was solved ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -43,6 +43,7 @@ import Data.List( deleteFirstsBy ) import Control.Monad import Data.Semigroup as S +import Data.Void( Void ) {- ********************************************************************** @@ -196,7 +197,10 @@ solveOne workItem ; traceTcS "End solver pipeline }" empty ; return () } - ContinueWith {} -> pprPanic "Pipeline finished without solving" (ppr ct) } + -- ContinueWith can't happen: res :: SolverStage Void + -- solveCt either solves the constraint, or puts + -- the unsolved constraint in the inert set. + } {- ********************************************************************* * * @@ -224,7 +228,9 @@ it must be recanonicalized. But we know a bit about its shape from the last time through, so we can skip the classification step. -} -solveCt :: Ct -> SolverStage () +solveCt :: Ct -> SolverStage Void +-- The Void result tells us that solveCt cannot return +-- a ContinueWith; it must return Stop or StartAgain. solveCt (CNonCanonical ev) = solveNC ev solveCt (CIrredCan (IrredCt { ir_ev = ev })) = solveNC ev @@ -234,12 +240,18 @@ solveCt (CEqCan (EqCt { eq_ev = ev, eq_eq_rel = eq_rel solveCt (CQuantCan (QCI { qci_ev = ev, qci_pend_sc = pend_sc })) = do { ev <- rewriteEvidence ev + -- It is (much) easier to rewrite and re-classify than to + -- rewrite the pieces and build a Reduction that will rewrite + -- the whole constraint ; case classifyPredType (ctEvPred ev) of ForAllPred tvs th p -> Stage $ solveForAll ev tvs th p pend_sc _ -> pprPanic "SolveCt" (ppr ev) } solveCt (CDictCan (DictCt { di_ev = ev, di_pend_sc = pend_sc })) = do { ev <- rewriteEvidence ev + -- It is easier to rewrite and re-classify than to rewrite + -- the pieces and build a Reduction that will rewrite the + -- whole constraint ; case classifyPredType (ctEvPred ev) of ClassPred cls tys -> solveDict (DictCt { di_ev = ev, di_cls = cls @@ -247,7 +259,7 @@ solveCt (CDictCan (DictCt { di_ev = ev, di_pend_sc = pend_sc })) _ -> pprPanic "solveCt" (ppr ev) } ------------------ -solveNC :: CtEvidence -> SolverStage () +solveNC :: CtEvidence -> SolverStage Void solveNC ev = -- Instead of rewriting the evidence before classifying, it's possible we -- can make progress without the rewrite. Try this first. @@ -354,7 +366,7 @@ type signature. -} solveForAllNC :: CtEvidence -> [TcTyVar] -> TcThetaType -> TcPredType - -> TcS (StopOrContinue ()) + -> TcS (StopOrContinue Void) -- NC: this came from CNonCanonical, so we have not yet expanded superclasses -- Precondition: already rewritten by inert set solveForAllNC ev tvs theta pred @@ -380,7 +392,7 @@ solveForAllNC ev tvs theta pred cls_pred_tys_maybe = getClassPredTys_maybe pred solveForAll :: CtEvidence -> [TcTyVar] -> TcThetaType -> PredType -> ExpansionFuel - -> TcS (StopOrContinue ()) + -> TcS (StopOrContinue Void) -- Precondition: already rewritten by inert set solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -891,6 +891,9 @@ class Outputable a where -- There's no Outputable for Char; it's too easy to use Outputable -- on String and have ppr "hello" rendered as "h,e,l,l,o". +instance Outputable Void where + ppr _ = text "<>" + instance Outputable Bool where ppr True = text "True" ppr False = text "False" ===================================== testsuite/tests/quantified-constraints/T17267b.hs ===================================== @@ -14,3 +14,22 @@ uc = oops where oops :: (a ~ b => a ~ b) => a -> b oops x = x +{- +Consider the ambiguity check for oops. + +[G] (a ~ b => a ~ b) +[W] (a ~ b => a ~ b) +==> + +[G] (a ~ b => a ~ b) +[G] (a ~# b) was [G] (a ~ b) [G] a ~# b + +kick out the QC and (old) (a~b) +[G] (b ~ b => b ~ b) Quantified constraint +[G] (a ~# b) was [G] (b ~ b) [G] a ~# b + +[W] (a~b) DictCt + +Wanted is rewritten + (b~b) DictCt +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9673b563bb28eaab4482c2be402d0de9a02530f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9673b563bb28eaab4482c2be402d0de9a02530f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 15 23:15:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 19:15:28 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <6462bd10f0310_171ad9813095689876b1@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: d2cca7a5 by Ben Gamari at 2023-05-15T19:15:21-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, OccSet, mkOccSet, elemOccSet) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: OccSet + exported_occs = mkOccSet $ map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elemOccSet` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2cca7a597d72079e1c9a70491540719c8052ad7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2cca7a597d72079e1c9a70491540719c8052ad7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 01:26:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 21:26:34 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 27 commits: JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <6462dbca8c093_171ad984b72f3010071f1@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - 13f83f4b by Ben Gamari at 2023-05-15T21:26:23-04:00 compiler: Make OccSet opaque - - - - - 725f9280 by Ben Gamari at 2023-05-15T21:26:24-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc. - - - - - 28e2c415 by Ben Gamari at 2023-05-15T21:26:25-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 5b76c144 by Ben Gamari at 2023-05-15T21:26:26-04:00 Don't use OccSet OccSet appears not to behave as one would expect. - - - - - 27 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2cca7a597d72079e1c9a70491540719c8052ad7...5b76c1441bf4802cda70796d7a3721bc2fb89e19 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2cca7a597d72079e1c9a70491540719c8052ad7...5b76c1441bf4802cda70796d7a3721bc2fb89e19 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 02:00:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 15 May 2023 22:00:00 -0400 Subject: [Git][ghc/ghc][wip/backports-9.6] 7 commits: nonmoving: Disable slop-zeroing Message-ID: <6462e3a06a220_171ad984b72f30101038d@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: 7c376f27 by Ben Gamari at 2023-05-15T21:59:49-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 (cherry picked from commit d1bb16ed3e18a4f41fcfe31f0bf57dbaf589d6c5) - - - - - ac3bd5b0 by Krzysztof Gogolewski at 2023-05-15T21:59:49-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). (cherry picked from commit 7c16f3be6e1ac92f87d752f12ad6c6e7b7fd6207) - - - - - eed419ae by Ben Gamari at 2023-05-15T21:59:49-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. (cherry picked from commit b8d783d24b9a617ad1e3038abeb75d322703ef65) - - - - - e03c5348 by Sylvain Henry at 2023-05-15T21:59:49-04:00 JS: fix thread-related primops (cherry picked from commit d442ac053f9ac7dbcc32318802daf686f377fe3d) - - - - - a283de03 by Ben Gamari at 2023-05-15T21:59:49-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 (cherry picked from commit 52d3e9b4189440d26bad9c5a15f9420b67b1ca5b) - - - - - 80cf7b21 by Ben Gamari at 2023-05-15T21:59:49-04:00 testsuite: Add test for #23071 (cherry picked from commit 1db30fe1dd38dd8ffedfadf3845706fcde02933b) - - - - - 2855ecf2 by sheaf at 2023-05-15T21:59:49-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 (cherry picked from commit df1a581188694479a583270548896245fc23b525) - - - - - 18 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Utils/TcType.hs - libraries/base/tests/all.T - + libraries/base/tests/listThreads1.hs - + libraries/base/tests/listThreads1.stdout - rts/Threads.c - rts/include/rts/storage/ClosureMacros.h - rts/js/mem.js - rts/js/thread.js - + testsuite/tests/primops/should_run/T23071.hs - testsuite/tests/primops/should_run/all.T - + testsuite/tests/simplCore/should_run/T23134.hs - + testsuite/tests/simplCore/should_run/T23134.stdout - testsuite/tests/simplCore/should_run/all.T - + testsuite/tests/typecheck/should_compile/T23171.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NumericUnderscores #-} module GHC.CmmToAsm.AArch64.CodeGen ( cmmTopCodeGen , generateJumpTableForInstr @@ -773,12 +772,12 @@ getRegister' config plat expr return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) -- 3. Logic &&, || - CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (AND (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg @@ -963,19 +962,6 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) - -- This needs to check if n can be encoded as a bitmask immediate: - -- - -- See https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly - -- - isBitMaskImmediate :: Integer -> Bool - isBitMaskImmediate i = i `elem` [0b0000_0001, 0b0000_0010, 0b0000_0100, 0b0000_1000, 0b0001_0000, 0b0010_0000, 0b0100_0000, 0b1000_0000 - ,0b0000_0011, 0b0000_0110, 0b0000_1100, 0b0001_1000, 0b0011_0000, 0b0110_0000, 0b1100_0000 - ,0b0000_0111, 0b0000_1110, 0b0001_1100, 0b0011_1000, 0b0111_0000, 0b1110_0000 - ,0b0000_1111, 0b0001_1110, 0b0011_1100, 0b0111_1000, 0b1111_0000 - ,0b0001_1111, 0b0011_1110, 0b0111_1100, 0b1111_1000 - ,0b0011_1111, 0b0111_1110, 0b1111_1100 - ,0b0111_1111, 0b1111_1110 - ,0b1111_1111] -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register @@ -1018,6 +1004,39 @@ getRegister' config plat expr CMP (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) `snocOL` CSET (OpReg w dst) NE) +-- | Is a given number encodable as a bitmask immediate? +-- +-- https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly +isAArch64Bitmask :: Integer -> Bool +-- N.B. zero and ~0 are not encodable as bitmask immediates +isAArch64Bitmask 0 = False +isAArch64Bitmask n + | n == bit 64 - 1 = False +isAArch64Bitmask n = + check 64 || check 32 || check 16 || check 8 + where + -- Check whether @n@ can be represented as a subpattern of the given + -- width. + check width + | hasOneRun subpat = + let n' = fromIntegral (mkPat width subpat) + in n == n' + | otherwise = False + where + subpat :: Word64 + subpat = fromIntegral (n .&. (bit width - 1)) + + -- Construct a bit-pattern from a repeated subpatterns the given width. + mkPat :: Int -> Word64 -> Word64 + mkPat width subpat = + foldl' (.|.) 0 [ subpat `shiftL` p | p <- [0, width..63] ] + + -- Does the given number's bit representation match the regular expression + -- @0*1*0*@? + hasOneRun :: Word64 -> Bool + hasOneRun m = + 64 == popCount m + countLeadingZeros m + countTrailingZeros m + -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2006 -{-# LANGUAGE ScopedTypeVariables, PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables, PatternSynonyms, MultiWayIf #-} {-# LANGUAGE DeriveFunctor #-} @@ -47,6 +47,7 @@ import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set import GHC.Exts( oneShot ) +import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Data.FastString @@ -994,6 +995,59 @@ These two TyConApps have the same TyCon at the front but they (legitimately) have different numbers of arguments. They are surelyApart, so we can report that without looking any further (see #15704). + +Note [Unifying type applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Unifying type applications is quite subtle, as we found +in #23134 and #22647, when type families are involved. + +Suppose + type family F a :: Type -> Type + type family G k :: k = r | r -> k + +and consider these examples: + +* F Int ~ F Char, where F is injective + Since F is injective, we can reduce this to Int ~ Char, + therefore SurelyApart. + +* F Int ~ F Char, where F is not injective + Without injectivity, return MaybeApart. + +* G Type ~ G (Type -> Type) Int + Even though G is injective and the arguments to G are different, + we cannot deduce apartness because the RHS is oversaturated. + For example, G might be defined as + G Type = Maybe Int + G (Type -> Type) = Maybe + So we return MaybeApart. + +* F Int Bool ~ F Int Char -- SurelyApart (since Bool is apart from Char) + F Int Bool ~ Maybe a -- MaybeApart + F Int Bool ~ a b -- MaybeApart + F Int Bool ~ Char -> Bool -- MaybeApart + An oversaturated type family can match an application, + whether it's a TyConApp, AppTy or FunTy. Decompose. + +* F Int ~ a b + We cannot decompose a saturated, or under-saturated + type family application. We return MaybeApart. + +To handle all those conditions, unify_ty goes through +the following checks in sequence, where Fn is a type family +of arity n: + +* (C1) Fn x_1 ... x_n ~ Fn y_1 .. y_n + A saturated application. + Here we can unify arguments in which Fn is injective. +* (C2) Fn x_1 ... x_n ~ anything, anything ~ Fn x_1 ... x_n + A saturated type family can match anything - we return MaybeApart. +* (C3) Fn x_1 ... x_m ~ a b, a b ~ Fn x_1 ... x_m where m > n + An oversaturated type family can be decomposed. +* (C4) Fn x_1 ... x_m ~ anything, anything ~ Fn x_1 ... x_m, where m > n + If we couldn't decompose in the previous step, we return SurelyApart. + +Afterwards, the rest of the code doesn't have to worry about type families. -} -------------- unify_ty: the main workhorse ----------- @@ -1035,31 +1089,63 @@ unify_ty env ty1 (TyVarTy tv2) kco = uVar (umSwapRn env) tv2 ty1 (mkSymCo kco) unify_ty env ty1 ty2 _kco + + -- Handle non-oversaturated type families first + -- See Note [Unifying type applications] + -- + -- (C1) If we have T x1 ... xn ~ T y1 ... yn, use injectivity information of T + -- Note that both sides must not be oversaturated + | Just (tc1, tys1) <- isSatTyFamApp mb_tc_app1 + , Just (tc2, tys2) <- isSatTyFamApp mb_tc_app2 + , tc1 == tc2 + = do { let inj = case tyConInjectivityInfo tc1 of + NotInjective -> repeat False + Injective bs -> bs + + (inj_tys1, noninj_tys1) = partitionByList inj tys1 + (inj_tys2, noninj_tys2) = partitionByList inj tys2 + + ; unify_tys env inj_tys1 inj_tys2 + ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] + don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } + + | Just _ <- isSatTyFamApp mb_tc_app1 -- (C2) A (not-over-saturated) type-family application + = maybeApart MARTypeFamily -- behaves like a type variable; might match + + | Just _ <- isSatTyFamApp mb_tc_app2 -- (C2) A (not-over-saturated) type-family application + -- behaves like a type variable; might unify + -- but doesn't match (as in the TyVarTy case) + = if um_unif env then maybeApart MARTypeFamily else surelyApart + + -- Handle oversaturated type families. + -- + -- They can match an application (TyConApp/FunTy/AppTy), this is handled + -- the same way as in the AppTy case below. + -- + -- If there is no application, an oversaturated type family can only + -- match a type variable or a saturated type family, + -- both of which we handled earlier. So we can say surelyApart. + | Just (tc1, _) <- mb_tc_app1 + , isTypeFamilyTyCon tc1 + = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] -- (C3) + | otherwise -> surelyApart -- (C4) + + | Just (tc2, _) <- mb_tc_app2 + , isTypeFamilyTyCon tc2 + = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] -- (C3) + | otherwise -> surelyApart -- (C4) + + -- At this point, neither tc1 nor tc2 can be a type family. | Just (tc1, tys1) <- mb_tc_app1 , Just (tc2, tys2) <- mb_tc_app2 , tc1 == tc2 - = if isInjectiveTyCon tc1 Nominal - then unify_tys env tys1 tys2 - else do { let inj | isTypeFamilyTyCon tc1 - = case tyConInjectivityInfo tc1 of - NotInjective -> repeat False - Injective bs -> bs - | otherwise - = repeat False - - (inj_tys1, noninj_tys1) = partitionByList inj tys1 - (inj_tys2, noninj_tys2) = partitionByList inj tys2 - - ; unify_tys env inj_tys1 inj_tys2 - ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] - don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } - - | isTyFamApp mb_tc_app1 -- A (not-over-saturated) type-family application - = maybeApart MARTypeFamily -- behaves like a type variable; might match - - | isTyFamApp mb_tc_app2 -- A (not-over-saturated) type-family application - , um_unif env -- behaves like a type variable; might unify - = maybeApart MARTypeFamily + = do { massertPpr (isInjectiveTyCon tc1 Nominal) (ppr tc1) + ; unify_tys env tys1 tys2 + } -- TYPE and CONSTRAINT are not Apart -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim @@ -1160,16 +1246,16 @@ unify_tys env orig_xs orig_ys -- Possibly different saturations of a polykinded tycon -- See Note [Polykinded tycon applications] -isTyFamApp :: Maybe (TyCon, [Type]) -> Bool --- True if we have a saturated or under-saturated type family application +isSatTyFamApp :: Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type]) +-- Return the argument if we have a saturated type family application -- If it is /over/ saturated then we return False. E.g. -- unify_ty (F a b) (c d) where F has arity 1 -- we definitely want to decompose that type application! (#22647) -isTyFamApp (Just (tc, tys)) - = not (isGenerativeTyCon tc Nominal) -- Type family-ish +isSatTyFamApp tapp@(Just (tc, tys)) + | isTypeFamilyTyCon tc && not (tys `lengthExceeds` tyConArity tc) -- Not over-saturated -isTyFamApp Nothing - = False + = tapp +isSatTyFamApp _ = Nothing --------------------------------- uVar :: UMEnv ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -921,7 +921,7 @@ genPrim prof bound ty op = case op of IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ r |= var "h$threads" + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -2387,22 +2387,32 @@ has a separate call to isStuckTypeFamily, so the `F` above will still be accepte -} +-- | Why was the LHS 'PatersonSize' not strictly smaller than the RHS 'PatersonSize'? +-- +-- See Note [Paterson conditions] in GHC.Tc.Validity. data PatersonSizeFailure - = PSF_TyFam TyCon -- Type family - | PSF_Size -- Too many type constructors/variables - | PSF_TyVar [TyVar] -- These type variables appear more often than in instance head; - -- no duplicates in this list + -- | Either side contains a type family. + = PSF_TyFam TyCon + -- | The size of the LHS is not strictly less than the size of the RHS. + | PSF_Size + -- | These type variables appear more often in the LHS than in the RHS. + | PSF_TyVar [TyVar] -- ^ no duplicates in this list -------------------------------------- -data PatersonSize -- See Note [Paterson conditions] in GHC.Tc.Validity - = PS_TyFam TyCon -- Mentions a type family; infinite size - - | PS_Vanilla { ps_tvs :: [TyVar] -- Free tyvars, including repetitions; - , ps_size :: Int -- Number of type constructors and variables +-- | The Paterson size of a given type, in the sense of +-- Note [Paterson conditions] in GHC.Tc.Validity +-- +-- - after expanding synonyms, +-- - ignoring coercions (as they are not user written). +data PatersonSize + -- | The type mentions a type family, so the size could be anything. + = PS_TyFam TyCon + + -- | The type does not mention a type family. + | PS_Vanilla { ps_tvs :: [TyVar] -- ^ free tyvars, including repetitions; + , ps_size :: Int -- ^ number of type constructors and variables } - -- Always after expanding synonyms - -- Always ignore coercions (not user written) -- ToDo: ignore invisible arguments? See Note [Invisible arguments and termination] instance Outputable PatersonSize where @@ -2415,21 +2425,26 @@ pSizeZero, pSizeOne :: PatersonSize pSizeZero = PS_Vanilla { ps_tvs = [], ps_size = 0 } pSizeOne = PS_Vanilla { ps_tvs = [], ps_size = 1 } -ltPatersonSize :: PatersonSize -- Size of constraint - -> PatersonSize -- Size of instance head; never PS_TyFam +-- | @ltPatersonSize ps1 ps2@ returns: +-- +-- - @Nothing@ iff @ps1@ is definitely strictly smaller than @ps2@, +-- - @Just ps_fail@ otherwise; @ps_fail@ says what went wrong. +ltPatersonSize :: PatersonSize + -> PatersonSize -> Maybe PatersonSizeFailure --- (ps1 `ltPatersonSize` ps2) returns --- Nothing iff ps1 is strictly smaller than p2 --- Just ps_fail says what went wrong -ltPatersonSize (PS_TyFam tc) _ = Just (PSF_TyFam tc) ltPatersonSize (PS_Vanilla { ps_tvs = tvs1, ps_size = s1 }) (PS_Vanilla { ps_tvs = tvs2, ps_size = s2 }) | s1 >= s2 = Just PSF_Size | bad_tvs@(_:_) <- noMoreTyVars tvs1 tvs2 = Just (PSF_TyVar bad_tvs) | otherwise = Nothing -- OK! -ltPatersonSize (PS_Vanilla {}) (PS_TyFam tc) - = pprPanic "ltPSize" (ppr tc) - -- Impossible because we never have a type family in an instance head +ltPatersonSize (PS_TyFam tc) _ = Just (PSF_TyFam tc) +ltPatersonSize _ (PS_TyFam tc) = Just (PSF_TyFam tc) + -- NB: this last equation is never taken when checking instances, because + -- type families are disallowed in instance heads. + -- + -- However, this function is also used in the logic for solving superclass + -- constraints (see Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance), + -- in which case we might well hit this case (see e.g. T23171). noMoreTyVars :: [TyVar] -- Free vars (with repetitions) of the constraint C -> [TyVar] -- Free vars (with repetitions) of the head H ===================================== libraries/base/tests/all.T ===================================== @@ -290,5 +290,6 @@ test('T19719', normal, compile_and_run, ['']) test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring']) test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) -test('listThreads', js_broken(22261), compile_and_run, ['']) +test('listThreads', normal, compile_and_run, ['']) +test('listThreads1', normal, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) ===================================== libraries/base/tests/listThreads1.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import GHC.Conc.Sync + +main :: IO () +main = listThreads >>= print ===================================== libraries/base/tests/listThreads1.stdout ===================================== @@ -0,0 +1 @@ +[ThreadId 1] ===================================== rts/Threads.c ===================================== @@ -872,6 +872,7 @@ StgMutArrPtrs *listThreads(Capability *cap) const StgWord size = n_threads + mutArrPtrsCardTableSize(n_threads); StgMutArrPtrs *arr = (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size); + SET_HDR(arr, &stg_MUT_ARR_PTRS_DIRTY_info, CCS_SYSTEM); TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0); arr->ptrs = n_threads; arr->size = size; ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -479,11 +479,13 @@ EXTERN_INLINE StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n) memory we're about to zero. Thus, with the THREADED RTS and +RTS -N2 or greater we must not zero - immutable closure's slop. + immutable closure's slop. Similarly, the concurrent GC's mark thread + may race when a mutator during slop-zeroing. Consequently, we also disable + zeroing when the non-moving GC is in use. Hence, an immutable closure's slop is zeroed when either: - - PROFILING && era > 0 (LDV is on) or + - PROFILING && era > 0 (LDV is on) && !nonmoving-gc-enabled or - !THREADED && DEBUG Additionally: @@ -541,7 +543,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) const bool can_zero_immutable_slop = // Only if we're running single threaded. - RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1; + RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1 + && !RTS_DEREF(RtsFlags).GcFlags.useNonmoving; // see #23170 const bool zero_slop_immutable = want_to_zero_immutable_slop && can_zero_immutable_slop; ===================================== rts/js/mem.js ===================================== @@ -1455,11 +1455,3 @@ function h$pext64(src_b, src_a, mask_b, mask_a) { } RETURN_UBX_TUP2(dst_b, dst_a); } - -function h$getThreadLabel(t) { - if (t.label) { - RETURN_UBX_TUP2(1, t.label); - } else { - RETURN_UBX_TUP2(0, 0); - } -} ===================================== rts/js/thread.js ===================================== @@ -106,8 +106,8 @@ function h$Thread() { #endif } -function h$rts_getThreadId(t) { - return t.tid; +function h$rts_getThreadId(t) { // returns a CULLong + RETURN_UBX_TUP2((t.tid / Math.pow(2,32))>>>0, (t.tid & 0xFFFFFFFF)>>>0); } function h$cmp_thread(t1,t2) { @@ -121,13 +121,35 @@ function h$threadString(t) { if(t === null) { return ""; } else if(t.label) { - var str = h$decodeUtf8z(t.label[0], t.label[1]); + var str = h$decodeUtf8z(t.label, 0); return str + " (" + t.tid + ")"; } else { return (""+t.tid); } } +function h$getThreadLabel(t) { + if (t.label) { + RETURN_UBX_TUP2(1, t.label); + } else { + RETURN_UBX_TUP2(0, 0); + } +} + +function h$listThreads() { + var r = h$newArray(0,null); + + if (h$currentThread) r.push(h$currentThread); + + var threads_iter = h$threads.iter(); + while ((t = threads_iter()) !== null) r.push(t); + + var blocked_iter = h$blocked.iter(); + while ((t = blocked_iter.next()) !== null) r.push(t); + + return r; +} + function h$fork(a, inherit) { h$r1 = h$forkThread(a, inherit); return h$yield(); @@ -1134,7 +1156,7 @@ function h$main(a) { t.stack[8] = a; t.stack[9] = h$return; t.sp = 9; - t.label = [h$encodeUtf8("main"), 0]; + t.label = h$encodeUtf8("main"); h$wakeupThread(t); h$startMainLoop(); return t; ===================================== testsuite/tests/primops/should_run/T23071.hs ===================================== @@ -0,0 +1,5 @@ +import Control.Monad +import GHC.Conc.Sync + +main = replicateM_ 1000000 $ listThreads >>= print + ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -60,3 +60,4 @@ test('UnliftedTVar2', normal, compile_and_run, ['']) test('UnliftedWeakPtr', normal, compile_and_run, ['']) test('T21624', normal, compile_and_run, ['']) +test('T23071', ignore_stdout, compile_and_run, ['']) ===================================== testsuite/tests/simplCore/should_run/T23134.hs ===================================== @@ -0,0 +1,37 @@ +{-# LANGUAGE GHC2021, DataKinds, TypeFamilies #-} +module Main where + +import Data.Maybe +import Data.Kind + +main :: IO () +main = putStrLn str + +str :: String +str = case runInstrImpl @(TOption TUnit) mm MAP of + C VOption -> "good" + C Unused -> "bad" + +runInstrImpl :: forall inp out. Value (MapOpRes inp TUnit) -> Instr inp out -> Rec out +runInstrImpl m MAP = C m + +type MapOpRes :: T -> T -> T +type family MapOpRes c :: T -> T +type instance MapOpRes ('TOption x) = 'TOption + +mm :: Value (TOption TUnit) +mm = VOption +{-# NOINLINE mm #-} + +type Value :: T -> Type +data Value t where + VOption :: Value ('TOption t) + Unused :: Value t + +data T = TOption T | TUnit + +data Instr (inp :: T) (out :: T) where + MAP :: Instr c (TOption (MapOpRes c TUnit)) + +data Rec :: T -> Type where + C :: Value r -> Rec (TOption r) ===================================== testsuite/tests/simplCore/should_run/T23134.stdout ===================================== @@ -0,0 +1 @@ +good ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -108,3 +108,4 @@ test('T21575', normal, compile_and_run, ['-O']) test('T21575b', [], multimod_compile_and_run, ['T21575b', '-O']) test('T20836', normal, compile_and_run, ['-O0']) # Should not time out; See #20836 test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint']) +test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases']) ===================================== testsuite/tests/typecheck/should_compile/T23171.hs ===================================== @@ -0,0 +1,43 @@ +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module T23171 where + +import Data.Kind + +type C1 :: Type -> Type -> Constraint +class C1 t m where + +type C2 :: Type -> Constraint +class C2 a where + +type C3 :: Type -> Constraint +class C2 a => C3 a where + +type D :: Type -> Constraint +class D t where +instance (forall m. C3 m => C1 t m) => D t where + +type T :: Type -> Type +type family T a where + +try :: forall (e :: Type). D (T e) => e -> () +try _ = () + +type C1T :: Type -> Type -> Constraint +class C1 (T e) m => C1T e m + +tried :: forall (e :: Type). (forall m. C1T e m) => e -> () +tried = try @e + +-- From the call to "try", we get [W] D (T e). +-- After using the instance for D, we get the QC [G] C3 m ==> [W] C1 (T e) m. +-- +-- The Given "[G] C3 m" thus arises from superclass expansion +-- from "D (T e)", which contains a type family application, T. +-- So the logic in 'mkStrictSuperClasses' better be able to handle that when +-- expanding the superclasses of C3 (in this case, C2); in particular +-- ltPatersonSize needs to handle a type family in its second argument. + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -865,3 +865,4 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T23171', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c923c1b983c717c7a6e2c16c6fe52ba0923eee20...2855ecf281173334b30007d3b568f9bafdc68fce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c923c1b983c717c7a6e2c16c6fe52ba0923eee20...2855ecf281173334b30007d3b568f9bafdc68fce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 04:14:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 00:14:21 -0400 Subject: [Git][ghc/ghc][master] configure: Drop unused AC_PROG_CPP Message-ID: <6463031d639a3_171ad9898ecc4810274f9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -465,9 +465,6 @@ MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0]) dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS -dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) -AC_PROG_CPP - # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d986c98e471e21aee0129e1fe1a7ba3059069256 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d986c98e471e21aee0129e1fe1a7ba3059069256 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 04:15:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 00:15:03 -0400 Subject: [Git][ghc/ghc][master] rts: fix --disable-large-address-space Message-ID: <646303475eab3_171ad9898d3eb4103242a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - 2 changed files: - rts/sm/HeapAlloc.h - rts/sm/Storage.h Changes: ===================================== rts/sm/HeapAlloc.h ===================================== @@ -10,6 +10,14 @@ #include "BeginPrivate.h" +#if defined(THREADED_RTS) +// needed for HEAP_ALLOCED below +extern SpinLock gc_alloc_block_sync; +#endif + +#define ACQUIRE_ALLOC_BLOCK_SPIN_LOCK() ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync) +#define RELEASE_ALLOC_BLOCK_SPIN_LOCK() RELEASE_SPIN_LOCK(&gc_alloc_block_sync) + /* ----------------------------------------------------------------------------- The HEAP_ALLOCED() test. ===================================== rts/sm/Storage.h ===================================== @@ -43,15 +43,6 @@ extern Mutex sm_mutex; #define ASSERT_SM_LOCK() #endif -#if defined(THREADED_RTS) -// needed for HEAP_ALLOCED below -extern SpinLock gc_alloc_block_sync; -#endif - -#define ACQUIRE_ALLOC_BLOCK_SPIN_LOCK() ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync) -#define RELEASE_ALLOC_BLOCK_SPIN_LOCK() RELEASE_SPIN_LOCK(&gc_alloc_block_sync) - - /* ----------------------------------------------------------------------------- The write barrier for MVARs and TVARs -------------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8f0435fc5516ad978064eeabcc24776b6b86351 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8f0435fc5516ad978064eeabcc24776b6b86351 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 07:29:15 2023 From: gitlab at gitlab.haskell.org (Moritz Angermann (@angerman)) Date: Tue, 16 May 2023 03:29:15 -0400 Subject: [Git][ghc/ghc][wip/angerman/riscv64-ncg] 2 commits: Remove TAB character Message-ID: <646330cbc3333_171ad98e3d801810720a9@gitlab.mail> Moritz Angermann pushed to branch wip/angerman/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 1303b53d by Sven Tennie at 2023-05-02T15:34:16+00:00 Remove TAB character The whitespace linter doesn't like it. - - - - - c5024bcb by Sven Tennie at 2023-05-03T11:32:39+00:00 Fix compiler warning about importing GHC.Utils.Panic.Plain in CodeGen.Platform.h - - - - - 2 changed files: - compiler/CodeGen.Platform.h - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/CodeGen.Platform.h ===================================== @@ -1,7 +1,8 @@ import GHC.Cmm.Expr #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \ - || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64)) + || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64) \ + || defined(MACHREGS_riscv64)) import GHC.Utils.Panic.Plain #endif import GHC.Platform.Reg ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -537,7 +537,7 @@ pprInstr platform instr = case instr of LDR _f o1 (OpImm (ImmCLbl lbl)) -> -- fixing this is _really_ annoyin we need to generate code like: - -- 1: auipc x16, %pcrel_hi() + -- 1: auipc x16, %pcrel_hi() -- addi x16, x16, %pcrel_lo(1b) -- I really dislike this (refer back to label 1 syntax from the assembler.) -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30a10abcc56166885fc457f55a66acbeddae06cd...c5024bcbe41c5cab6429185fa4d65c67f87b8aa1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30a10abcc56166885fc457f55a66acbeddae06cd...c5024bcbe41c5cab6429185fa4d65c67f87b8aa1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 07:58:02 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Tue, 16 May 2023 03:58:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/warns-messages-drivermessage Message-ID: <6463378a51771_171ad9914b003c10805c9@gitlab.mail> Oleg Grenrus pushed new branch wip/warns-messages-drivermessage at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/warns-messages-drivermessage You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 08:17:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 04:17:38 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: configure: Drop unused AC_PROG_CPP Message-ID: <64633c22d2a62_171ad991f1b0e410878f3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 5165311b by Ben Gamari at 2023-05-16T04:17:29-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 06aee519 by Ben Gamari at 2023-05-16T04:17:29-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 22 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Error/Codes.hs - configure.ac - docs/users_guide/using-warnings.rst - + libraries/base/GHC/IO/Handle/Text.hs-boot - + libraries/base/GHC/IO/Handle/Types.hs-boot - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Weak.hs - libraries/base/GHC/Weak/Finalize.hs - libraries/base/System/Mem/Weak.hs - libraries/base/changelog.md - rts/sm/HeapAlloc.h - rts/sm/Storage.h - testsuite/tests/linters/notes.stdout - + testsuite/tests/warnings/should_compile/T22702a.hs - + testsuite/tests/warnings/should_compile/T22702a.stderr - + testsuite/tests/warnings/should_compile/T22702b.hs - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -636,6 +636,7 @@ data WarningFlag = | Opt_WarnTypeEqualityRequiresOperators -- Since 9.4 | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 + | Opt_WarnMissingRoleAnnotations -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -742,6 +743,7 @@ warnFlagNames wflag = case wflag of Opt_WarnTypeEqualityOutOfScope -> "type-equality-out-of-scope" :| [] Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] + Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2249,7 +2249,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnGADTMonoLocalBinds, warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, - warnSpec Opt_WarnTermVariableCapture + warnSpec Opt_WarnTermVariableCapture, + warnSpec Opt_WarnMissingRoleAnnotations ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1338,6 +1338,9 @@ instance Diagnostic TcRnMessage where TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) + TcRnMissingRoleAnnotation name roles -> mkSimpleDecorated $ + hang (text "Missing role annotation" <> colon) + 2 (text "type role" <+> ppr name <+> hsep (map ppr roles)) TcRnCapturedTermName tv_name shadowed_term_names -> mkSimpleDecorated $ @@ -2547,6 +2550,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnGhciMonadLookupFail {} -> ErrorWithoutFlag + TcRnMissingRoleAnnotation{} + -> WarningWithFlag Opt_WarnMissingRoleAnnotations diagnosticHints = \case TcRnUnknownMessage m @@ -3226,6 +3231,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnGhciMonadLookupFail {} -> noHints + TcRnMissingRoleAnnotation{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4168,6 +4168,18 @@ data TcRnMessage where -> Maybe [GlobalRdrElt] -- ^ lookup result -> TcRnMessage + {- TcRnMissingRoleAnnotation is a warning that occurs when type declaration + doesn't have a role annotatiosn + + Controlled by flags: + - Wmissing-role-annotations + + Test cases: + T22702 + + -} + TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -4976,9 +4976,13 @@ checkValidRoleAnnots role_annots tc | isVisibleTyConBinder tvb = Just (role, binderVar tvb) | otherwise = Nothing - check_roles - = whenIsJust role_annot_decl_maybe $ - \decl@(L loc (RoleAnnotDecl _ _ the_role_annots)) -> + check_roles = case role_annot_decl_maybe of + Nothing -> + setSrcSpan (getSrcSpan name) $ + -- See Note [Missing role annotations warning] + warnIf (not (isClassTyCon tc) && not (null vis_roles)) $ + TcRnMissingRoleAnnotation name vis_roles + Just (decl@(L loc (RoleAnnotDecl _ _ the_role_annots))) -> addRoleAnnotCtxt name $ setSrcSpanA loc $ do { role_annots_ok <- xoptM LangExt.RoleAnnotations @@ -5001,6 +5005,39 @@ checkValidRoleAnnots role_annots tc check_no_roles = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl +-- Note [Missing role annotations warning] +-- +-- We warn about missing role annotations for tycons +-- 1. not type-classes: +-- type classes are nominal by default, which is most conservative +-- choice. E.g. we cannot have a type-class with an (accidentally) +-- phantom or representational type variable, as we can with +-- data types. +-- 2. with visible roles +-- +-- We don't make any exceptions for other data types. +-- In particular we explicitly warn about omitted (default and common) +-- representational roles. That is the point of the warning. +-- For example the default representational role for `Map`s key type parameter +-- would be wrong, and this warning is there to warn about it, +-- asking users to be explicit. +-- +-- If the default roles have been nominal, i.e. as conservative as possible, +-- the warning would still be valuable, as most types can be `representational` +-- (c.f. type-classes, which usually cannot). +-- +-- We don't warn about types with invisible roles only, because users cannot +-- specify them: +-- +-- type Foo :: forall {k}. Type +-- data Foo = Foo Int +-- type role Foo phantom +-- +-- is incorrect, GHC complains: +-- Wrong number of roles listed in role annotation; +-- Expected 0, got 1: +-- + checkRoleAnnot :: TyVar -> LocatedAn NoEpAnns (Maybe Role) -> Role -> TcM () checkRoleAnnot _ (L _ Nothing) _ = return () checkRoleAnnot tv (L _ (Just r1)) r2 ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -439,6 +439,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnUnexpectedKindVar" = 12875 GhcDiagnosticCode "TcRnNegativeNumTypeLiteral" = 93632 GhcDiagnosticCode "TcRnUnusedQuantifiedTypeVar" = 54180 + GhcDiagnosticCode "TcRnMissingRoleAnnotation" = 65490 GhcDiagnosticCode "TcRnUntickedPromotedThing" = 49957 GhcDiagnosticCode "TcRnIllegalBuiltinSyntax" = 39716 ===================================== configure.ac ===================================== @@ -465,9 +465,6 @@ MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0]) dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS -dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) -AC_PROG_CPP - # --with-hs-cpp/--with-hs-cpp-flags FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2393,6 +2393,28 @@ of ``-W(no-)*``. When :ghc-flag:`-Wterm-variable-capture` is enabled, GHC warns against implicit quantification that would stop working under ``RequiredTypeArguments``. +.. ghc-flag:: -Wmissing-role-annotations + :shortdesc: warn when type declarations don't have role annotations + :type: dynamic + :reverse: -Wno-role-annotations-signatures + :category: + + :since: 9.8 + :default: off + + .. index:: + single: roles, missing + + If you would like GHC to check that every data type definition + has a :ref:`role annotation `, use the + :ghc-flag:`-Wmissing-role-annotations` option. + You can specify the role via :extension:`RoleAnnotations`. + + GHC will not warn about type class definitions with missing role annotations, + as their default roles are the strictest: all nominal. + In other words the type-class role cannot be accidentally left + representational or phantom, which could affected the code correctness. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== libraries/base/GHC/IO/Handle/Text.hs-boot ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Text ( hPutStrLn ) where + +import GHC.Base (String, IO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) + +hPutStrLn :: Handle -> String -> IO () ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Types ( Handle ) where + +data Handle ===================================== libraries/base/GHC/TopHandler.hs ===================================== @@ -84,7 +84,7 @@ runMainIO main = main_thread_id <- myThreadId weak_tid <- mkWeakThreadId main_thread_id - --setFinalizerExceptionHandler printToStderrFinalizerExceptionHandler + --setFinalizerExceptionHandler (printToHandleFinalizerExceptionHandler stderr) -- For the time being, we don't install any exception handler for -- Handle finalization. Instead, the user should set one manually. ===================================== libraries/base/GHC/Weak.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Weak ( -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by -- this handler will be ignored. setFinalizerExceptionHandler, - getFinalizerExceptionHandler + getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler ) where import GHC.Base ===================================== libraries/base/GHC/Weak/Finalize.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Weak.Finalize -- this handler will be ignored. setFinalizerExceptionHandler , getFinalizerExceptionHandler + , printToHandleFinalizerExceptionHandler -- * Internal , runFinalizerBatch ) where @@ -20,6 +21,8 @@ import GHC.Exception import GHC.IORef import {-# SOURCE #-} GHC.Conc.Sync (labelThreadByteArray#, myThreadId) import GHC.IO (catchException, unsafePerformIO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) +import {-# SOURCE #-} GHC.IO.Handle.Text (hPutStrLn) import GHC.Encoding.UTF8 (utf8EncodeByteArray#) data ByteArray = ByteArray ByteArray# @@ -79,3 +82,13 @@ getFinalizerExceptionHandler = readIORef finalizerExceptionHandler -- @since 4.18.0.0 setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO () setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler + +-- | An exception handler for 'Handle' finalization that prints the error to +-- the given 'Handle', but doesn't rethrow it. +-- +-- @since 4.18.0.0 +printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO () +printToHandleFinalizerExceptionHandler hdl se = + hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ()) + where + msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n" ===================================== libraries/base/System/Mem/Weak.hs ===================================== @@ -64,6 +64,15 @@ module System.Mem.Weak ( mkWeakPair, -- replaceFinaliser + -- * Handling exceptions + -- | When an exception is thrown by a finalizer called by the + -- garbage collector, GHC calls a global handler which can be set with + -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by + -- this handler will be ignored. + setFinalizerExceptionHandler, + getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler, + -- * A precise semantics -- $precise ===================================== libraries/base/changelog.md ===================================== @@ -14,6 +14,8 @@ * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) + * Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) + * Add `System.Mem.Weak.printToHandleFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to the given `Handle`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. ===================================== rts/sm/HeapAlloc.h ===================================== @@ -10,6 +10,14 @@ #include "BeginPrivate.h" +#if defined(THREADED_RTS) +// needed for HEAP_ALLOCED below +extern SpinLock gc_alloc_block_sync; +#endif + +#define ACQUIRE_ALLOC_BLOCK_SPIN_LOCK() ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync) +#define RELEASE_ALLOC_BLOCK_SPIN_LOCK() RELEASE_SPIN_LOCK(&gc_alloc_block_sync) + /* ----------------------------------------------------------------------------- The HEAP_ALLOCED() test. ===================================== rts/sm/Storage.h ===================================== @@ -43,15 +43,6 @@ extern Mutex sm_mutex; #define ASSERT_SM_LOCK() #endif -#if defined(THREADED_RTS) -// needed for HEAP_ALLOCED below -extern SpinLock gc_alloc_block_sync; -#endif - -#define ACQUIRE_ALLOC_BLOCK_SPIN_LOCK() ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync) -#define RELEASE_ALLOC_BLOCK_SPIN_LOCK() RELEASE_SPIN_LOCK(&gc_alloc_block_sync) - - /* ----------------------------------------------------------------------------- The write barrier for MVARs and TVARs -------------------------------------------------------------------------- */ ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -34,6 +34,8 @@ ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family i ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] +ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] ===================================== testsuite/tests/warnings/should_compile/T22702a.hs ===================================== @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -Wmissing-role-annotations #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T22702a where + +import Data.Kind (Type) + +-- type with parameters +-- warns +type Foo :: Type -> Type -> Type +data Foo x y = Foo x + +-- type without parameters +-- doesn't warn +data Quu = Quu1 | Quu2 + +-- polykinded type +-- warns, no role for `k` +type Bar :: (k -> Type) -> k -> Type +data Bar f a = Bar (f a) + +-- type-class may have roles as well +-- doesn't warn +class C a where ===================================== testsuite/tests/warnings/should_compile/T22702a.stderr ===================================== @@ -0,0 +1,6 @@ + +T22702a.hs:12:1: warning: [GHC-65490] [-Wmissing-role-annotations] + Missing role annotation: type role Foo representational phantom + +T22702a.hs:21:1: warning: [GHC-65490] [-Wmissing-role-annotations] + Missing role annotation: type role Bar representational nominal ===================================== testsuite/tests/warnings/should_compile/T22702b.hs ===================================== @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -Wmissing-role-annotations #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T22702b where + +import Data.Kind (Type) + +-- type with parameters +type Foo :: Type -> Type -> Type +type role Foo representational phantom +data Foo x y = Foo x + +-- type without parameters +data Quu = Quu1 | Quu2 + +-- polykinded type +type Bar :: (k -> Type) -> k -> Type +type role Bar representational nominal +data Bar f a = Bar (f a) + +-- type-class may have roles as well +class C a where ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -62,3 +62,5 @@ test('T22759', normal, compile, ['']) test('T22676', [extra_files(['src'])], multimod_compile, ['src.hs', '-working-dir src -Wmissing-home-modules -v0']) test('DodgyImports', normal, compile, ['-Wdodgy-imports']) test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) +test('T22702a', normal, compile, ['']) +test('T22702b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f01c89d582ea6650a53dff88103e46eabbdc38ea...06aee51968e65dbd5ca7cb79702cce7b9c7cda18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f01c89d582ea6650a53dff88103e46eabbdc38ea...06aee51968e65dbd5ca7cb79702cce7b9c7cda18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 09:06:10 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 16 May 2023 05:06:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/no-binary-char Message-ID: <646347824de51_171ad99322eba411177c9@gitlab.mail> Zubin pushed new branch wip/no-binary-char at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/no-binary-char You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 09:22:51 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 16 May 2023 05:22:51 -0400 Subject: [Git][ghc/ghc][wip/no-binary-char] compiler: Remove instance Binary Char Message-ID: <64634b6b6198d_171ad99478c14011221cb@gitlab.mail> Zubin pushed to branch wip/no-binary-char at Glasgow Haskell Compiler / GHC Commits: c36c513a by Zubin Duggal at 2023-05-16T14:52:36+05:30 compiler: Remove instance Binary Char It is generally not a good idea to serialise strings as [Char] into interface files, as upon deserialisation each of these would be turned into a highly memory inefficient structure mostly composed of cons cells and pointers. If you really want to serialise a Char, use the SerialisableChar newtype. - - - - - 23 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/DocString.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Fields.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/StgToJS/Object.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Binary/Typeable.hs Changes: ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -153,11 +153,11 @@ instance B.Binary NamePattern where get bh = do tag <- B.get bh case tag :: Word8 of - 0 -> PChar <$> B.get bh <*> B.get bh + 0 -> PChar <$> (B.getSerialisedChar <$> B.get bh) <*> B.get bh 1 -> PWildcard <$> B.get bh 2 -> pure PEnd _ -> panic "Binary(NamePattern): Invalid tag" - put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y + put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh (B.SerialisableChar x) >> B.put_ bh y put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x put_ bh PEnd = B.put_ bh (2 :: Word8) ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -320,7 +320,7 @@ toIfaceCoercionX fr co go_prov :: UnivCoProvenance -> IfaceUnivCoProv go_prov (PhantomProv co) = IfacePhantomProv (go co) go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co) - go_prov (PluginProv str) = IfacePluginProv str + go_prov (PluginProv str) = IfacePluginProv (mkFastString str) go_prov (CorePrepProv b) = IfaceCorePrepProv b toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -290,7 +290,7 @@ instance Ord NonDetFastString where -- representation). Hence it is deterministic from one run to the other. newtype LexicalFastString = LexicalFastString FastString - deriving newtype (Eq, Show) + deriving newtype (Eq, Show, NFData) deriving stock Data instance Ord LexicalFastString where ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Hs.Doc import GHC.Prelude +import GHC.Data.FastString import GHC.Utils.Binary import GHC.Types.Name import GHC.Utils.Outputable as Outputable hiding ((<>)) @@ -40,10 +41,9 @@ import GHC.Driver.Flags import Control.DeepSeq import Data.Data +import Data.Function (on) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap -import Data.Map (Map) -import qualified Data.Map as Map import Data.List.NonEmpty (NonEmpty(..)) import GHC.LanguageExtensions.Type import qualified GHC.Utils.Outputable as O @@ -123,7 +123,7 @@ type LHsDoc pass = Located (HsDoc pass) data DocStructureItem = DsiSectionHeading !Int !(HsDoc GhcRn) | DsiDocChunk !(HsDoc GhcRn) - | DsiNamedChunkRef !(String) + | DsiNamedChunkRef !FastString | DsiExports !Avails | DsiModExport !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple @@ -176,7 +176,7 @@ instance Outputable DocStructureItem where , nest 2 (pprHsDocDebug doc) ] DsiNamedChunkRef name -> - text "reference to named chunk:" <+> text name + text "reference to named chunk:" <+> ftext name DsiExports avails -> text "avails:" $$ nest 2 (ppr avails) DsiModExport mod_names avails -> @@ -202,12 +202,12 @@ data Docs = Docs , docs_args :: UniqMap Name (IntMap (HsDoc GhcRn)) -- ^ Docs for arguments. E.g. function arguments, method arguments. , docs_structure :: DocStructure - , docs_named_chunks :: Map String (HsDoc GhcRn) + , docs_named_chunks :: UniqMap FastString (HsDoc GhcRn) -- ^ Map from chunk name to content. -- -- This map will be empty unless we have an explicit export list from which -- we can reference the chunks. - , docs_haddock_opts :: Maybe String + , docs_haddock_opts :: Maybe FastString -- ^ Haddock options from @OPTIONS_HADDOCK@ or from @-haddock-opts at . , docs_language :: Maybe Language -- ^ The 'Language' used in the module, for example 'Haskell2010'. @@ -227,7 +227,7 @@ instance Binary Docs where put_ bh (sortBy (\a b -> (fst a) `stableNameCmp` fst b) $ nonDetUniqMapToList $ docs_decls docs) put_ bh (sortBy (\a b -> (fst a) `stableNameCmp` fst b) $ nonDetUniqMapToList $ docs_args docs) put_ bh (docs_structure docs) - put_ bh (Map.toList $ docs_named_chunks docs) + put_ bh (sortBy (lexicalCompareFS `on` fst) $ nonDetUniqMapToList $ docs_named_chunks docs) put_ bh (docs_haddock_opts docs) put_ bh (docs_language docs) put_ bh (docs_extensions docs) @@ -236,7 +236,7 @@ instance Binary Docs where decls <- listToUniqMap <$> get bh args <- listToUniqMap <$> get bh structure <- get bh - named_chunks <- Map.fromList <$> get bh + named_chunks <- listToUniqMap <$> get bh haddock_opts <- get bh language <- get bh exts <- get bh @@ -257,7 +257,7 @@ instance Outputable Docs where , pprField (ppr . fmap (ppr . map pprHsDocDebug)) "declaration docs" docs_decls , pprField (ppr . fmap (pprIntMap ppr pprHsDocDebug)) "arg docs" docs_args , pprField (vcat . map ppr) "documentation structure" docs_structure - , pprField (pprMap (doubleQuotes . text) pprHsDocDebug) "named chunks" + , pprField (ppr . fmap (ppr . pprHsDocDebug)) "named chunks" docs_named_chunks , pprField pprMbString "haddock options" docs_haddock_opts , pprField ppr "language" docs_language @@ -268,14 +268,11 @@ instance Outputable Docs where pprField :: (a -> SDoc) -> String -> (Docs -> a) -> SDoc pprField ppr' heading lbl = text heading O.<> colon $$ nest 2 (ppr' (lbl docs)) - pprMap pprKey pprVal m = - vcat $ flip map (Map.toList m) $ \(k, v) -> - pprKey k O.<> colon $$ nest 2 (pprVal v) pprIntMap pprKey pprVal m = vcat $ flip map (IntMap.toList m) $ \(k, v) -> pprKey k O.<> colon $$ nest 2 (pprVal v) pprMbString Nothing = empty - pprMbString (Just s) = text s + pprMbString (Just s) = ftext s pprMaybe ppr' = \case Nothing -> text "Nothing" Just x -> text "Just" <+> ppr' x @@ -286,7 +283,7 @@ emptyDocs = Docs , docs_decls = emptyUniqMap , docs_args = emptyUniqMap , docs_structure = [] - , docs_named_chunks = Map.empty + , docs_named_chunks = emptyUniqMap , docs_haddock_opts = Nothing , docs_language = Nothing , docs_extensions = EnumSet.empty ===================================== compiler/GHC/Hs/DocString.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Hs.DocString import GHC.Prelude +import GHC.Data.FastString import GHC.Utils.Binary import GHC.Utils.Encoding import GHC.Utils.Outputable as Outputable hiding ((<>)) @@ -102,7 +103,7 @@ instance Binary HsDocString where data HsDocStringDecorator = HsDocStringNext -- ^ '|' is the decorator | HsDocStringPrevious -- ^ '^' is the decorator - | HsDocStringNamed !String -- ^ '$' is the decorator + | HsDocStringNamed !LexicalFastString -- ^ '$' is the decorator | HsDocStringGroup !Int -- ^ The decorator is the given number of '*'s deriving (Eq, Ord, Show, Data) @@ -118,7 +119,7 @@ instance NFData HsDocStringDecorator where printDecorator :: HsDocStringDecorator -> String printDecorator HsDocStringNext = "|" printDecorator HsDocStringPrevious = "^" -printDecorator (HsDocStringNamed n) = '$':n +printDecorator (HsDocStringNamed (LexicalFastString n)) = '$':unpackFS n printDecorator (HsDocStringGroup n) = replicate n '*' instance Binary HsDocStringDecorator where ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -12,6 +12,7 @@ module GHC.HsToCore.Docs where import GHC.Prelude import GHC.Data.Bag +import GHC.Data.FastString import GHC.Hs.Binds import GHC.Hs.Doc import GHC.Hs.Decls @@ -86,7 +87,7 @@ extractDocs dflags , docs_args = th_arg_docs `unionArgMaps` arg_map , docs_structure = doc_structure , docs_named_chunks = named_chunks - , docs_haddock_opts = haddockOptions dflags + , docs_haddock_opts = fmap mkFastString $ haddockOptions dflags , docs_language = language_ , docs_extensions = exts } @@ -146,7 +147,7 @@ mkDocStructureFromExportList mdl import_avails export_list = (IEModuleContents _ lmn, avails) -> moduleExport (unLoc lmn) avails (IEGroup _ level doc, _) -> DsiSectionHeading level (unLoc doc) (IEDoc _ doc, _) -> DsiDocChunk (unLoc doc) - (IEDocNamed _ name, _) -> DsiNamedChunkRef name + (IEDocNamed _ name, _) -> DsiNamedChunkRef (mkFastString name) (_, avails) -> DsiExports (nubAvails avails) moduleExport :: ModuleName -- Alias @@ -220,12 +221,12 @@ mkDocStructureFromDecls env all_exports decls = -- since there would be no way to link to a named chunk. getNamedChunks :: Bool -- ^ Do we have an explicit export list? -> HsGroup (GhcPass pass) - -> Map String (HsDoc (GhcPass pass)) + -> UniqMap FastString (HsDoc (GhcPass pass)) getNamedChunks True decls = - M.fromList $ flip mapMaybe (unLoc <$> hs_docs decls) $ \case - DocCommentNamed name doc -> Just (name, unLoc doc) + listToUniqMap $ flip mapMaybe (unLoc <$> hs_docs decls) $ \case + DocCommentNamed name doc -> Just (mkFastString name, unLoc doc) _ -> Nothing -getNamedChunks False _ = M.empty +getNamedChunks False _ = emptyUniqMap -- | Create decl and arg doc-maps by looping through the declarations. -- For each declaration, find its names, its subordinates, and its doc strings. ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -173,7 +173,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do where linkableToUsage (LM _ m uls) = mapM (unlinkedToUsage m) uls - msg m = moduleNameString (moduleName m) ++ "[TH] changed" + msg m = moduleNameFS (moduleName m) `appendFS` fsLit "[TH] changed" fing mmsg fn = UsageFile (mkFastString fn) <$> lookupFileCache fc fn <*> pure mmsg ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -106,12 +106,12 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do (unFixedLength $ binaryInterfaceMagic platform) (unFixedLength magic) -- Check the interface file version and profile tag. - check_ver <- get bh + check_ver <- map getSerialisedChar <$> get bh let our_ver = show hiVersion wantedGot "Version" our_ver check_ver text errorOnMismatch "mismatched interface file versions" our_ver check_ver - check_tag <- get bh + check_tag <- map getSerialisedChar <$> get bh let tag = profileBuildTag profile wantedGot "Way" tag check_tag text when (checkHiWay == CheckHiWay) $ @@ -179,8 +179,8 @@ writeBinIface profile traceBinIface hi_path mod_iface = do put_ bh (binaryInterfaceMagic platform) -- The version, profile tag, and source hash go next - put_ bh (show hiVersion) - let tag = profileBuildTag profile + put_ bh (map SerialisableChar $ show hiVersion) + let tag = map SerialisableChar $ profileBuildTag profile put_ bh tag put_ bh (mi_src_hash mod_iface) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -303,7 +303,7 @@ mkHieFileWithSource src_file src ms ts rs = tcs = tcg_tcs ts (asts',arr) = getCompressedAsts tc_binds rs top_ev_binds insts tcs in HieFile - { hie_hs_file = src_file + { hie_hs_file = mkFastString src_file , hie_module = ms_mod ms , hie_types = arr , hie_asts = asts' ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -32,6 +32,7 @@ import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Unique import GHC.Types.Unique.FM +import Data.Bifunctor (first) import qualified Data.Array as A import qualified Data.Array.IO as A import qualified Data.Array.Unsafe as A @@ -344,7 +345,7 @@ putHieName bh (LocalName occName span) = do put_ bh (occName, BinSrcSpan span) putHieName bh (KnownKeyName uniq) = do putByte bh 2 - put_ bh $ unpkUnique uniq + put_ bh $ (first SerialisableChar $ unpkUnique uniq) getHieName :: BinHandle -> IO HieName getHieName bh = do @@ -358,5 +359,5 @@ getHieName bh = do return $ LocalName occ $ unBinSrcSpan span 2 -> do (c,i) <- get bh - return $ KnownKeyName $ mkUnique c i + return $ KnownKeyName $ mkUnique (getSerialisedChar c) i _ -> panic "GHC.Iface.Ext.Binary.getHieName: invalid tag" ===================================== compiler/GHC/Iface/Ext/Fields.hs ===================================== @@ -15,23 +15,25 @@ where import GHC.Prelude import GHC.Utils.Binary +import GHC.Data.FastString +import GHC.Types.Unique.Map +import Data.Function (on) +import Data.List (sortBy) import Control.Monad -import Data.Map ( Map ) -import qualified Data.Map as Map import Control.DeepSeq -type FieldName = String +type FieldName = FastString -newtype ExtensibleFields = ExtensibleFields { getExtensibleFields :: (Map FieldName BinData) } +newtype ExtensibleFields = ExtensibleFields { getExtensibleFields :: (UniqMap FastString BinData) } instance Binary ExtensibleFields where put_ bh (ExtensibleFields fs) = do - put_ bh (Map.size fs :: Int) + put_ bh (sizeUniqMap fs :: Int) -- Put the names of each field, and reserve a space -- for a payload pointer after each name: - header_entries <- forM (Map.toList fs) $ \(name, dat) -> do + header_entries <- forM (sortBy (lexicalCompareFS `on` fst) $ nonDetUniqMapToList fs) $ \(name, dat) -> do put_ bh name field_p_p <- tellBin bh put_ bh field_p_p @@ -58,13 +60,13 @@ instance Binary ExtensibleFields where dat <- get bh return (name, dat) - return . ExtensibleFields . Map.fromList $ fields + return . ExtensibleFields . listToUniqMap $ fields instance NFData ExtensibleFields where rnf (ExtensibleFields fs) = rnf fs emptyExtensibleFields :: ExtensibleFields -emptyExtensibleFields = ExtensibleFields Map.empty +emptyExtensibleFields = ExtensibleFields emptyUniqMap -------------------------------------------------------------------------------- -- | Reading @@ -74,7 +76,7 @@ readField name = readFieldWith name get readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> - Map.lookup name (getExtensibleFields fields) + lookupUniqMap (getExtensibleFields fields) name -------------------------------------------------------------------------------- -- | Writing @@ -88,7 +90,7 @@ writeFieldWith name write fields = do write bh -- bd <- handleData bh - return $ ExtensibleFields (Map.insert name bd $ getExtensibleFields fields) + return $ ExtensibleFields (addToUniqMap (getExtensibleFields fields) name bd) deleteField :: FieldName -> ExtensibleFields -> ExtensibleFields -deleteField name (ExtensibleFields fs) = ExtensibleFields $ Map.delete name fs +deleteField name (ExtensibleFields fs) = ExtensibleFields $ delFromUniqMap fs name ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -65,7 +65,7 @@ Besides saving compilation cycles, @.hie@ files also offer a more stable interface than the GHC API. -} data HieFile = HieFile - { hie_hs_file :: FilePath + { hie_hs_file :: FastString -- ^ Initial Haskell source file path , hie_module :: Module ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Types.SourceFile import GHC.Types.SafeHaskell import GHC.Types.TypeEnv import GHC.Types.Unique.DSet +import GHC.Types.Unique.Map import GHC.Types.SrcLoc import GHC.Types.TyThing import GHC.Types.PkgQual @@ -109,10 +110,12 @@ import GHC.Unit.Home.ModInfo import GHC.Unit.Finder import GHC.Unit.Env -import GHC.Data.Maybe +import GHC.Data.FastString import Control.Monad -import Data.Map ( toList ) +import Data.List (sortBy) +import Data.Function (on) +import GHC.Data.Maybe import System.FilePath import System.Directory import GHC.Driver.Env.KnotVars @@ -1219,6 +1222,6 @@ pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedVal = ppr target <+> text "annotated by" <+> ppr serialized pprExtensibleFields :: ExtensibleFields -> SDoc -pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ toList fs +pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ sortBy (lexicalCompareFS `on` fst) $ nonDetUniqMapToList fs where - pprField (name, (BinData size _data)) = text name <+> text "-" <+> ppr size <+> text "bytes" + pprField (name, (BinData size _data)) = ftext name <+> text "-" <+> ppr size <+> text "bytes" ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -777,7 +777,7 @@ checkModUsage fc UsageFile{ usg_file_path = file, else return UpToDate where reason = FileChanged $ unpackFS file - recomp = needsRecompileBecause $ fromMaybe reason $ fmap CustomReason mlabel + recomp = needsRecompileBecause $ fromMaybe reason $ fmap (CustomReason . unpackFS) mlabel handler = if debugIsOn then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp else \_ -> return recomp -- if we can't find the file, just recompile, don't fail ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -8,6 +8,7 @@ module GHC.Iface.Recomp.Flags ( , fingerprintHpcFlags ) where +import Data.Bifunctor (first) import GHC.Prelude import GHC.Driver.Session @@ -36,7 +37,8 @@ fingerprintDynFlags :: HscEnv -> Module fingerprintDynFlags hsc_env this_mod nameio = let dflags at DynFlags{..} = hsc_dflags hsc_env - mainis = if mainModIs (hsc_HUE hsc_env) == this_mod then Just mainFunIs else Nothing + serialisableString = map SerialisableChar + mainis = if mainModIs (hsc_HUE hsc_env) == this_mod then Just (fmap serialisableString mainFunIs) else Nothing -- see #5878 -- pkgopts = (homeUnit home_unit, sort $ packageFlags dflags) safeHs = setSafeMode safeHaskell @@ -51,14 +53,14 @@ fingerprintDynFlags hsc_env this_mod nameio = includePathsMinusImplicit = includePaths { includePathsQuoteImplicit = [] } -- -I, -D and -U flags affect CPP - cpp = ( map normalise $ flattenIncludes includePathsMinusImplicit + cpp = ( map (serialisableString . normalise) $ flattenIncludes includePathsMinusImplicit -- normalise: eliminate spurious differences due to "./foo" vs "foo" - , picPOpts dflags - , opt_P_signature dflags) + , map serialisableString $ picPOpts dflags + , first (map serialisableString) $ opt_P_signature dflags) -- See Note [Repeated -optP hashing] -- Note [path flags and recompilation] - paths = [ hcSuf ] + paths = map serialisableString [ hcSuf ] -- -fprof-auto etc. prof = if sccProfilingEnabled dflags then fromEnum profAuto else 0 @@ -102,7 +104,7 @@ fingerprintHpcFlags dflags at DynFlags{..} nameio = let -- -fhpc, see https://gitlab.haskell.org/ghc/ghc/issues/11798 -- hpcDir is output-only, so we should recompile if it changes - hpc = if gopt Opt_Hpc dflags then Just hpcDir else Nothing + hpc = if gopt Opt_Hpc dflags then Just (map SerialisableChar hpcDir) else Nothing in computeFingerprint nameio hpc ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -401,7 +401,7 @@ data IfaceCoercion data IfaceUnivCoProv = IfacePhantomProv IfaceCoercion | IfaceProofIrrelProv IfaceCoercion - | IfacePluginProv String + | IfacePluginProv FastString | IfaceCorePrepProv Bool -- See defn of CorePrepProv {- Note [Holes in IfaceCoercion] @@ -1859,7 +1859,7 @@ pprIfaceUnivCoProv (IfacePhantomProv co) pprIfaceUnivCoProv (IfaceProofIrrelProv co) = text "irrel" <+> pprParendIfaceCoercion co pprIfaceUnivCoProv (IfacePluginProv s) - = text "plugin" <+> doubleQuotes (text s) + = text "plugin" <+> doubleQuotes (ftext s) pprIfaceUnivCoProv (IfaceCorePrepProv _) = text "CorePrep" @@ -1925,7 +1925,7 @@ instance Outputable IfaceTyLit where instance Binary IfaceTyLit where put_ bh (IfaceNumTyLit n) = putByte bh 1 >> put_ bh n put_ bh (IfaceStrTyLit n) = putByte bh 2 >> put_ bh n - put_ bh (IfaceCharTyLit n) = putByte bh 3 >> put_ bh n + put_ bh (IfaceCharTyLit n) = putByte bh 3 >> put_ bh (SerialisableChar n) get bh = do tag <- getByte bh @@ -1935,7 +1935,7 @@ instance Binary IfaceTyLit where 2 -> do { n <- get bh ; return (IfaceStrTyLit n) } 3 -> do { n <- get bh - ; return (IfaceCharTyLit n) } + ; return (IfaceCharTyLit $ getSerialisedChar n) } _ -> panic ("get IfaceTyLit " ++ show tag) instance Binary IfaceAppArgs where ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1519,7 +1519,7 @@ tcIfaceCo = go tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance tcIfaceUnivCoProv (IfacePhantomProv kco) = PhantomProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco -tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv str +tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv (unpackFS str) tcIfaceUnivCoProv (IfaceCorePrepProv b) = return $ CorePrepProv b {- ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -1517,7 +1517,7 @@ mkHdkCommentPrev loc mkDS = (HdkCommentPrev ds,ITdocComment ds loc) mkHdkCommentNamed :: PsSpan -> String -> (HsDocStringDecorator -> HsDocString) -> (HdkComment, Token) mkHdkCommentNamed loc name mkDS = (HdkCommentNamed name ds, ITdocComment ds loc) - where ds = mkDS (HsDocStringNamed name) + where ds = mkDS (HsDocStringNamed $ LexicalFastString $ mkFastString name) mkHdkCommentSection :: PsSpan -> Int -> (HsDocStringDecorator -> HsDocString) -> (HdkComment, Token) mkHdkCommentSection loc n mkDS = (HdkCommentSection n ds, ITdocComment ds loc) ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -227,12 +227,12 @@ putObject -> IO () putObject bh mod_name deps os = do forM_ magic (putByte bh . fromIntegral . ord) - put_ bh (show hiVersion) + put_ bh (map SerialisableChar $ show hiVersion) -- we store the module name as a String because we don't want to have to -- decode the FastString table just to decode it when we're looking for an -- object in an archive. - put_ bh (moduleNameString mod_name) + put_ bh (moduleNameFS mod_name) (bh_fs, _bin_dict, put_dict) <- initFSTable bh @@ -281,12 +281,12 @@ getObjectHeader bh = do case is_magic of False -> pure (Left "invalid magic header") True -> do - is_correct_version <- ((== hiVersion) . read) <$> get bh + is_correct_version <- ((== hiVersion) . read . map getSerialisedChar) <$> get bh case is_correct_version of False -> pure (Left "invalid header version") True -> do mod_name <- get bh - pure (Right (mkModuleName (mod_name))) + pure (Right (mkModuleNameFS mod_name)) -- | Parse object body. Must be called after a sucessful getObjectHeader ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -254,7 +254,7 @@ for more details. -} instance Binary Literal where - put_ bh (LitChar aa) = do putByte bh 0; put_ bh aa + put_ bh (LitChar aa) = do putByte bh 0; put_ bh $ SerialisableChar aa put_ bh (LitString ab) = do putByte bh 1; put_ bh ab put_ bh (LitNullAddr) = putByte bh 2 put_ bh (LitFloat ah) = do putByte bh 3; put_ bh ah @@ -276,7 +276,7 @@ instance Binary Literal where case h of 0 -> do aa <- get bh - return (LitChar aa) + return (LitChar $ getSerialisedChar aa) 1 -> do ab <- get bh return (LitString ab) ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -283,7 +283,7 @@ data Usage usg_file_hash :: Fingerprint, -- ^ 'Fingerprint' of the file contents. - usg_file_label :: Maybe String + usg_file_label :: Maybe FastString -- ^ An optional string which is used in recompilation messages if -- file in question has changed. ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -81,7 +83,7 @@ module GHC.Utils.Binary FSTable, initFSTable, getDictFastString, putDictFastString, -- * Newtype wrappers - BinSpan(..), BinSrcSpan(..), BinLocated(..) + BinSpan(..), BinSrcSpan(..), BinLocated(..), SerialisableChar(..) ) where import GHC.Prelude @@ -125,6 +127,8 @@ import qualified Data.IntMap as IntMap import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif +import GHC.TypeError + type BinArray = ForeignPtr Word8 #if !MIN_VERSION_base(4,15,0) @@ -675,9 +679,20 @@ instance Binary Bool where put_ bh b = putByte bh (fromIntegral (fromEnum b)) get bh = do x <- getWord8 bh; return $! (toEnum (fromIntegral x)) -instance Binary Char where - put_ bh c = put_ bh (fromIntegral (ord c) :: Word32) - get bh = do x <- get bh; return $! (chr (fromIntegral (x :: Word32))) +instance (TypeError (Text "No instance for Binary Char" + :$$: Text "We don't want to serialise Strings into interface files" + :$$: Text "Use a compact representation like " :<>: ShowType FastString :<>: Text " instead" + :$$: Text "If you really want to serialise you can use " :<>: ShowType SerialisableChar) + ) + => Binary Char where + put_ = undefined + get = undefined + +newtype SerialisableChar = SerialisableChar { getSerialisedChar :: Char } + +instance Binary SerialisableChar where + put_ bh (SerialisableChar c) = put_ bh (fromIntegral (ord c) :: Word32) + get bh = do x <- get bh; return $! (SerialisableChar $ chr (fromIntegral (x :: Word32))) instance Binary Int where put_ bh i = put_ bh (fromIntegral i :: Int64) ===================================== compiler/GHC/Utils/Binary/Typeable.hs ===================================== @@ -17,6 +17,7 @@ where import GHC.Prelude import GHC.Utils.Binary +import GHC.Data.FastString import GHC.Exts (RuntimeRep(..), VecCount(..), VecElem(..)) #if __GLASGOW_HASKELL__ >= 901 @@ -32,13 +33,13 @@ import Data.Kind (Type) instance Binary TyCon where put_ bh tc = do - put_ bh (tyConPackage tc) - put_ bh (tyConModule tc) - put_ bh (tyConName tc) + put_ bh (mkFastString $ tyConPackage tc) + put_ bh (mkFastString $ tyConModule tc) + put_ bh (mkFastString $ tyConName tc) put_ bh (tyConKindArgs tc) put_ bh (tyConKindRep tc) get bh = - mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh + mkTyCon <$> (unpackFS <$> get bh) <*> (unpackFS <$> get bh) <*> (unpackFS <$> get bh) <*> get bh <*> get bh getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do @@ -157,7 +158,7 @@ instance Binary KindRep where put_ bh (KindRepApp a b) = putByte bh 2 >> put_ bh a >> put_ bh b put_ bh (KindRepFun a b) = putByte bh 3 >> put_ bh a >> put_ bh b put_ bh (KindRepTYPE r) = putByte bh 4 >> put_ bh r - put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh r + put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh (mkFastString r) get bh = do tag <- getByte bh @@ -167,7 +168,7 @@ instance Binary KindRep where 2 -> KindRepApp <$> get bh <*> get bh 3 -> KindRepFun <$> get bh <*> get bh 4 -> KindRepTYPE <$> get bh - 5 -> KindRepTypeLit <$> get bh <*> get bh + 5 -> KindRepTypeLit <$> get bh <*> (unpackFS <$> get bh) _ -> fail "Binary.putKindRep: invalid tag" instance Binary TypeLitSort where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c36c513a9ea619ad7cb0f1c8f22de0407178affe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c36c513a9ea619ad7cb0f1c8f22de0407178affe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 11:12:46 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 May 2023 07:12:46 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Switch off the ambiguity check properly Message-ID: <6463652e546a4_171ad996a5eec0116686c@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: b34a3d9f by Simon Peyton Jones at 2023-05-16T11:06:05+01:00 Switch off the ambiguity check properly Needs more documentation - - - - - 9 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Validity.hs - testsuite/tests/gadt/T3651.hs - testsuite/tests/pmcheck/should_compile/T15450.hs - testsuite/tests/typecheck/should_fail/GivenForallLoop.hs - testsuite/tests/typecheck/should_fail/T20189.hs Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1759,7 +1759,7 @@ reportEqErr ctxt item ty1 ty2 , mismatchAmbiguityInfo = eqInfos , mismatchCoercibleInfo = mb_coercible_info } where - mismatch = misMatchOrCND False ctxt item ty1 ty2 + mismatch = misMatchOrCND ctxt item ty1 ty2 eqInfos = eqInfoMsgs ty1 ty2 coercible_msg :: TcType -> TcType -> TcM (Maybe CoercibleMsg) @@ -1907,7 +1907,7 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 -- Consider an ambiguous top-level constraint (a ~ F a) -- Not an occurs check, because F is a type function. where - headline_msg = misMatchOrCND insoluble_occurs_check ctxt item ty1 ty2 + headline_msg = misMatchOrCND ctxt item ty1 ty2 mismatch_msg = mkMismatchMsg item ty1 ty2 add_sig = maybeToList $ suggestAddSig ctxt ty1 ty2 @@ -1936,8 +1936,6 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 Just (NonCanonicalReason result) -> result _ -> cteOK - insoluble_occurs_check = check_eq_result `cterHasProblem` cteInsolubleOccurs - eqInfoMsgs :: TcType -> TcType -> [AmbiguityInfo] -- Report (a) ambiguity if either side is a type function application -- e.g. F a0 ~ Int @@ -1971,11 +1969,11 @@ eqInfoMsgs ty1 ty2 | otherwise = Nothing -misMatchOrCND :: Bool -> SolverReportErrCtxt -> ErrorItem +misMatchOrCND :: SolverReportErrCtxt -> ErrorItem -> TcType -> TcType -> MismatchMsg -- If oriented then ty1 is actual, ty2 is expected -misMatchOrCND insoluble_occurs_check ctxt item ty1 ty2 - | insoluble_occurs_check -- See Note [Insoluble occurs check] +misMatchOrCND ctxt item ty1 ty2 + | insoluble_item -- See Note [Insoluble mis-match] || (isRigidTy ty1 && isRigidTy ty2) || (ei_flavour item == Given) || null givens @@ -1987,6 +1985,10 @@ misMatchOrCND insoluble_occurs_check ctxt item ty1 ty2 = CouldNotDeduce givens (item :| []) (Just $ CND_Extra level ty1 ty2) where + insoluble_item = case ei_m_reason item of + Nothing -> False + Just r -> isInsolubleReason r + level = ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel givens = [ given | given <- getUserGivens ctxt, ic_given_eqs given /= NoGivenEqs ] -- Keep only UserGivens that have some equalities. @@ -2144,8 +2146,8 @@ shouldPprWithExplicitKinds _ty1 _ty2 (TypeEqOrigin { uo_actual = act shouldPprWithExplicitKinds ty1 ty2 _ct = tcEqTypeVis ty1 ty2 -{- Note [Insoluble occurs check] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Insoluble mis-match] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider [G] a ~ [a], [W] a ~ [a] (#13674). The Given is insoluble so we don't use it for rewriting. The Wanted is also insoluble, and we don't solve it from the Given. It's very confusing to say @@ -2154,7 +2156,9 @@ we don't solve it from the Given. It's very confusing to say And indeed even thinking about the Givens is silly; [W] a ~ [a] is just as insoluble as Int ~ Bool. -Conclusion: if there's an insoluble occurs check (cteInsolubleOccurs) +Exactly the same is true if we have [G] Int ~ Bool, [W] Int ~ Bool. + +Conclusion: if there's an insoluble constraint (isInsolubleReason), then report it directly, not in the "cannot deduce X from Y" form. This is done in misMatchOrCND (via the insoluble_occurs_check arg) ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -79,10 +79,6 @@ solveDictNC :: CtEvidence -> Class -> [Type] -> SolverStage Void -- NC: this comes from CNonCanonical or CIrredCan -- Precondition: already rewritten by inert set solveDictNC ev cls tys - | isEqualityClass cls - = solveEqualityDict ev cls tys - - | otherwise = do { simpleStage $ traceTcS "solveDictNC" (ppr (mkClassPred cls tys) $$ ppr ev) ; dict_ct <- canDictCt ev cls tys ; solveDict dict_ct } @@ -90,6 +86,10 @@ solveDictNC ev cls tys solveDict :: DictCt -> SolverStage Void -- Preconditions: `tys` are already rewritten by the inert set solveDict dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys = tys }) + | isEqualityClass cls + = solveEqualityDict ev cls tys + + | otherwise = assertPpr (ctEvRole ev == Nominal) (ppr ev $$ ppr cls $$ ppr tys) $ do { simpleStage $ traceTcS "solveDict" (ppr dict_ct) @@ -1949,11 +1949,16 @@ mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -- nor are repeated -- The caller of this function is supposed to perform fuel book keeping -- Precondition: fuel >= 0 -mk_strict_superclasses fuel rec_clss ev@(CtGiven { ctev_evar = evar, ctev_loc = loc }) +mk_strict_superclasses _ _ _ _ _ cls _ + | isEqualityClass cls + = return [] + +mk_strict_superclasses fuel rec_clss + ev@(CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys - = do { traceTcS "mk_strict" (ppr ev $$ ppr (ctLocOrigin loc)) - ; concatMapM do_one_given $ - classSCSelIds cls } + = -- Given case + do { traceTcS "mk_strict" (ppr ev $$ ppr (ctLocOrigin loc)) + ; concatMapM do_one_given (classSCSelIds cls) } where dict_ids = mkTemplateLocals theta this_size = pSizeClassPred cls tys @@ -2020,6 +2025,7 @@ mk_strict_superclasses fuel rec_clss ev@(CtGiven { ctev_evar = evar, ctev_loc = newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False +-- Wanted case mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. @@ -2087,7 +2093,9 @@ mk_superclasses_of fuel rec_clss ev tvs theta cls tys loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm + mk_this_ct :: ExpansionFuel -> Ct + -- We can't use CNonCanonical here because we need to tradk the fuel mk_this_ct fuel | null tvs, null theta = CDictCan (DictCt { di_ev = ev, di_cls = cls , di_tys = tys, di_pend_sc = fuel }) @@ -2095,8 +2103,7 @@ mk_superclasses_of fuel rec_clss ev tvs theta cls tys -- added the superclasses, hence cc_pend_sc = fuel | otherwise = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys - , qci_ev = ev - , qci_pend_sc = fuel }) + , qci_ev = ev, qci_pend_sc = fuel }) {- Note [Equality superclasses in quantified constraints] ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -68,7 +68,7 @@ try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) -- See Note [Multiple matching irreds] , let ev_i = irredCtEvidence irred_i ct_i = CIrredCan irred_i - , not (isInsolubleReason reason && isWanted ev_i && isWanted ev_w) + , not (isInsolubleReason reason && (isWanted ev_i || isWanted ev_w)) -- See Note [Insoluble irreds] = do { traceTcS "iteractIrred" $ vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) @@ -106,9 +106,9 @@ once had done). This problem can be tickled by typecheck/should_compile/holes. Note [Insoluble irreds] ~~~~~~~~~~~~~~~~~~~~~~~ -For insoluble Wanteds, don't allow a duplicate Wanted to be dropped which -can happen with solveOneFromTheOther, so that we get distinct error messages -with -fdefer-type-errors +We don't allow an /insoluble/ Wanted to be dropped, even if there is an identical +(insoluble) Given or Wanated. We want to keep all the insoluble Wanteds distinct, +so that we get distinct error messages with -fdefer-type-errors However we do allow an insoluble constraint to be solved from an insoluble Given. This might seem a little odd, but it's very much a corner case, and ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -221,7 +221,7 @@ data StopOrContinue a deriving (Functor) instance Outputable a => Outputable (StopOrContinue a) where - ppr (Stop ev s) = text "Stop" <> parens s <+> ppr ev + ppr (Stop ev s) = text "Stop" <> parens (s $$ text "ev:" <+> ppr ev) ppr (ContinueWith w) = text "ContinueWith" <+> ppr w ppr (StartAgain w) = text "StartAgain" <+> ppr w ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -237,12 +237,13 @@ checkAmbiguity ctxt ty -- can cause a cascade of further errors. Since the free -- tyvars are skolemised, we can safely use tcSimplifyTop ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes - ; (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $ + ; unless allow_ambiguous $ + do { (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $ captureConstraints $ tcSubTypeAmbiguity ctxt ty ty -- See Note [Ambiguity check and deep subsumption] -- in GHC.Tc.Utils.Unify - ; simplifyAmbiguityCheck ty wanted + ; simplifyAmbiguityCheck ty wanted } ; traceTc "Done ambiguity check for" (ppr ty) } ===================================== testsuite/tests/gadt/T3651.hs ===================================== @@ -10,6 +10,19 @@ data Z a where unsafe1 :: Z a -> Z a -> a unsafe1 B U = () +{- For unsafe1 we get: + + [G] a ~ () => [G] a ~ Bool => [W] Bool ~ a + +By the time we get to the Wanted we have: + inert: [G] a ~ Bool (CEqCan) + [G] () ~ Bool (CIrredCan) + work: [W] Bool ~ a + +We rewrite with the CEqCan to get [W] Bool ~ (), which is +insoluble, and which we decline to solve from [G] () ~ Bool +-} + unsafe2 :: a ~ b => Z b -> Z a -> a unsafe2 B U = () ===================================== testsuite/tests/pmcheck/should_compile/T15450.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE EmptyCase #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -- To avoid rejecting the inaccessible types + module T15450 where f :: (Int ~ Bool) => Bool -> a ===================================== testsuite/tests/typecheck/should_fail/GivenForallLoop.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies, ImpredicativeTypes #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -- Allow insoluble signature for loopy module GivenForallLoop where ===================================== testsuite/tests/typecheck/should_fail/T20189.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -- Dodgy: allow the strange (illegal) signature module T20189 where y :: (t ~ (forall x . Show x => x -> IO ())) => t View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b34a3d9fdad8b665422a1b4bbf1ef54b64b609cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b34a3d9fdad8b665422a1b4bbf1ef54b64b609cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 11:28:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 07:28:10 -0400 Subject: [Git][ghc/ghc][master] Add -Wmissing-role-annotations Message-ID: <646368ca1f412_171ad999136c1411792a8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 12 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/using-warnings.rst - testsuite/tests/linters/notes.stdout - + testsuite/tests/warnings/should_compile/T22702a.hs - + testsuite/tests/warnings/should_compile/T22702a.stderr - + testsuite/tests/warnings/should_compile/T22702b.hs - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -636,6 +636,7 @@ data WarningFlag = | Opt_WarnTypeEqualityRequiresOperators -- Since 9.4 | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 + | Opt_WarnMissingRoleAnnotations -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -742,6 +743,7 @@ warnFlagNames wflag = case wflag of Opt_WarnTypeEqualityOutOfScope -> "type-equality-out-of-scope" :| [] Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] + Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2249,7 +2249,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnGADTMonoLocalBinds, warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, - warnSpec Opt_WarnTermVariableCapture + warnSpec Opt_WarnTermVariableCapture, + warnSpec Opt_WarnMissingRoleAnnotations ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1338,6 +1338,9 @@ instance Diagnostic TcRnMessage where TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) + TcRnMissingRoleAnnotation name roles -> mkSimpleDecorated $ + hang (text "Missing role annotation" <> colon) + 2 (text "type role" <+> ppr name <+> hsep (map ppr roles)) TcRnCapturedTermName tv_name shadowed_term_names -> mkSimpleDecorated $ @@ -2547,6 +2550,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnGhciMonadLookupFail {} -> ErrorWithoutFlag + TcRnMissingRoleAnnotation{} + -> WarningWithFlag Opt_WarnMissingRoleAnnotations diagnosticHints = \case TcRnUnknownMessage m @@ -3226,6 +3231,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnGhciMonadLookupFail {} -> noHints + TcRnMissingRoleAnnotation{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4168,6 +4168,18 @@ data TcRnMessage where -> Maybe [GlobalRdrElt] -- ^ lookup result -> TcRnMessage + {- TcRnMissingRoleAnnotation is a warning that occurs when type declaration + doesn't have a role annotatiosn + + Controlled by flags: + - Wmissing-role-annotations + + Test cases: + T22702 + + -} + TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -4976,9 +4976,13 @@ checkValidRoleAnnots role_annots tc | isVisibleTyConBinder tvb = Just (role, binderVar tvb) | otherwise = Nothing - check_roles - = whenIsJust role_annot_decl_maybe $ - \decl@(L loc (RoleAnnotDecl _ _ the_role_annots)) -> + check_roles = case role_annot_decl_maybe of + Nothing -> + setSrcSpan (getSrcSpan name) $ + -- See Note [Missing role annotations warning] + warnIf (not (isClassTyCon tc) && not (null vis_roles)) $ + TcRnMissingRoleAnnotation name vis_roles + Just (decl@(L loc (RoleAnnotDecl _ _ the_role_annots))) -> addRoleAnnotCtxt name $ setSrcSpanA loc $ do { role_annots_ok <- xoptM LangExt.RoleAnnotations @@ -5001,6 +5005,39 @@ checkValidRoleAnnots role_annots tc check_no_roles = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl +-- Note [Missing role annotations warning] +-- +-- We warn about missing role annotations for tycons +-- 1. not type-classes: +-- type classes are nominal by default, which is most conservative +-- choice. E.g. we cannot have a type-class with an (accidentally) +-- phantom or representational type variable, as we can with +-- data types. +-- 2. with visible roles +-- +-- We don't make any exceptions for other data types. +-- In particular we explicitly warn about omitted (default and common) +-- representational roles. That is the point of the warning. +-- For example the default representational role for `Map`s key type parameter +-- would be wrong, and this warning is there to warn about it, +-- asking users to be explicit. +-- +-- If the default roles have been nominal, i.e. as conservative as possible, +-- the warning would still be valuable, as most types can be `representational` +-- (c.f. type-classes, which usually cannot). +-- +-- We don't warn about types with invisible roles only, because users cannot +-- specify them: +-- +-- type Foo :: forall {k}. Type +-- data Foo = Foo Int +-- type role Foo phantom +-- +-- is incorrect, GHC complains: +-- Wrong number of roles listed in role annotation; +-- Expected 0, got 1: +-- + checkRoleAnnot :: TyVar -> LocatedAn NoEpAnns (Maybe Role) -> Role -> TcM () checkRoleAnnot _ (L _ Nothing) _ = return () checkRoleAnnot tv (L _ (Just r1)) r2 ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -439,6 +439,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnUnexpectedKindVar" = 12875 GhcDiagnosticCode "TcRnNegativeNumTypeLiteral" = 93632 GhcDiagnosticCode "TcRnUnusedQuantifiedTypeVar" = 54180 + GhcDiagnosticCode "TcRnMissingRoleAnnotation" = 65490 GhcDiagnosticCode "TcRnUntickedPromotedThing" = 49957 GhcDiagnosticCode "TcRnIllegalBuiltinSyntax" = 39716 ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2393,6 +2393,28 @@ of ``-W(no-)*``. When :ghc-flag:`-Wterm-variable-capture` is enabled, GHC warns against implicit quantification that would stop working under ``RequiredTypeArguments``. +.. ghc-flag:: -Wmissing-role-annotations + :shortdesc: warn when type declarations don't have role annotations + :type: dynamic + :reverse: -Wno-role-annotations-signatures + :category: + + :since: 9.8 + :default: off + + .. index:: + single: roles, missing + + If you would like GHC to check that every data type definition + has a :ref:`role annotation `, use the + :ghc-flag:`-Wmissing-role-annotations` option. + You can specify the role via :extension:`RoleAnnotations`. + + GHC will not warn about type class definitions with missing role annotations, + as their default roles are the strictest: all nominal. + In other words the type-class role cannot be accidentally left + representational or phantom, which could affected the code correctness. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -34,6 +34,8 @@ ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family i ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] +ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] ===================================== testsuite/tests/warnings/should_compile/T22702a.hs ===================================== @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -Wmissing-role-annotations #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T22702a where + +import Data.Kind (Type) + +-- type with parameters +-- warns +type Foo :: Type -> Type -> Type +data Foo x y = Foo x + +-- type without parameters +-- doesn't warn +data Quu = Quu1 | Quu2 + +-- polykinded type +-- warns, no role for `k` +type Bar :: (k -> Type) -> k -> Type +data Bar f a = Bar (f a) + +-- type-class may have roles as well +-- doesn't warn +class C a where ===================================== testsuite/tests/warnings/should_compile/T22702a.stderr ===================================== @@ -0,0 +1,6 @@ + +T22702a.hs:12:1: warning: [GHC-65490] [-Wmissing-role-annotations] + Missing role annotation: type role Foo representational phantom + +T22702a.hs:21:1: warning: [GHC-65490] [-Wmissing-role-annotations] + Missing role annotation: type role Bar representational nominal ===================================== testsuite/tests/warnings/should_compile/T22702b.hs ===================================== @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -Wmissing-role-annotations #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T22702b where + +import Data.Kind (Type) + +-- type with parameters +type Foo :: Type -> Type -> Type +type role Foo representational phantom +data Foo x y = Foo x + +-- type without parameters +data Quu = Quu1 | Quu2 + +-- polykinded type +type Bar :: (k -> Type) -> k -> Type +type role Bar representational nominal +data Bar f a = Bar (f a) + +-- type-class may have roles as well +class C a where ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -62,3 +62,5 @@ test('T22759', normal, compile, ['']) test('T22676', [extra_files(['src'])], multimod_compile, ['src.hs', '-working-dir src -Wmissing-home-modules -v0']) test('DodgyImports', normal, compile, ['-Wdodgy-imports']) test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) +test('T22702a', normal, compile, ['']) +test('T22702b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bdb93cd28f4a40e9a9f28b0976ca8fa4f250cad2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bdb93cd28f4a40e9a9f28b0976ca8fa4f250cad2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 11:28:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 07:28:42 -0400 Subject: [Git][ghc/ghc][master] 2 commits: base: Export {get,set}ExceptionFinalizer from System.Mem.Weak Message-ID: <646368eaa8d34_171ad999550f3411835a7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 7 changed files: - + libraries/base/GHC/IO/Handle/Text.hs-boot - + libraries/base/GHC/IO/Handle/Types.hs-boot - libraries/base/GHC/TopHandler.hs - libraries/base/GHC/Weak.hs - libraries/base/GHC/Weak/Finalize.hs - libraries/base/System/Mem/Weak.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/IO/Handle/Text.hs-boot ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Text ( hPutStrLn ) where + +import GHC.Base (String, IO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) + +hPutStrLn :: Handle -> String -> IO () ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Types ( Handle ) where + +data Handle ===================================== libraries/base/GHC/TopHandler.hs ===================================== @@ -84,7 +84,7 @@ runMainIO main = main_thread_id <- myThreadId weak_tid <- mkWeakThreadId main_thread_id - --setFinalizerExceptionHandler printToStderrFinalizerExceptionHandler + --setFinalizerExceptionHandler (printToHandleFinalizerExceptionHandler stderr) -- For the time being, we don't install any exception handler for -- Handle finalization. Instead, the user should set one manually. ===================================== libraries/base/GHC/Weak.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Weak ( -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by -- this handler will be ignored. setFinalizerExceptionHandler, - getFinalizerExceptionHandler + getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler ) where import GHC.Base ===================================== libraries/base/GHC/Weak/Finalize.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Weak.Finalize -- this handler will be ignored. setFinalizerExceptionHandler , getFinalizerExceptionHandler + , printToHandleFinalizerExceptionHandler -- * Internal , runFinalizerBatch ) where @@ -20,6 +21,8 @@ import GHC.Exception import GHC.IORef import {-# SOURCE #-} GHC.Conc.Sync (labelThreadByteArray#, myThreadId) import GHC.IO (catchException, unsafePerformIO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) +import {-# SOURCE #-} GHC.IO.Handle.Text (hPutStrLn) import GHC.Encoding.UTF8 (utf8EncodeByteArray#) data ByteArray = ByteArray ByteArray# @@ -79,3 +82,13 @@ getFinalizerExceptionHandler = readIORef finalizerExceptionHandler -- @since 4.18.0.0 setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO () setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler + +-- | An exception handler for 'Handle' finalization that prints the error to +-- the given 'Handle', but doesn't rethrow it. +-- +-- @since 4.18.0.0 +printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO () +printToHandleFinalizerExceptionHandler hdl se = + hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ()) + where + msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n" ===================================== libraries/base/System/Mem/Weak.hs ===================================== @@ -64,6 +64,15 @@ module System.Mem.Weak ( mkWeakPair, -- replaceFinaliser + -- * Handling exceptions + -- | When an exception is thrown by a finalizer called by the + -- garbage collector, GHC calls a global handler which can be set with + -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by + -- this handler will be ignored. + setFinalizerExceptionHandler, + getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler, + -- * A precise semantics -- $precise ===================================== libraries/base/changelog.md ===================================== @@ -14,6 +14,8 @@ * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) + * Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) + * Add `System.Mem.Weak.printToHandleFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to the given `Handle`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdb93cd28f4a40e9a9f28b0976ca8fa4f250cad2...67330303714ab64751e538f318932a70c36392b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdb93cd28f4a40e9a9f28b0976ca8fa4f250cad2...67330303714ab64751e538f318932a70c36392b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 11:30:14 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 16 May 2023 07:30:14 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <64636946ef501_171ad9990adfa41184193@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 5afb3d3a by Ben Gamari at 2023-05-16T15:29:59+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - + docs/users_guide/exts/implicit_forall.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/exts/type_signatures.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.stderr - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5afb3d3a021aa519bb5accc2be5984ae03b0f617 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5afb3d3a021aa519bb5accc2be5984ae03b0f617 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 11:56:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 16 May 2023 07:56:22 -0400 Subject: [Git][ghc/ghc][wip/backports-9.6] 9 commits: docs: Generate docs/index.html with version number Message-ID: <64636f66720f7_171ad99a48b71011893e0@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: f70b9c49 by Matthew Pickering at 2023-05-16T07:56:09-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 (cherry picked from commit d7a768a415c3bd575a20b20ae9a3953aa5886ed7) - - - - - 6cd0f807 by Simon Peyton Jones at 2023-05-16T07:56:09-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 (cherry picked from commit 3b0ea4809d92581a10e0e501a6fbd7339e8922bf) - - - - - 5637364e by Ben Gamari at 2023-05-16T07:56:09-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 (cherry picked from commit d1bb16ed3e18a4f41fcfe31f0bf57dbaf589d6c5) - - - - - 373ec872 by Krzysztof Gogolewski at 2023-05-16T07:56:09-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). (cherry picked from commit 7c16f3be6e1ac92f87d752f12ad6c6e7b7fd6207) - - - - - ab677901 by Ben Gamari at 2023-05-16T07:56:09-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. (cherry picked from commit b8d783d24b9a617ad1e3038abeb75d322703ef65) - - - - - 7083db5a by Sylvain Henry at 2023-05-16T07:56:09-04:00 JS: fix thread-related primops (cherry picked from commit d442ac053f9ac7dbcc32318802daf686f377fe3d) - - - - - 35131c9d by Ben Gamari at 2023-05-16T07:56:09-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 (cherry picked from commit 52d3e9b4189440d26bad9c5a15f9420b67b1ca5b) - - - - - ac639721 by Ben Gamari at 2023-05-16T07:56:09-04:00 testsuite: Add test for #23071 (cherry picked from commit 1db30fe1dd38dd8ffedfadf3845706fcde02933b) - - - - - 1fdbbd8d by sheaf at 2023-05-16T07:56:09-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 (cherry picked from commit df1a581188694479a583270548896245fc23b525) - - - - - 22 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Utils/TcType.hs - docs/index.html → docs/index.html.in - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - libraries/base/tests/all.T - + libraries/base/tests/listThreads1.hs - + libraries/base/tests/listThreads1.stdout - rts/Threads.c - rts/include/rts/storage/ClosureMacros.h - rts/js/mem.js - rts/js/thread.js - + testsuite/tests/primops/should_run/T23071.hs - testsuite/tests/primops/should_run/all.T - + testsuite/tests/simplCore/should_run/T23134.hs - + testsuite/tests/simplCore/should_run/T23134.stdout - testsuite/tests/simplCore/should_run/all.T - + testsuite/tests/typecheck/should_compile/T23171.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NumericUnderscores #-} module GHC.CmmToAsm.AArch64.CodeGen ( cmmTopCodeGen , generateJumpTableForInstr @@ -773,12 +772,12 @@ getRegister' config plat expr return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) -- 3. Logic &&, || - CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (AND (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg @@ -963,19 +962,6 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) - -- This needs to check if n can be encoded as a bitmask immediate: - -- - -- See https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly - -- - isBitMaskImmediate :: Integer -> Bool - isBitMaskImmediate i = i `elem` [0b0000_0001, 0b0000_0010, 0b0000_0100, 0b0000_1000, 0b0001_0000, 0b0010_0000, 0b0100_0000, 0b1000_0000 - ,0b0000_0011, 0b0000_0110, 0b0000_1100, 0b0001_1000, 0b0011_0000, 0b0110_0000, 0b1100_0000 - ,0b0000_0111, 0b0000_1110, 0b0001_1100, 0b0011_1000, 0b0111_0000, 0b1110_0000 - ,0b0000_1111, 0b0001_1110, 0b0011_1100, 0b0111_1000, 0b1111_0000 - ,0b0001_1111, 0b0011_1110, 0b0111_1100, 0b1111_1000 - ,0b0011_1111, 0b0111_1110, 0b1111_1100 - ,0b0111_1111, 0b1111_1110 - ,0b1111_1111] -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register @@ -1018,6 +1004,39 @@ getRegister' config plat expr CMP (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) `snocOL` CSET (OpReg w dst) NE) +-- | Is a given number encodable as a bitmask immediate? +-- +-- https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly +isAArch64Bitmask :: Integer -> Bool +-- N.B. zero and ~0 are not encodable as bitmask immediates +isAArch64Bitmask 0 = False +isAArch64Bitmask n + | n == bit 64 - 1 = False +isAArch64Bitmask n = + check 64 || check 32 || check 16 || check 8 + where + -- Check whether @n@ can be represented as a subpattern of the given + -- width. + check width + | hasOneRun subpat = + let n' = fromIntegral (mkPat width subpat) + in n == n' + | otherwise = False + where + subpat :: Word64 + subpat = fromIntegral (n .&. (bit width - 1)) + + -- Construct a bit-pattern from a repeated subpatterns the given width. + mkPat :: Int -> Word64 -> Word64 + mkPat width subpat = + foldl' (.|.) 0 [ subpat `shiftL` p | p <- [0, width..63] ] + + -- Does the given number's bit representation match the regular expression + -- @0*1*0*@? + hasOneRun :: Word64 -> Bool + hasOneRun m = + 64 == popCount m + countLeadingZeros m + countTrailingZeros m + -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -48,10 +48,11 @@ 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 ) +import GHC.Types.Var ( PiTyBinder(..), isLocalVar, isInvisibleFunArg, mkLocalVar ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Id +import GHC.Types.Id.Info import GHC.Types.Error import GHC.Utils.Error ( mkMCDiagnostic ) @@ -59,6 +60,7 @@ import GHC.Utils.Monad ( foldlM ) import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Panic.Plain( assert ) import GHC.Unit.Module( Module ) import GHC.Unit.Module.ModGuts @@ -1748,12 +1750,44 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs | otherwise = (spec_bndrs1, spec_rhs1, spec_fn_ty1) join_arity_decr = length rule_lhs_args - length spec_bndrs - spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn - = Just (orig_join_arity - join_arity_decr) - | otherwise - = Nothing - ; spec_fn <- newSpecIdSM fn spec_fn_ty spec_join_arity + -------------------------------------- + -- Add a suitable unfolding; see Note [Inline specialisations] + -- The wrap_unf_body applies the original unfolding to the specialised + -- arguments, not forgetting to wrap the dx_binds around the outside (#22358) + simpl_opts = initSimpleOpts dflags + wrap_unf_body body = foldr (Let . db_bind) (body `mkApps` spec_args) dx_binds + spec_unf = specUnfolding simpl_opts spec_bndrs wrap_unf_body + rule_lhs_args fn_unf + + -------------------------------------- + -- Adding arity information just propagates it a bit faster + -- 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 + + spec_inl_prag + | not is_local -- See Note [Specialising imported functions] + , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal + = neverInlinePragma + | otherwise + = inl_prag + + spec_fn_info + = vanillaIdInfo `setArityInfo` max 0 (fn_arity - arity_decr) + `setInlinePragInfo` spec_inl_prag + `setUnfoldingInfo` spec_unf + + -- Compute the IdDetails of the specialise Id + -- See Note [Transfer IdDetails during specialisation] + spec_fn_details + = case idDetails fn of + JoinId join_arity _ -> JoinId (join_arity - join_arity_decr) Nothing + DFunId is_nt -> DFunId is_nt + _ -> VanillaId + + ; spec_fn <- newSpecIdSM (idName fn) spec_fn_ty spec_fn_details spec_fn_info ; let -- The rule to put in the function's specialisation is: -- forall x @b d1' d2'. @@ -1768,33 +1802,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs herald fn rule_bndrs rule_lhs_args (mkVarApps (Var spec_fn) spec_bndrs) - simpl_opts = initSimpleOpts dflags - - -------------------------------------- - -- Add a suitable unfolding; see Note [Inline specialisations] - -- The wrap_unf_body applies the original unfolding to the specialised - -- arguments, not forgetting to wrap the dx_binds around the outside (#22358) - wrap_unf_body body = foldr (Let . db_bind) (body `mkApps` spec_args) dx_binds - spec_unf = specUnfolding simpl_opts spec_bndrs wrap_unf_body - rule_lhs_args fn_unf - - spec_inl_prag - | not is_local -- See Note [Specialising imported functions] - , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal - = neverInlinePragma - | otherwise - = inl_prag - - -------------------------------------- - -- Adding arity information just propagates it a bit faster - -- 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 - spec_f_w_arity = spec_fn `setIdArity` max 0 (fn_arity - arity_decr) - `setInlinePragma` spec_inl_prag - `setIdUnfolding` spec_unf - `asJoinId_maybe` spec_join_arity + spec_f_w_arity = spec_fn _rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type , ppr spec_fn <+> dcolon <+> ppr spec_fn_ty @@ -1824,7 +1832,7 @@ specLookupRule env fn args phase rules {- Note [Specialising DFuns] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -DFuns have a special sort of unfolding (DFunUnfolding), and these are +DFuns have a special sort of unfolding (DFunUnfolding), and it is hard to specialise a DFunUnfolding to give another DFunUnfolding unless the DFun is fully applied (#18120). So, in the case of DFunIds we simply extend the CallKey with trailing UnspecTypes/UnspecArgs, @@ -1833,6 +1841,36 @@ so that we'll generate a rule that completely saturates the DFun. There is an ASSERT that checks this, in the DFunUnfolding case of GHC.Core.Unfold.Make.specUnfolding. +Note [Transfer IdDetails during specialisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When specialising a function, `newSpecIdSM` comes up with a fresh Id the +specialised RHS will be bound to. It is critical that we get the `IdDetails` of +the specialised Id correct: + +* JoinId: We want the specialised Id to be a join point, too. But + we have to carefully adjust the arity + +* DFunId: It is crucial that we also make the new Id a DFunId. + - First, because it obviously /is/ a DFun, having a DFunUnfolding and + all that; see Note [Specialising DFuns] + + - Second, DFuns get very delicate special treatment in the demand analyser; + see GHC.Core.Opt.DmdAnal.enterDFun. If the specialised function isn't + also a DFunId, this special treatment doesn't happen, so the demand + analyser makes a too-strict DFun, and we get an infinite loop. See Note + [Do not strictify a DFun's parameter dictionaries] in GHC.Core.Opt.DmdAnal. + #22549 describes the loop, and (lower down) a case where a /specialised/ + DFun caused a loop. + +* WorkerLikeId: Introduced by WW, so after Specialise. Nevertheless, they come + up when specialising imports. We must keep them as VanillaIds because WW + will detect them as WorkerLikeIds again. That is, unless specialisation + allows unboxing of all previous CBV args, in which case sticking to + VanillaIds was the only correct choice to begin with. + +* RecSelId, DataCon*Id, ClassOpId, PrimOpId, FCallId, CoVarId, TickBoxId: + Never specialised. + Note [Specialisation Must Preserve Sharing] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider a function: @@ -3439,15 +3477,14 @@ newDictBndr env@(SE { se_subst = subst }) b env' = env { se_subst = subst `Core.extendSubstInScope` b' } ; pure (env', b') } -newSpecIdSM :: Id -> Type -> Maybe JoinArity -> SpecM Id +newSpecIdSM :: Name -> Type -> IdDetails -> IdInfo -> SpecM Id -- Give the new Id a similar occurrence name to the old one -newSpecIdSM old_id new_ty join_arity_maybe +newSpecIdSM old_name new_ty details info = do { uniq <- getUniqueM - ; let name = idName old_id - new_occ = mkSpecOcc (nameOccName name) - new_id = mkUserLocal new_occ uniq ManyTy new_ty (getSrcSpan name) - `asJoinId_maybe` join_arity_maybe - ; return new_id } + ; let new_occ = mkSpecOcc (nameOccName old_name) + new_name = mkInternalName uniq new_occ (getSrcSpan old_name) + ; return (assert (not (isCoVarType new_ty)) $ + mkLocalVar details new_name ManyTy new_ty info) } {- Old (but interesting) stuff about unboxed bindings ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2006 -{-# LANGUAGE ScopedTypeVariables, PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables, PatternSynonyms, MultiWayIf #-} {-# LANGUAGE DeriveFunctor #-} @@ -47,6 +47,7 @@ import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set import GHC.Exts( oneShot ) +import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Data.FastString @@ -994,6 +995,59 @@ These two TyConApps have the same TyCon at the front but they (legitimately) have different numbers of arguments. They are surelyApart, so we can report that without looking any further (see #15704). + +Note [Unifying type applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Unifying type applications is quite subtle, as we found +in #23134 and #22647, when type families are involved. + +Suppose + type family F a :: Type -> Type + type family G k :: k = r | r -> k + +and consider these examples: + +* F Int ~ F Char, where F is injective + Since F is injective, we can reduce this to Int ~ Char, + therefore SurelyApart. + +* F Int ~ F Char, where F is not injective + Without injectivity, return MaybeApart. + +* G Type ~ G (Type -> Type) Int + Even though G is injective and the arguments to G are different, + we cannot deduce apartness because the RHS is oversaturated. + For example, G might be defined as + G Type = Maybe Int + G (Type -> Type) = Maybe + So we return MaybeApart. + +* F Int Bool ~ F Int Char -- SurelyApart (since Bool is apart from Char) + F Int Bool ~ Maybe a -- MaybeApart + F Int Bool ~ a b -- MaybeApart + F Int Bool ~ Char -> Bool -- MaybeApart + An oversaturated type family can match an application, + whether it's a TyConApp, AppTy or FunTy. Decompose. + +* F Int ~ a b + We cannot decompose a saturated, or under-saturated + type family application. We return MaybeApart. + +To handle all those conditions, unify_ty goes through +the following checks in sequence, where Fn is a type family +of arity n: + +* (C1) Fn x_1 ... x_n ~ Fn y_1 .. y_n + A saturated application. + Here we can unify arguments in which Fn is injective. +* (C2) Fn x_1 ... x_n ~ anything, anything ~ Fn x_1 ... x_n + A saturated type family can match anything - we return MaybeApart. +* (C3) Fn x_1 ... x_m ~ a b, a b ~ Fn x_1 ... x_m where m > n + An oversaturated type family can be decomposed. +* (C4) Fn x_1 ... x_m ~ anything, anything ~ Fn x_1 ... x_m, where m > n + If we couldn't decompose in the previous step, we return SurelyApart. + +Afterwards, the rest of the code doesn't have to worry about type families. -} -------------- unify_ty: the main workhorse ----------- @@ -1035,31 +1089,63 @@ unify_ty env ty1 (TyVarTy tv2) kco = uVar (umSwapRn env) tv2 ty1 (mkSymCo kco) unify_ty env ty1 ty2 _kco + + -- Handle non-oversaturated type families first + -- See Note [Unifying type applications] + -- + -- (C1) If we have T x1 ... xn ~ T y1 ... yn, use injectivity information of T + -- Note that both sides must not be oversaturated + | Just (tc1, tys1) <- isSatTyFamApp mb_tc_app1 + , Just (tc2, tys2) <- isSatTyFamApp mb_tc_app2 + , tc1 == tc2 + = do { let inj = case tyConInjectivityInfo tc1 of + NotInjective -> repeat False + Injective bs -> bs + + (inj_tys1, noninj_tys1) = partitionByList inj tys1 + (inj_tys2, noninj_tys2) = partitionByList inj tys2 + + ; unify_tys env inj_tys1 inj_tys2 + ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] + don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } + + | Just _ <- isSatTyFamApp mb_tc_app1 -- (C2) A (not-over-saturated) type-family application + = maybeApart MARTypeFamily -- behaves like a type variable; might match + + | Just _ <- isSatTyFamApp mb_tc_app2 -- (C2) A (not-over-saturated) type-family application + -- behaves like a type variable; might unify + -- but doesn't match (as in the TyVarTy case) + = if um_unif env then maybeApart MARTypeFamily else surelyApart + + -- Handle oversaturated type families. + -- + -- They can match an application (TyConApp/FunTy/AppTy), this is handled + -- the same way as in the AppTy case below. + -- + -- If there is no application, an oversaturated type family can only + -- match a type variable or a saturated type family, + -- both of which we handled earlier. So we can say surelyApart. + | Just (tc1, _) <- mb_tc_app1 + , isTypeFamilyTyCon tc1 + = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] -- (C3) + | otherwise -> surelyApart -- (C4) + + | Just (tc2, _) <- mb_tc_app2 + , isTypeFamilyTyCon tc2 + = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] -- (C3) + | otherwise -> surelyApart -- (C4) + + -- At this point, neither tc1 nor tc2 can be a type family. | Just (tc1, tys1) <- mb_tc_app1 , Just (tc2, tys2) <- mb_tc_app2 , tc1 == tc2 - = if isInjectiveTyCon tc1 Nominal - then unify_tys env tys1 tys2 - else do { let inj | isTypeFamilyTyCon tc1 - = case tyConInjectivityInfo tc1 of - NotInjective -> repeat False - Injective bs -> bs - | otherwise - = repeat False - - (inj_tys1, noninj_tys1) = partitionByList inj tys1 - (inj_tys2, noninj_tys2) = partitionByList inj tys2 - - ; unify_tys env inj_tys1 inj_tys2 - ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] - don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } - - | isTyFamApp mb_tc_app1 -- A (not-over-saturated) type-family application - = maybeApart MARTypeFamily -- behaves like a type variable; might match - - | isTyFamApp mb_tc_app2 -- A (not-over-saturated) type-family application - , um_unif env -- behaves like a type variable; might unify - = maybeApart MARTypeFamily + = do { massertPpr (isInjectiveTyCon tc1 Nominal) (ppr tc1) + ; unify_tys env tys1 tys2 + } -- TYPE and CONSTRAINT are not Apart -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim @@ -1160,16 +1246,16 @@ unify_tys env orig_xs orig_ys -- Possibly different saturations of a polykinded tycon -- See Note [Polykinded tycon applications] -isTyFamApp :: Maybe (TyCon, [Type]) -> Bool --- True if we have a saturated or under-saturated type family application +isSatTyFamApp :: Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type]) +-- Return the argument if we have a saturated type family application -- If it is /over/ saturated then we return False. E.g. -- unify_ty (F a b) (c d) where F has arity 1 -- we definitely want to decompose that type application! (#22647) -isTyFamApp (Just (tc, tys)) - = not (isGenerativeTyCon tc Nominal) -- Type family-ish +isSatTyFamApp tapp@(Just (tc, tys)) + | isTypeFamilyTyCon tc && not (tys `lengthExceeds` tyConArity tc) -- Not over-saturated -isTyFamApp Nothing - = False + = tapp +isSatTyFamApp _ = Nothing --------------------------------- uVar :: UMEnv ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -921,7 +921,7 @@ genPrim prof bound ty op = case op of IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_ NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid] - ListThreadsOp -> \[r] [] -> PrimInline $ r |= var "h$threads" + ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" [] GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t] LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -2387,22 +2387,32 @@ has a separate call to isStuckTypeFamily, so the `F` above will still be accepte -} +-- | Why was the LHS 'PatersonSize' not strictly smaller than the RHS 'PatersonSize'? +-- +-- See Note [Paterson conditions] in GHC.Tc.Validity. data PatersonSizeFailure - = PSF_TyFam TyCon -- Type family - | PSF_Size -- Too many type constructors/variables - | PSF_TyVar [TyVar] -- These type variables appear more often than in instance head; - -- no duplicates in this list + -- | Either side contains a type family. + = PSF_TyFam TyCon + -- | The size of the LHS is not strictly less than the size of the RHS. + | PSF_Size + -- | These type variables appear more often in the LHS than in the RHS. + | PSF_TyVar [TyVar] -- ^ no duplicates in this list -------------------------------------- -data PatersonSize -- See Note [Paterson conditions] in GHC.Tc.Validity - = PS_TyFam TyCon -- Mentions a type family; infinite size - - | PS_Vanilla { ps_tvs :: [TyVar] -- Free tyvars, including repetitions; - , ps_size :: Int -- Number of type constructors and variables +-- | The Paterson size of a given type, in the sense of +-- Note [Paterson conditions] in GHC.Tc.Validity +-- +-- - after expanding synonyms, +-- - ignoring coercions (as they are not user written). +data PatersonSize + -- | The type mentions a type family, so the size could be anything. + = PS_TyFam TyCon + + -- | The type does not mention a type family. + | PS_Vanilla { ps_tvs :: [TyVar] -- ^ free tyvars, including repetitions; + , ps_size :: Int -- ^ number of type constructors and variables } - -- Always after expanding synonyms - -- Always ignore coercions (not user written) -- ToDo: ignore invisible arguments? See Note [Invisible arguments and termination] instance Outputable PatersonSize where @@ -2415,21 +2425,26 @@ pSizeZero, pSizeOne :: PatersonSize pSizeZero = PS_Vanilla { ps_tvs = [], ps_size = 0 } pSizeOne = PS_Vanilla { ps_tvs = [], ps_size = 1 } -ltPatersonSize :: PatersonSize -- Size of constraint - -> PatersonSize -- Size of instance head; never PS_TyFam +-- | @ltPatersonSize ps1 ps2@ returns: +-- +-- - @Nothing@ iff @ps1@ is definitely strictly smaller than @ps2@, +-- - @Just ps_fail@ otherwise; @ps_fail@ says what went wrong. +ltPatersonSize :: PatersonSize + -> PatersonSize -> Maybe PatersonSizeFailure --- (ps1 `ltPatersonSize` ps2) returns --- Nothing iff ps1 is strictly smaller than p2 --- Just ps_fail says what went wrong -ltPatersonSize (PS_TyFam tc) _ = Just (PSF_TyFam tc) ltPatersonSize (PS_Vanilla { ps_tvs = tvs1, ps_size = s1 }) (PS_Vanilla { ps_tvs = tvs2, ps_size = s2 }) | s1 >= s2 = Just PSF_Size | bad_tvs@(_:_) <- noMoreTyVars tvs1 tvs2 = Just (PSF_TyVar bad_tvs) | otherwise = Nothing -- OK! -ltPatersonSize (PS_Vanilla {}) (PS_TyFam tc) - = pprPanic "ltPSize" (ppr tc) - -- Impossible because we never have a type family in an instance head +ltPatersonSize (PS_TyFam tc) _ = Just (PSF_TyFam tc) +ltPatersonSize _ (PS_TyFam tc) = Just (PSF_TyFam tc) + -- NB: this last equation is never taken when checking instances, because + -- type families are disallowed in instance heads. + -- + -- However, this function is also used in the logic for solving superclass + -- constraints (see Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance), + -- in which case we might well hit this case (see e.g. T23171). noMoreTyVars :: [TyVar] -- Free vars (with repetitions) of the constraint C -> [TyVar] -- Free vars (with repetitions) of the head H ===================================== docs/index.html → docs/index.html.in ===================================== @@ -39,7 +39,7 @@

  • - GHC API + GHC API

    Documentation for the GHC API. ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -192,7 +192,7 @@ buildHtmlDocumentation = do | SphinxHTML `Set.member` doctargets ] need $ map ((root -/-) . pathIndex) targets - copyFileUntracked "docs/index.html" file + copyFile "docs/index.html" file -- | Compile a Sphinx ReStructured Text package to HTML. buildSphinxHtml :: FilePath -> Rules () ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -304,10 +304,10 @@ rtsCabalFlags = mconcat flag = interpolateCabalFlag packageVersions :: Interpolations -packageVersions = foldMap f [ base, ghcPrim, ghc, cabal, templateHaskell, ghcCompact, array ] +packageVersions = foldMap f [ base, ghcPrim, compiler, ghc, cabal, templateHaskell, ghcCompact, array ] where f :: Package -> Interpolations - f pkg = interpolateVar var $ show . version <$> readPackageData pkg + f pkg = interpolateVar var $ version <$> readPackageData pkg where var = "LIBRARY_" <> pkgName pkg <> "_VERSION" templateRule :: FilePath -> Interpolations -> Rules () @@ -336,6 +336,7 @@ templateRules = do templateRule "libraries/libiserv/libiserv.cabal" $ projectVersion templateRule "libraries/template-haskell/template-haskell.cabal" $ projectVersion templateRule "libraries/prologue.txt" $ packageVersions + templateRule "docs/index.html" $ packageVersions -- Generators ===================================== libraries/base/tests/all.T ===================================== @@ -290,5 +290,6 @@ test('T19719', normal, compile_and_run, ['']) test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring']) test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) -test('listThreads', js_broken(22261), compile_and_run, ['']) +test('listThreads', normal, compile_and_run, ['']) +test('listThreads1', normal, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) ===================================== libraries/base/tests/listThreads1.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import GHC.Conc.Sync + +main :: IO () +main = listThreads >>= print ===================================== libraries/base/tests/listThreads1.stdout ===================================== @@ -0,0 +1 @@ +[ThreadId 1] ===================================== rts/Threads.c ===================================== @@ -872,6 +872,7 @@ StgMutArrPtrs *listThreads(Capability *cap) const StgWord size = n_threads + mutArrPtrsCardTableSize(n_threads); StgMutArrPtrs *arr = (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size); + SET_HDR(arr, &stg_MUT_ARR_PTRS_DIRTY_info, CCS_SYSTEM); TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0); arr->ptrs = n_threads; arr->size = size; ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -479,11 +479,13 @@ EXTERN_INLINE StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n) memory we're about to zero. Thus, with the THREADED RTS and +RTS -N2 or greater we must not zero - immutable closure's slop. + immutable closure's slop. Similarly, the concurrent GC's mark thread + may race when a mutator during slop-zeroing. Consequently, we also disable + zeroing when the non-moving GC is in use. Hence, an immutable closure's slop is zeroed when either: - - PROFILING && era > 0 (LDV is on) or + - PROFILING && era > 0 (LDV is on) && !nonmoving-gc-enabled or - !THREADED && DEBUG Additionally: @@ -541,7 +543,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) const bool can_zero_immutable_slop = // Only if we're running single threaded. - RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1; + RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1 + && !RTS_DEREF(RtsFlags).GcFlags.useNonmoving; // see #23170 const bool zero_slop_immutable = want_to_zero_immutable_slop && can_zero_immutable_slop; ===================================== rts/js/mem.js ===================================== @@ -1455,11 +1455,3 @@ function h$pext64(src_b, src_a, mask_b, mask_a) { } RETURN_UBX_TUP2(dst_b, dst_a); } - -function h$getThreadLabel(t) { - if (t.label) { - RETURN_UBX_TUP2(1, t.label); - } else { - RETURN_UBX_TUP2(0, 0); - } -} ===================================== rts/js/thread.js ===================================== @@ -106,8 +106,8 @@ function h$Thread() { #endif } -function h$rts_getThreadId(t) { - return t.tid; +function h$rts_getThreadId(t) { // returns a CULLong + RETURN_UBX_TUP2((t.tid / Math.pow(2,32))>>>0, (t.tid & 0xFFFFFFFF)>>>0); } function h$cmp_thread(t1,t2) { @@ -121,13 +121,35 @@ function h$threadString(t) { if(t === null) { return ""; } else if(t.label) { - var str = h$decodeUtf8z(t.label[0], t.label[1]); + var str = h$decodeUtf8z(t.label, 0); return str + " (" + t.tid + ")"; } else { return (""+t.tid); } } +function h$getThreadLabel(t) { + if (t.label) { + RETURN_UBX_TUP2(1, t.label); + } else { + RETURN_UBX_TUP2(0, 0); + } +} + +function h$listThreads() { + var r = h$newArray(0,null); + + if (h$currentThread) r.push(h$currentThread); + + var threads_iter = h$threads.iter(); + while ((t = threads_iter()) !== null) r.push(t); + + var blocked_iter = h$blocked.iter(); + while ((t = blocked_iter.next()) !== null) r.push(t); + + return r; +} + function h$fork(a, inherit) { h$r1 = h$forkThread(a, inherit); return h$yield(); @@ -1134,7 +1156,7 @@ function h$main(a) { t.stack[8] = a; t.stack[9] = h$return; t.sp = 9; - t.label = [h$encodeUtf8("main"), 0]; + t.label = h$encodeUtf8("main"); h$wakeupThread(t); h$startMainLoop(); return t; ===================================== testsuite/tests/primops/should_run/T23071.hs ===================================== @@ -0,0 +1,5 @@ +import Control.Monad +import GHC.Conc.Sync + +main = replicateM_ 1000000 $ listThreads >>= print + ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -60,3 +60,4 @@ test('UnliftedTVar2', normal, compile_and_run, ['']) test('UnliftedWeakPtr', normal, compile_and_run, ['']) test('T21624', normal, compile_and_run, ['']) +test('T23071', ignore_stdout, compile_and_run, ['']) ===================================== testsuite/tests/simplCore/should_run/T23134.hs ===================================== @@ -0,0 +1,37 @@ +{-# LANGUAGE GHC2021, DataKinds, TypeFamilies #-} +module Main where + +import Data.Maybe +import Data.Kind + +main :: IO () +main = putStrLn str + +str :: String +str = case runInstrImpl @(TOption TUnit) mm MAP of + C VOption -> "good" + C Unused -> "bad" + +runInstrImpl :: forall inp out. Value (MapOpRes inp TUnit) -> Instr inp out -> Rec out +runInstrImpl m MAP = C m + +type MapOpRes :: T -> T -> T +type family MapOpRes c :: T -> T +type instance MapOpRes ('TOption x) = 'TOption + +mm :: Value (TOption TUnit) +mm = VOption +{-# NOINLINE mm #-} + +type Value :: T -> Type +data Value t where + VOption :: Value ('TOption t) + Unused :: Value t + +data T = TOption T | TUnit + +data Instr (inp :: T) (out :: T) where + MAP :: Instr c (TOption (MapOpRes c TUnit)) + +data Rec :: T -> Type where + C :: Value r -> Rec (TOption r) ===================================== testsuite/tests/simplCore/should_run/T23134.stdout ===================================== @@ -0,0 +1 @@ +good ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -108,3 +108,4 @@ test('T21575', normal, compile_and_run, ['-O']) test('T21575b', [], multimod_compile_and_run, ['T21575b', '-O']) test('T20836', normal, compile_and_run, ['-O0']) # Should not time out; See #20836 test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint']) +test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases']) ===================================== testsuite/tests/typecheck/should_compile/T23171.hs ===================================== @@ -0,0 +1,43 @@ +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module T23171 where + +import Data.Kind + +type C1 :: Type -> Type -> Constraint +class C1 t m where + +type C2 :: Type -> Constraint +class C2 a where + +type C3 :: Type -> Constraint +class C2 a => C3 a where + +type D :: Type -> Constraint +class D t where +instance (forall m. C3 m => C1 t m) => D t where + +type T :: Type -> Type +type family T a where + +try :: forall (e :: Type). D (T e) => e -> () +try _ = () + +type C1T :: Type -> Type -> Constraint +class C1 (T e) m => C1T e m + +tried :: forall (e :: Type). (forall m. C1T e m) => e -> () +tried = try @e + +-- From the call to "try", we get [W] D (T e). +-- After using the instance for D, we get the QC [G] C3 m ==> [W] C1 (T e) m. +-- +-- The Given "[G] C3 m" thus arises from superclass expansion +-- from "D (T e)", which contains a type family application, T. +-- So the logic in 'mkStrictSuperClasses' better be able to handle that when +-- expanding the superclasses of C3 (in this case, C2); in particular +-- ltPatersonSize needs to handle a type family in its second argument. + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -865,3 +865,4 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T23171', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2855ecf281173334b30007d3b568f9bafdc68fce...1fdbbd8d81b3b5e80e8997d279764f62cdcc3c26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2855ecf281173334b30007d3b568f9bafdc68fce...1fdbbd8d81b3b5e80e8997d279764f62cdcc3c26 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 11:59:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 16 May 2023 07:59:03 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] Don't use OccSet Message-ID: <646370075a0c4_171ad99a5313a4118952a@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: dc7ca88b by Ben Gamari at 2023-05-16T07:58:47-04:00 Don't use OccSet OccSet appears not to behave as one would expect. - - - - - 2 changed files: - testsuite/tests/interface-stability/base-exports.stdout - utils/dump-decls/Main.hs Changes: ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -19,7 +19,6 @@ module Control.Applicative where (*>) :: forall a b. f a -> f b -> f b (<*) :: forall a b. f a -> f b -> f a {-# MINIMAL pure, ((<*>) | liftA2) #-} - Const :: forall {k} a (b :: k). a -> Const a b type role Const representational phantom type Const :: forall {k}. * -> k -> * newtype Const a b = Const {getConst :: a} @@ -29,12 +28,9 @@ module Control.Applicative where type role WrappedMonad representational nominal type WrappedMonad :: (* -> *) -> * -> * newtype WrappedMonad m a = WrapMonad {unwrapMonad :: m a} - ZipList :: forall a. [a] -> ZipList a type ZipList :: * -> * newtype ZipList a = ZipList {getZipList :: [a]} asum :: forall (t :: * -> *) (f :: * -> *) a. (Data.Foldable.Foldable t, Alternative f) => t (f a) -> f a - getConst :: forall {k} a (b :: k). Const a b -> a - getZipList :: forall a. ZipList a -> [a] liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Maybe.Maybe a) @@ -68,7 +64,6 @@ module Control.Arrow where class Arrow a => ArrowLoop a where loop :: forall b d c. a (b, d) (c, d) -> a b c {-# MINIMAL loop #-} - ArrowMonad :: forall (a :: * -> * -> *) b. a () b -> ArrowMonad a b type role ArrowMonad representational nominal type ArrowMonad :: (* -> * -> *) -> * -> * newtype ArrowMonad a b = ArrowMonad (a () b) @@ -80,7 +75,6 @@ module Control.Arrow where class Arrow a => ArrowZero a where zeroArrow :: forall b c. a b c {-# MINIMAL zeroArrow #-} - Kleisli :: forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b type role Kleisli representational representational nominal type Kleisli :: (* -> *) -> * -> * -> * newtype Kleisli m a b = Kleisli {runKleisli :: a -> m b} @@ -88,7 +82,6 @@ module Control.Arrow where (^>>) :: forall (a :: * -> * -> *) b c d. Arrow a => (b -> c) -> a c d -> a b d leftApp :: forall (a :: * -> * -> *) b c d. ArrowApply a => a b c -> a (Data.Either.Either b d) (Data.Either.Either c d) returnA :: forall (a :: * -> * -> *) b. Arrow a => a b b - runKleisli :: forall (m :: * -> *) a b. Kleisli m a b -> a -> m b module Control.Category where -- Safety: Trustworthy @@ -219,74 +212,56 @@ module Control.Concurrent.QSemN where module Control.Exception where -- Safety: Trustworthy - AllocationLimitExceeded :: AllocationLimitExceeded type AllocationLimitExceeded :: * data AllocationLimitExceeded = AllocationLimitExceeded type ArithException :: * data ArithException = Overflow | Underflow | LossOfPrecision | DivideByZero | Denormal | RatioZeroDenominator type ArrayException :: * data ArrayException = IndexOutOfBounds GHC.Base.String | UndefinedElement GHC.Base.String - AssertionFailed :: GHC.Base.String -> AssertionFailed type AssertionFailed :: * newtype AssertionFailed = AssertionFailed GHC.Base.String type AsyncException :: * data AsyncException = StackOverflow | HeapOverflow | ThreadKilled | UserInterrupt - BlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar type BlockedIndefinitelyOnMVar :: * data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar - BlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM type BlockedIndefinitelyOnSTM :: * data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM - CompactionFailed :: GHC.Base.String -> CompactionFailed type CompactionFailed :: * newtype CompactionFailed = CompactionFailed GHC.Base.String - Deadlock :: Deadlock type Deadlock :: * data Deadlock = Deadlock pattern ErrorCall :: GHC.Base.String -> ErrorCall type ErrorCall :: * data ErrorCall = ErrorCallWithLocation GHC.Base.String GHC.Base.String - ErrorCallWithLocation :: GHC.Base.String -> GHC.Base.String -> ErrorCall type Exception :: * -> Constraint class (base-4.18.0.0:Data.Typeable.Internal.Typeable e, GHC.Show.Show e) => Exception e where toException :: e -> SomeException fromException :: SomeException -> GHC.Maybe.Maybe e displayException :: e -> GHC.Base.String - Handler :: forall a e. Exception e => (e -> GHC.Types.IO a) -> Handler a type Handler :: * -> * data Handler a = forall e. Exception e => Handler (e -> GHC.Types.IO a) type IOException :: * data IOException = ... type MaskingState :: * data MaskingState = Unmasked | MaskedInterruptible | MaskedUninterruptible - NestedAtomically :: NestedAtomically type NestedAtomically :: * data NestedAtomically = NestedAtomically - NoMethodError :: GHC.Base.String -> NoMethodError type NoMethodError :: * newtype NoMethodError = NoMethodError GHC.Base.String - NonTermination :: NonTermination type NonTermination :: * data NonTermination = NonTermination - PatternMatchFail :: GHC.Base.String -> PatternMatchFail type PatternMatchFail :: * newtype PatternMatchFail = PatternMatchFail GHC.Base.String - RecConError :: GHC.Base.String -> RecConError type RecConError :: * newtype RecConError = RecConError GHC.Base.String - RecSelError :: GHC.Base.String -> RecSelError type RecSelError :: * newtype RecSelError = RecSelError GHC.Base.String - RecUpdError :: GHC.Base.String -> RecUpdError type RecUpdError :: * newtype RecUpdError = RecUpdError GHC.Base.String - SomeAsyncException :: forall e. Exception e => e -> SomeAsyncException type SomeAsyncException :: * data SomeAsyncException = forall e. Exception e => SomeAsyncException e - SomeException :: forall e. Exception e => e -> SomeException type SomeException :: * data SomeException = forall e. Exception e => SomeException e - TypeError :: GHC.Base.String -> TypeError type TypeError :: * newtype TypeError = TypeError GHC.Base.String allowInterrupt :: GHC.Types.IO () @@ -320,77 +295,58 @@ module Control.Exception where module Control.Exception.Base where -- Safety: Trustworthy - AllocationLimitExceeded :: AllocationLimitExceeded type AllocationLimitExceeded :: * data AllocationLimitExceeded = AllocationLimitExceeded type ArithException :: * data ArithException = Overflow | Underflow | LossOfPrecision | DivideByZero | Denormal | RatioZeroDenominator type ArrayException :: * data ArrayException = IndexOutOfBounds GHC.Base.String | UndefinedElement GHC.Base.String - AssertionFailed :: GHC.Base.String -> AssertionFailed type AssertionFailed :: * newtype AssertionFailed = AssertionFailed GHC.Base.String type AsyncException :: * data AsyncException = StackOverflow | HeapOverflow | ThreadKilled | UserInterrupt - BlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar type BlockedIndefinitelyOnMVar :: * data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar - BlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM type BlockedIndefinitelyOnSTM :: * data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM - CompactionFailed :: GHC.Base.String -> CompactionFailed type CompactionFailed :: * newtype CompactionFailed = CompactionFailed GHC.Base.String - Deadlock :: Deadlock type Deadlock :: * data Deadlock = Deadlock pattern ErrorCall :: GHC.Base.String -> ErrorCall type ErrorCall :: * data ErrorCall = ErrorCallWithLocation GHC.Base.String GHC.Base.String - ErrorCallWithLocation :: GHC.Base.String -> GHC.Base.String -> ErrorCall type Exception :: * -> Constraint class (base-4.18.0.0:Data.Typeable.Internal.Typeable e, GHC.Show.Show e) => Exception e where toException :: e -> SomeException fromException :: SomeException -> GHC.Maybe.Maybe e displayException :: e -> GHC.Base.String - FixIOException :: FixIOException type FixIOException :: * data FixIOException = FixIOException type IOException :: * data IOException = ... type MaskingState :: * data MaskingState = Unmasked | MaskedInterruptible | MaskedUninterruptible - NestedAtomically :: NestedAtomically type NestedAtomically :: * data NestedAtomically = NestedAtomically - NoMatchingContinuationPrompt :: NoMatchingContinuationPrompt type NoMatchingContinuationPrompt :: * data NoMatchingContinuationPrompt = NoMatchingContinuationPrompt - NoMethodError :: GHC.Base.String -> NoMethodError type NoMethodError :: * newtype NoMethodError = NoMethodError GHC.Base.String - NonTermination :: NonTermination type NonTermination :: * data NonTermination = NonTermination - PatternMatchFail :: GHC.Base.String -> PatternMatchFail type PatternMatchFail :: * newtype PatternMatchFail = PatternMatchFail GHC.Base.String - RecConError :: GHC.Base.String -> RecConError type RecConError :: * newtype RecConError = RecConError GHC.Base.String - RecSelError :: GHC.Base.String -> RecSelError type RecSelError :: * newtype RecSelError = RecSelError GHC.Base.String - RecUpdError :: GHC.Base.String -> RecUpdError type RecUpdError :: * newtype RecUpdError = RecUpdError GHC.Base.String - SomeAsyncException :: forall e. Exception e => e -> SomeAsyncException type SomeAsyncException :: * data SomeAsyncException = forall e. Exception e => SomeAsyncException e - SomeException :: forall e. Exception e => e -> SomeException type SomeException :: * data SomeException = forall e. Exception e => SomeException e - TypeError :: GHC.Base.String -> TypeError type TypeError :: * newtype TypeError = TypeError GHC.Base.String assert :: forall a. GHC.Types.Bool -> a -> a @@ -602,10 +558,8 @@ module Control.Monad.Zip where module Data.Array.Byte where -- Safety: Trustworthy - ByteArray :: GHC.Prim.ByteArray# -> ByteArray type ByteArray :: * data ByteArray = ByteArray GHC.Prim.ByteArray# - MutableByteArray :: forall s. GHC.Prim.MutableByteArray# s -> MutableByteArray s type role MutableByteArray nominal type MutableByteArray :: * -> * data MutableByteArray s = MutableByteArray (GHC.Prim.MutableByteArray# s) @@ -692,7 +646,6 @@ module Data.Bits where (.<<.) :: forall a. Bits a => a -> GHC.Types.Int -> a (.>>.) :: forall a. Bits a => a -> GHC.Types.Int -> a (.^.) :: forall a. Bits a => a -> a -> a - And :: forall a. a -> And a type And :: * -> * newtype And a = And {getAnd :: a} type Bits :: * -> Constraint @@ -726,20 +679,13 @@ module Data.Bits where countLeadingZeros :: b -> GHC.Types.Int countTrailingZeros :: b -> GHC.Types.Int {-# MINIMAL finiteBitSize #-} - Iff :: forall a. a -> Iff a type Iff :: * -> * newtype Iff a = Iff {getIff :: a} - Ior :: forall a. a -> Ior a type Ior :: * -> * newtype Ior a = Ior {getIor :: a} - Xor :: forall a. a -> Xor a type Xor :: * -> * newtype Xor a = Xor {getXor :: a} bitDefault :: forall a. (Bits a, GHC.Num.Num a) => GHC.Types.Int -> a - getAnd :: forall a. And a -> a - getIff :: forall a. Iff a -> a - getIor :: forall a. Ior a -> a - getXor :: forall a. Xor a -> a oneBits :: forall a. FiniteBits a => a popCountDefault :: forall a. (Bits a, GHC.Num.Num a) => a -> GHC.Types.Int testBitDefault :: forall a. (Bits a, GHC.Num.Num a) => a -> GHC.Types.Int -> GHC.Types.Bool @@ -854,7 +800,6 @@ module Data.Data where data DataType = ... type Fixity :: * data Fixity = Prefix | Infix - Proxy :: forall {k} (t :: k). Proxy t type role Proxy phantom type Proxy :: forall {k}. k -> * data Proxy t = Proxy @@ -930,7 +875,6 @@ module Data.Data where module Data.Dynamic where -- Safety: Trustworthy - Dynamic :: forall a. base-4.18.0.0:Data.Typeable.Internal.TypeRep a -> a -> Dynamic type Dynamic :: * data Dynamic where Dynamic :: forall a. base-4.18.0.0:Data.Typeable.Internal.TypeRep a -> a -> Dynamic @@ -1178,26 +1122,21 @@ module Data.Functor.Classes where module Data.Functor.Compose where -- Safety: Trustworthy - Compose :: forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1). f (g a) -> Compose f g a type role Compose representational nominal nominal type Compose :: forall {k} {k1}. (k -> *) -> (k1 -> k) -> k1 -> * newtype Compose f g a = Compose {getCompose :: f (g a)} - getCompose :: forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). Compose f g a -> f (g a) module Data.Functor.Const where -- Safety: Trustworthy - Const :: forall {k} a (b :: k). a -> Const a b type role Const representational phantom type Const :: forall {k}. * -> k -> * newtype Const a b = Const {getConst :: a} - getConst :: forall {k} a (b :: k). Const a b -> a module Data.Functor.Contravariant where -- Safety: Trustworthy ($<) :: forall (f :: * -> *) b a. Contravariant f => f b -> b -> f a (>$$<) :: forall (f :: * -> *) b a. Contravariant f => f b -> (a -> b) -> f a (>$<) :: forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a - Comparison :: forall a. (a -> a -> GHC.Types.Ordering) -> Comparison a type Comparison :: * -> * newtype Comparison a = Comparison {getComparison :: a -> a -> GHC.Types.Ordering} type Contravariant :: (* -> *) -> Constraint @@ -1205,30 +1144,21 @@ module Data.Functor.Contravariant where contramap :: forall a' a. (a' -> a) -> f a -> f a' (>$) :: forall b a. b -> f b -> f a {-# MINIMAL contramap #-} - Equivalence :: forall a. (a -> a -> GHC.Types.Bool) -> Equivalence a type Equivalence :: * -> * newtype Equivalence a = Equivalence {getEquivalence :: a -> a -> GHC.Types.Bool} - Op :: forall a b. (b -> a) -> Op a b type Op :: * -> * -> * newtype Op a b = Op {getOp :: b -> a} - Predicate :: forall a. (a -> GHC.Types.Bool) -> Predicate a type Predicate :: * -> * newtype Predicate a = Predicate {getPredicate :: a -> GHC.Types.Bool} comparisonEquivalence :: forall a. Comparison a -> Equivalence a defaultComparison :: forall a. GHC.Classes.Ord a => Comparison a defaultEquivalence :: forall a. GHC.Classes.Eq a => Equivalence a - getComparison :: forall a. Comparison a -> a -> a -> GHC.Types.Ordering - getEquivalence :: forall a. Equivalence a -> a -> a -> GHC.Types.Bool - getOp :: forall a b. Op a b -> b -> a - getPredicate :: forall a. Predicate a -> a -> GHC.Types.Bool phantom :: forall (f :: * -> *) a b. (GHC.Base.Functor f, Contravariant f) => f a -> f b module Data.Functor.Identity where -- Safety: Trustworthy - Identity :: forall a. a -> Identity a type Identity :: * -> * newtype Identity a = Identity {runIdentity :: a} - runIdentity :: forall a. Identity a -> a module Data.Functor.Product where -- Safety: Safe @@ -1497,30 +1427,22 @@ module Data.Maybe where module Data.Monoid where -- Safety: Trustworthy (<>) :: forall a. GHC.Base.Semigroup a => a -> a -> a - All :: GHC.Types.Bool -> All type All :: * newtype All = All {getAll :: GHC.Types.Bool} - Alt :: forall {k} (f :: k -> *) (a :: k). f a -> Alt f a type role Alt representational nominal type Alt :: forall {k}. (k -> *) -> k -> * newtype Alt f a = Alt {getAlt :: f a} - Any :: GHC.Types.Bool -> Any type Any :: * newtype Any = Any {getAny :: GHC.Types.Bool} - Ap :: forall {k} (f :: k -> *) (a :: k). f a -> Ap f a type role Ap representational nominal type Ap :: forall {k}. (k -> *) -> k -> * newtype Ap f a = Ap {getAp :: f a} - Dual :: forall a. a -> Dual a type Dual :: * -> * newtype Dual a = Dual {getDual :: a} - Endo :: forall a. (a -> a) -> Endo a type Endo :: * -> * newtype Endo a = Endo {appEndo :: a -> a} - First :: forall a. GHC.Maybe.Maybe a -> First a type First :: * -> * newtype First a = First {getFirst :: GHC.Maybe.Maybe a} - Last :: forall a. GHC.Maybe.Maybe a -> Last a type Last :: * -> * newtype Last a = Last {getLast :: GHC.Maybe.Maybe a} type Monoid :: * -> Constraint @@ -1529,26 +1451,13 @@ module Data.Monoid where mappend :: a -> a -> a mconcat :: [a] -> a {-# MINIMAL mempty | mconcat #-} - Product :: forall a. a -> Product a type Product :: * -> * newtype Product a = Product {getProduct :: a} - Sum :: forall a. a -> Sum a type Sum :: * -> * newtype Sum a = Sum {getSum :: a} - appEndo :: forall a. Endo a -> a -> a - getAll :: All -> GHC.Types.Bool - getAlt :: forall {k} (f :: k -> *) (a :: k). Alt f a -> f a - getAny :: Any -> GHC.Types.Bool - getAp :: forall {k} (f :: k -> *) (a :: k). Ap f a -> f a - getDual :: forall a. Dual a -> a - getFirst :: forall a. First a -> GHC.Maybe.Maybe a - getLast :: forall a. Last a -> GHC.Maybe.Maybe a - getProduct :: forall a. Product a -> a - getSum :: forall a. Sum a -> a module Data.Ord where -- Safety: Trustworthy - Down :: forall a. a -> Down a type Down :: * -> * newtype Down a = Down {getDown :: a} type Ord :: * -> Constraint @@ -1565,15 +1474,12 @@ module Data.Ord where data Ordering = LT | EQ | GT clamp :: forall a. Ord a => (a, a) -> a -> a comparing :: forall a b. Ord a => (b -> a) -> b -> b -> Ordering - getDown :: forall a. Down a -> a module Data.Proxy where -- Safety: Trustworthy - KProxy :: forall t. KProxy t type role KProxy phantom type KProxy :: * -> * data KProxy t = KProxy - Proxy :: forall {k} (t :: k). Proxy t type role Proxy phantom type Proxy :: forall {k}. k -> * data Proxy t = Proxy @@ -1624,38 +1530,28 @@ module Data.STRef.Strict where module Data.Semigroup where -- Safety: Trustworthy - All :: GHC.Types.Bool -> All type All :: * newtype All = All {getAll :: GHC.Types.Bool} - Any :: GHC.Types.Bool -> Any type Any :: * newtype Any = Any {getAny :: GHC.Types.Bool} - Arg :: forall a b. a -> b -> Arg a b type Arg :: * -> * -> * data Arg a b = Arg a b type ArgMax :: * -> * -> * type ArgMax a b = Max (Arg a b) type ArgMin :: * -> * -> * type ArgMin a b = Min (Arg a b) - Dual :: forall a. a -> Dual a type Dual :: * -> * newtype Dual a = Dual {getDual :: a} - Endo :: forall a. (a -> a) -> Endo a type Endo :: * -> * newtype Endo a = Endo {appEndo :: a -> a} - First :: forall a. a -> First a type First :: * -> * newtype First a = First {getFirst :: a} - Last :: forall a. a -> Last a type Last :: * -> * newtype Last a = Last {getLast :: a} - Max :: forall a. a -> Max a type Max :: * -> * newtype Max a = Max {getMax :: a} - Min :: forall a. a -> Min a type Min :: * -> * newtype Min a = Min {getMin :: a} - Product :: forall a. a -> Product a type Product :: * -> * newtype Product a = Product {getProduct :: a} type Semigroup :: * -> Constraint @@ -1664,23 +1560,12 @@ module Data.Semigroup where sconcat :: GHC.Base.NonEmpty a -> a stimes :: forall b. GHC.Real.Integral b => b -> a -> a {-# MINIMAL (<>) | sconcat #-} - Sum :: forall a. a -> Sum a type Sum :: * -> * newtype Sum a = Sum {getSum :: a} type WrappedMonoid :: * -> * newtype WrappedMonoid m = WrapMonoid {unwrapMonoid :: m} - appEndo :: forall a. Endo a -> a -> a cycle1 :: forall m. Semigroup m => m -> m diff :: forall m. Semigroup m => m -> Endo m - getAll :: All -> GHC.Types.Bool - getAny :: Any -> GHC.Types.Bool - getDual :: forall a. Dual a -> a - getFirst :: forall a. First a -> a - getLast :: forall a. Last a -> a - getMax :: forall a. Max a -> a - getMin :: forall a. Min a -> a - getProduct :: forall a. Product a -> a - getSum :: forall a. Sum a -> a mtimesDefault :: forall b a. (GHC.Real.Integral b, GHC.Base.Monoid a) => b -> a -> a stimesIdempotent :: forall b a. GHC.Real.Integral b => b -> a -> a stimesIdempotentMonoid :: forall b a. (GHC.Real.Integral b, GHC.Base.Monoid a) => b -> a -> a @@ -1719,7 +1604,6 @@ module Data.Traversable where module Data.Tuple where -- Safety: Trustworthy - MkSolo :: forall a. a -> Solo a pattern Solo :: forall a. a -> Solo a type Solo :: * -> * data Solo a = MkSolo a @@ -1757,7 +1641,6 @@ module Data.Type.Bool where module Data.Type.Coercion where -- Safety: None - Coercion :: forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b type Coercion :: forall {k}. k -> k -> * data Coercion a b where Coercion :: forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b @@ -1848,7 +1731,6 @@ module Data.Typeable where type (:~~:) :: forall k1 k2. k1 -> k2 -> * data (:~~:) a b where HRefl :: forall {k1} (a :: k1). (:~~:) a a - Proxy :: forall {k} (t :: k). Proxy t type role Proxy phantom type Proxy :: forall {k}. k -> * data Proxy t = Proxy @@ -1901,14 +1783,11 @@ module Data.Unique where module Data.Version where -- Safety: Safe - Version :: [GHC.Types.Int] -> [GHC.Base.String] -> Version type Version :: * data Version = Version {versionBranch :: [GHC.Types.Int], versionTags :: [GHC.Base.String]} makeVersion :: [GHC.Types.Int] -> Version parseVersion :: Text.ParserCombinators.ReadP.ReadP Version showVersion :: Version -> GHC.Base.String - versionBranch :: Version -> [GHC.Types.Int] - versionTags :: Version -> [GHC.Base.String] module Data.Void where -- Safety: Trustworthy @@ -1964,7 +1843,6 @@ module Foreign where (.<<.) :: forall a. Bits a => a -> Int -> a (.>>.) :: forall a. Bits a => a -> Int -> a (.^.) :: forall a. Bits a => a -> a -> a - And :: forall a. a -> And a type And :: * -> * newtype And a = And {getAnd :: a} type Bits :: * -> Constraint @@ -2008,7 +1886,6 @@ module Foreign where type role FunPtr phantom type FunPtr :: * -> * data FunPtr a = ... - Iff :: forall a. a -> Iff a type Iff :: * -> * newtype Iff a = Iff {getIff :: a} type Int :: * @@ -2021,10 +1898,8 @@ module Foreign where data Int64 = ... type Int8 :: * data Int8 = ... - IntPtr :: Int -> IntPtr type IntPtr :: * newtype IntPtr = IntPtr Int - Ior :: forall a. a -> Ior a type Ior :: * -> * newtype Ior a = Ior {getIor :: a} type Pool :: * @@ -2055,10 +1930,8 @@ module Foreign where data Word64 = ... type Word8 :: * data Word8 = ... - WordPtr :: Word -> WordPtr type WordPtr :: * newtype WordPtr = WordPtr Word - Xor :: forall a. a -> Xor a type Xor :: * -> * newtype Xor a = Xor {getXor :: a} addForeignPtrFinalizer :: forall a. FinalizerPtr a -> ForeignPtr a -> GHC.Types.IO () @@ -2100,10 +1973,6 @@ module Foreign where freePool :: Pool -> GHC.Types.IO () freeStablePtr :: forall a. StablePtr a -> GHC.Types.IO () fromBool :: forall a. GHC.Num.Num a => GHC.Types.Bool -> a - getAnd :: forall a. And a -> a - getIff :: forall a. Iff a -> a - getIor :: forall a. Ior a -> a - getXor :: forall a. Xor a -> a intPtrToPtr :: forall a. IntPtr -> Ptr a lengthArray0 :: forall a. (Storable a, GHC.Classes.Eq a) => a -> Ptr a -> GHC.Types.IO Int malloc :: forall a. Storable a => GHC.Types.IO (Ptr a) @@ -2177,99 +2046,72 @@ module Foreign where module Foreign.C where -- Safety: Safe - CBool :: GHC.Word.Word8 -> CBool type CBool :: * newtype CBool = CBool GHC.Word.Word8 - CChar :: GHC.Int.Int8 -> CChar type CChar :: * newtype CChar = CChar GHC.Int.Int8 - CClock :: GHC.Int.Int64 -> CClock type CClock :: * newtype CClock = CClock GHC.Int.Int64 - CDouble :: GHC.Types.Double -> CDouble type CDouble :: * newtype CDouble = CDouble GHC.Types.Double type CFile :: * data CFile = ... - CFloat :: GHC.Types.Float -> CFloat type CFloat :: * newtype CFloat = CFloat GHC.Types.Float type CFpos :: * data CFpos = ... - CInt :: GHC.Int.Int32 -> CInt type CInt :: * newtype CInt = CInt GHC.Int.Int32 - CIntMax :: GHC.Int.Int64 -> CIntMax type CIntMax :: * newtype CIntMax = CIntMax GHC.Int.Int64 - CIntPtr :: GHC.Int.Int64 -> CIntPtr type CIntPtr :: * newtype CIntPtr = CIntPtr GHC.Int.Int64 type CJmpBuf :: * data CJmpBuf = ... - CLLong :: GHC.Int.Int64 -> CLLong type CLLong :: * newtype CLLong = CLLong GHC.Int.Int64 - CLong :: GHC.Int.Int64 -> CLong type CLong :: * newtype CLong = CLong GHC.Int.Int64 - CPtrdiff :: GHC.Int.Int64 -> CPtrdiff type CPtrdiff :: * newtype CPtrdiff = CPtrdiff GHC.Int.Int64 - CSChar :: GHC.Int.Int8 -> CSChar type CSChar :: * newtype CSChar = CSChar GHC.Int.Int8 - CSUSeconds :: GHC.Int.Int64 -> CSUSeconds type CSUSeconds :: * newtype CSUSeconds = CSUSeconds GHC.Int.Int64 - CShort :: GHC.Int.Int16 -> CShort type CShort :: * newtype CShort = CShort GHC.Int.Int16 - CSigAtomic :: GHC.Int.Int32 -> CSigAtomic type CSigAtomic :: * newtype CSigAtomic = CSigAtomic GHC.Int.Int32 - CSize :: GHC.Word.Word64 -> CSize type CSize :: * newtype CSize = CSize GHC.Word.Word64 type CString :: * type CString = GHC.Ptr.Ptr CChar type CStringLen :: * type CStringLen = (GHC.Ptr.Ptr CChar, GHC.Types.Int) - CTime :: GHC.Int.Int64 -> CTime type CTime :: * newtype CTime = CTime GHC.Int.Int64 - CUChar :: GHC.Word.Word8 -> CUChar type CUChar :: * newtype CUChar = CUChar GHC.Word.Word8 - CUInt :: GHC.Word.Word32 -> CUInt type CUInt :: * newtype CUInt = CUInt GHC.Word.Word32 - CUIntMax :: GHC.Word.Word64 -> CUIntMax type CUIntMax :: * newtype CUIntMax = CUIntMax GHC.Word.Word64 - CUIntPtr :: GHC.Word.Word64 -> CUIntPtr type CUIntPtr :: * newtype CUIntPtr = CUIntPtr GHC.Word.Word64 - CULLong :: GHC.Word.Word64 -> CULLong type CULLong :: * newtype CULLong = CULLong GHC.Word.Word64 - CULong :: GHC.Word.Word64 -> CULong type CULong :: * newtype CULong = CULong GHC.Word.Word64 - CUSeconds :: GHC.Word.Word32 -> CUSeconds type CUSeconds :: * newtype CUSeconds = CUSeconds GHC.Word.Word32 - CUShort :: GHC.Word.Word16 -> CUShort type CUShort :: * newtype CUShort = CUShort GHC.Word.Word16 type CWString :: * type CWString = GHC.Ptr.Ptr CWchar type CWStringLen :: * type CWStringLen = (GHC.Ptr.Ptr CWchar, GHC.Types.Int) - CWchar :: GHC.Int.Int32 -> CWchar type CWchar :: * newtype CWchar = CWchar GHC.Int.Int32 - Errno :: CInt -> Errno type Errno :: * newtype Errno = Errno CInt castCCharToChar :: CChar -> GHC.Types.Char @@ -2426,15 +2268,12 @@ module Foreign.C where module Foreign.C.ConstPtr where -- Safety: Trustworthy - ConstPtr :: forall a. GHC.Ptr.Ptr a -> ConstPtr a type role ConstPtr phantom type ConstPtr :: * -> * newtype ConstPtr a = ConstPtr {unConstPtr :: GHC.Ptr.Ptr a} - unConstPtr :: forall a. ConstPtr a -> GHC.Ptr.Ptr a module Foreign.C.Error where -- Safety: Trustworthy - Errno :: Foreign.C.Types.CInt -> Errno type Errno :: * newtype Errno = Errno Foreign.C.Types.CInt e2BIG :: Errno @@ -2889,13 +2728,11 @@ module Foreign.Ptr where type role FunPtr phantom type FunPtr :: * -> * data FunPtr a = ... - IntPtr :: GHC.Types.Int -> IntPtr type IntPtr :: * newtype IntPtr = IntPtr GHC.Types.Int type role Ptr phantom type Ptr :: * -> * data Ptr a = ... - WordPtr :: GHC.Types.Word -> WordPtr type WordPtr :: * newtype WordPtr = WordPtr GHC.Types.Word alignPtr :: forall a. Ptr a -> GHC.Types.Int -> Ptr a @@ -2920,7 +2757,6 @@ module Foreign.Safe where (.<<.) :: forall a. Bits a => a -> Int -> a (.>>.) :: forall a. Bits a => a -> Int -> a (.^.) :: forall a. Bits a => a -> a -> a - And :: forall a. a -> And a type And :: * -> * newtype And a = And {getAnd :: a} type Bits :: * -> Constraint @@ -2964,7 +2800,6 @@ module Foreign.Safe where type role FunPtr phantom type FunPtr :: * -> * data FunPtr a = ... - Iff :: forall a. a -> Iff a type Iff :: * -> * newtype Iff a = Iff {getIff :: a} type Int :: * @@ -2977,10 +2812,8 @@ module Foreign.Safe where data Int64 = ... type Int8 :: * data Int8 = ... - IntPtr :: Int -> IntPtr type IntPtr :: * newtype IntPtr = IntPtr Int - Ior :: forall a. a -> Ior a type Ior :: * -> * newtype Ior a = Ior {getIor :: a} type Pool :: * @@ -3011,10 +2844,8 @@ module Foreign.Safe where data Word64 = ... type Word8 :: * data Word8 = ... - WordPtr :: Word -> WordPtr type WordPtr :: * newtype WordPtr = WordPtr Word - Xor :: forall a. a -> Xor a type Xor :: * -> * newtype Xor a = Xor {getXor :: a} addForeignPtrFinalizer :: forall a. FinalizerPtr a -> ForeignPtr a -> GHC.Types.IO () @@ -3056,10 +2887,6 @@ module Foreign.Safe where freePool :: Pool -> GHC.Types.IO () freeStablePtr :: forall a. StablePtr a -> GHC.Types.IO () fromBool :: forall a. GHC.Num.Num a => GHC.Types.Bool -> a - getAnd :: forall a. And a -> a - getIff :: forall a. Iff a -> a - getIor :: forall a. Ior a -> a - getXor :: forall a. Xor a -> a intPtrToPtr :: forall a. IntPtr -> Ptr a lengthArray0 :: forall a. (Storable a, GHC.Classes.Eq a) => a -> Ptr a -> GHC.Types.IO Int malloc :: forall a. Storable a => GHC.Types.IO (Ptr a) @@ -3159,7 +2986,6 @@ module GHC.Arr where -- Safety: Unsafe (!) :: forall i e. Ix i => Array i e -> i -> e (//) :: forall i e. Ix i => Array i e -> [(i, e)] -> Array i e - Array :: forall i e. i -> i -> GHC.Types.Int -> GHC.Prim.Array# e -> Array i e type role Array nominal representational type Array :: * -> * -> * data Array i e = Array !i !i {-# UNPACK #-}GHC.Types.Int (GHC.Prim.Array# e) @@ -3172,7 +2998,6 @@ module GHC.Arr where rangeSize :: (a, a) -> GHC.Types.Int unsafeRangeSize :: (a, a) -> GHC.Types.Int {-# MINIMAL range, (index | unsafeIndex), inRange #-} - STArray :: forall s i e. i -> i -> GHC.Types.Int -> GHC.Prim.MutableArray# s e -> STArray s i e type role STArray nominal nominal representational type STArray :: * -> * -> * -> * data STArray s i e = STArray !i !i {-# UNPACK #-}GHC.Types.Int (GHC.Prim.MutableArray# s e) @@ -3226,10 +3051,8 @@ module GHC.Arr where module GHC.ArrayArray where -- Safety: Trustworthy - ArrayArray# :: GHC.Prim.Array# GHC.Prim.ByteArray# -> ArrayArray# type ArrayArray# :: GHC.Types.UnliftedType newtype ArrayArray# = ArrayArray# (GHC.Prim.Array# GHC.Prim.ByteArray#) - MutableArrayArray# :: forall s. GHC.Prim.MutableArray# s GHC.Prim.ByteArray# -> MutableArrayArray# s type role MutableArrayArray# nominal type MutableArrayArray# :: * -> GHC.Types.UnliftedType newtype MutableArrayArray# s = MutableArrayArray# (GHC.Prim.MutableArray# s GHC.Prim.ByteArray#) @@ -3361,7 +3184,6 @@ module GHC.Base where fmap :: forall a b. (a -> b) -> f a -> f b (<$) :: forall a b. a -> f b -> f a {-# MINIMAL fmap #-} - IO :: forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a type IO :: * -> * newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) type role IOPort# nominal representational @@ -3424,7 +3246,6 @@ module GHC.Base where data MVar# a b type Maybe :: * -> * data Maybe a = Nothing | Just a - Module :: TrName -> TrName -> Module type Module :: * data Module = Module TrName TrName type Monad :: (* -> *) -> Constraint @@ -3485,10 +3306,8 @@ module GHC.Base where data RealWorld type RuntimeRep :: * data RuntimeRep = VecRep VecCount VecElem | TupleRep [RuntimeRep] | SumRep [RuntimeRep] | BoxedRep Levity | IntRep | Int8Rep | Int16Rep | Int32Rep | Int64Rep | WordRep | Word8Rep | Word16Rep | Word32Rep | Word64Rep | AddrRep | FloatRep | DoubleRep - SPEC :: SPEC type SPEC :: * data SPEC = SPEC | SPEC2 - SPEC2 :: SPEC type Semigroup :: * -> Constraint class Semigroup a where (<>) :: a -> a -> a @@ -3524,7 +3343,6 @@ module GHC.Base where data ThreadId# type TrName :: * data TrName = TrNameS Addr# | TrNameD [Char] - TyCon :: Word64# -> Word64# -> Module -> TrName -> Int# -> KindRep -> TyCon type TyCon :: * data TyCon = TyCon Word64# Word64# Module TrName Int# KindRep type Type :: * @@ -5090,15 +4908,12 @@ module GHC.Conc where type HandlerFun = GHC.ForeignPtr.ForeignPtr GHC.Word.Word8 -> GHC.Types.IO () type PrimMVar :: * data PrimMVar - STM :: forall a. (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) -> STM a type STM :: * -> * newtype STM a = STM (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) type Signal :: * type Signal = Foreign.C.Types.CInt - TVar :: forall a. GHC.Prim.TVar# GHC.Prim.RealWorld a -> TVar a type TVar :: * -> * data TVar a = TVar (GHC.Prim.TVar# GHC.Prim.RealWorld a) - ThreadId :: GHC.Prim.ThreadId# -> ThreadId type ThreadId :: * data ThreadId = ThreadId GHC.Prim.ThreadId# type ThreadStatus :: * @@ -5180,13 +4995,10 @@ module GHC.Conc.Sync where data BlockReason = BlockedOnMVar | BlockedOnBlackHole | BlockedOnException | BlockedOnSTM | BlockedOnForeignCall | BlockedOnOther type PrimMVar :: * data PrimMVar - STM :: forall a. (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) -> STM a type STM :: * -> * newtype STM a = STM (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) - TVar :: forall a. GHC.Prim.TVar# GHC.Prim.RealWorld a -> TVar a type TVar :: * -> * data TVar a = TVar (GHC.Prim.TVar# GHC.Prim.RealWorld a) - ThreadId :: GHC.Prim.ThreadId# -> ThreadId type ThreadId :: * data ThreadId = ThreadId GHC.Prim.ThreadId# type ThreadStatus :: * @@ -5251,7 +5063,6 @@ module GHC.Constants where module GHC.Desugar where -- Safety: Trustworthy (>>>) :: forall (arr :: * -> * -> *) a b c. Control.Arrow.Arrow arr => arr a b -> arr b c -> arr a c - AnnotationWrapper :: forall a. Data.Data.Data a => a -> AnnotationWrapper type AnnotationWrapper :: * data AnnotationWrapper = forall a. Data.Data.Data a => AnnotationWrapper a toAnnotationWrapper :: forall a. Data.Data.Data a => a -> AnnotationWrapper @@ -5359,16 +5170,13 @@ module GHC.Exception where pattern ErrorCall :: GHC.Base.String -> ErrorCall type ErrorCall :: * data ErrorCall = ErrorCallWithLocation GHC.Base.String GHC.Base.String - ErrorCallWithLocation :: GHC.Base.String -> GHC.Base.String -> ErrorCall type Exception :: * -> Constraint class (base-4.18.0.0:Data.Typeable.Internal.Typeable e, GHC.Show.Show e) => Exception e where toException :: e -> SomeException fromException :: SomeException -> GHC.Maybe.Maybe e displayException :: e -> GHC.Base.String - SomeException :: forall e. Exception e => e -> SomeException type SomeException :: * data SomeException = forall e. Exception e => SomeException e - SrcLoc :: [GHC.Types.Char] -> [GHC.Types.Char] -> [GHC.Types.Char] -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc type SrcLoc :: * data SrcLoc = SrcLoc {srcLocPackage :: [GHC.Types.Char], srcLocModule :: [GHC.Types.Char], srcLocFile :: [GHC.Types.Char], srcLocStartLine :: GHC.Types.Int, srcLocStartCol :: GHC.Types.Int, srcLocEndLine :: GHC.Types.Int, srcLocEndCol :: GHC.Types.Int} divZeroException :: SomeException @@ -5382,13 +5190,6 @@ module GHC.Exception where prettySrcLoc :: SrcLoc -> GHC.Base.String ratioZeroDenomException :: SomeException showCCSStack :: [GHC.Base.String] -> [GHC.Base.String] - srcLocEndCol :: SrcLoc -> GHC.Types.Int - srcLocEndLine :: SrcLoc -> GHC.Types.Int - srcLocFile :: SrcLoc -> [GHC.Types.Char] - srcLocModule :: SrcLoc -> [GHC.Types.Char] - srcLocPackage :: SrcLoc -> [GHC.Types.Char] - srcLocStartCol :: SrcLoc -> GHC.Types.Int - srcLocStartLine :: SrcLoc -> GHC.Types.Int throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a underflowException :: SomeException @@ -5401,7 +5202,6 @@ module GHC.Exception.Type where toException :: e -> SomeException fromException :: SomeException -> GHC.Maybe.Maybe e displayException :: e -> GHC.Base.String - SomeException :: forall e. Exception e => e -> SomeException type SomeException :: * data SomeException = forall e. Exception e => SomeException e divZeroException :: SomeException @@ -5411,40 +5211,24 @@ module GHC.Exception.Type where module GHC.ExecutionStack where -- Safety: None - Location :: GHC.Base.String -> GHC.Base.String -> GHC.Maybe.Maybe SrcLoc -> Location type Location :: * data Location = Location {objectName :: GHC.Base.String, functionName :: GHC.Base.String, srcLoc :: GHC.Maybe.Maybe SrcLoc} - SrcLoc :: GHC.Base.String -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc type SrcLoc :: * data SrcLoc = SrcLoc {sourceFile :: GHC.Base.String, sourceLine :: GHC.Types.Int, sourceColumn :: GHC.Types.Int} - functionName :: Location -> GHC.Base.String getStackTrace :: GHC.Types.IO (GHC.Maybe.Maybe [Location]) - objectName :: Location -> GHC.Base.String showStackTrace :: GHC.Types.IO (GHC.Maybe.Maybe GHC.Base.String) - sourceColumn :: SrcLoc -> GHC.Types.Int - sourceFile :: SrcLoc -> GHC.Base.String - sourceLine :: SrcLoc -> GHC.Types.Int - srcLoc :: Location -> GHC.Maybe.Maybe SrcLoc module GHC.ExecutionStack.Internal where -- Safety: None - Location :: GHC.Base.String -> GHC.Base.String -> GHC.Maybe.Maybe SrcLoc -> Location type Location :: * data Location = Location {objectName :: GHC.Base.String, functionName :: GHC.Base.String, srcLoc :: GHC.Maybe.Maybe SrcLoc} - SrcLoc :: GHC.Base.String -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc type SrcLoc :: * data SrcLoc = SrcLoc {sourceFile :: GHC.Base.String, sourceLine :: GHC.Types.Int, sourceColumn :: GHC.Types.Int} type StackTrace :: * newtype StackTrace = ... collectStackTrace :: GHC.Types.IO (GHC.Maybe.Maybe StackTrace) - functionName :: Location -> GHC.Base.String invalidateDebugCache :: GHC.Types.IO () - objectName :: Location -> GHC.Base.String showStackFrames :: [Location] -> GHC.Show.ShowS - sourceColumn :: SrcLoc -> GHC.Types.Int - sourceFile :: SrcLoc -> GHC.Base.String - sourceLine :: SrcLoc -> GHC.Types.Int - srcLoc :: Location -> GHC.Maybe.Maybe SrcLoc stackDepth :: StackTrace -> GHC.Types.Int stackFrames :: StackTrace -> GHC.Maybe.Maybe [Location] @@ -5476,7 +5260,6 @@ module GHC.Exts where type family Any where type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType data Array# a - ArrayArray# :: Array# ByteArray# -> ArrayArray# type ArrayArray# :: UnliftedType newtype ArrayArray# = ArrayArray# (Array# ByteArray#) type BCO :: * @@ -5513,7 +5296,6 @@ module GHC.Exts where data DoubleX4# type DoubleX8# :: TYPE (VecRep Vec8 DoubleElemRep) data DoubleX8# - Down :: forall a. a -> Down a type Down :: * -> * newtype Down a = Down {getDown :: a} type role FUN nominal representational representational @@ -5531,7 +5313,6 @@ module GHC.Exts where data FloatX4# type FloatX8# :: TYPE (VecRep Vec8 FloatElemRep) data FloatX8# - FunPtr :: forall a. Addr# -> FunPtr a type role FunPtr phantom type FunPtr :: * -> * data FunPtr a = FunPtr Addr# @@ -5618,7 +5399,6 @@ module GHC.Exts where type role MutableArray# nominal representational type MutableArray# :: forall {l :: Levity}. * -> TYPE (BoxedRep l) -> UnliftedType data MutableArray# a b - MutableArrayArray# :: forall s. MutableArray# s ByteArray# -> MutableArrayArray# s type role MutableArrayArray# nominal type MutableArrayArray# :: * -> UnliftedType newtype MutableArrayArray# s = MutableArrayArray# (MutableArray# s ByteArray#) @@ -5632,7 +5412,6 @@ module GHC.Exts where type role Proxy# phantom type Proxy# :: forall k. k -> ZeroBitType data Proxy# a - Ptr :: forall a. Addr# -> Ptr a type role Ptr phantom type Ptr :: * -> * data Ptr a = Ptr Addr# @@ -5640,10 +5419,8 @@ module GHC.Exts where data RealWorld type RuntimeRep :: * data RuntimeRep = VecRep VecCount VecElem | TupleRep [RuntimeRep] | SumRep [RuntimeRep] | BoxedRep Levity | IntRep | Int8Rep | Int16Rep | Int32Rep | Int64Rep | WordRep | Word8Rep | Word16Rep | Word32Rep | Word64Rep | AddrRep | FloatRep | DoubleRep - SPEC :: SPEC type SPEC :: * data SPEC = SPEC | SPEC2 - SPEC2 :: SPEC type SmallArray# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType data SmallArray# a type role SmallMutableArray# nominal representational @@ -5960,7 +5737,6 @@ module GHC.Exts where getApStackVal# :: forall a b. a -> Int# -> (# Int#, b #) getCCSOf# :: forall a d. a -> State# d -> (# State# d, Addr# #) getCurrentCCS# :: forall a d. a -> State# d -> (# State# d, Addr# #) - getDown :: forall a. Down a -> a getMaskingState# :: State# RealWorld -> (# State# RealWorld, Int# #) getSizeofMutableByteArray# :: forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #) getSizeofSmallMutableArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, Int# #) @@ -7119,7 +6895,6 @@ module GHC.Exts where module GHC.Fingerprint where -- Safety: Trustworthy - Fingerprint :: GHC.Word.Word64 -> GHC.Word.Word64 -> Fingerprint type Fingerprint :: * data Fingerprint = Fingerprint {-# UNPACK #-}GHC.Word.Word64 {-# UNPACK #-}GHC.Word.Word64 fingerprint0 :: Fingerprint @@ -7130,7 +6905,6 @@ module GHC.Fingerprint where module GHC.Fingerprint.Type where -- Safety: Trustworthy - Fingerprint :: GHC.Word.Word64 -> GHC.Word.Word64 -> Fingerprint type Fingerprint :: * data Fingerprint = Fingerprint {-# UNPACK #-}GHC.Word.Word64 {-# UNPACK #-}GHC.Word.Word64 @@ -7361,7 +7135,6 @@ module GHC.ForeignPtr where type FinalizerPtr a = GHC.Ptr.FunPtr (GHC.Ptr.Ptr a -> GHC.Types.IO ()) type Finalizers :: * data Finalizers = NoFinalizers | CFinalizers (GHC.Prim.Weak# ()) | HaskellFinalizers [GHC.Types.IO ()] - ForeignPtr :: forall a. GHC.Prim.Addr# -> ForeignPtrContents -> ForeignPtr a type role ForeignPtr phantom type ForeignPtr :: * -> * data ForeignPtr a = ForeignPtr GHC.Prim.Addr# ForeignPtrContents @@ -7403,7 +7176,6 @@ module GHC.GHCi.Helpers where module GHC.Generics where -- Safety: Trustworthy - (:*:) :: forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p type role (:*:) representational representational nominal type (:*:) :: forall k. (k -> *) -> (k -> *) -> k -> * data (:*:) f g p = (f p) :*: (g p) @@ -7456,32 +7228,26 @@ module GHC.Generics where from1 :: forall (a :: k). f a -> Rep1 f a to1 :: forall (a :: k). Rep1 f a -> f a {-# MINIMAL from1, to1 #-} - Generically :: forall a. a -> Generically a type Generically :: * -> * newtype Generically a = Generically a - Generically1 :: forall {k} (f :: k -> *) (a :: k). f a -> Generically1 f a type role Generically1 representational nominal type Generically1 :: forall k. (k -> *) -> k -> * newtype Generically1 f a where Generically1 :: forall {k} (f :: k -> *) (a :: k). f a -> Generically1 f a - K1 :: forall k i c (p :: k). c -> K1 i c p type role K1 phantom representational phantom type K1 :: forall k. * -> * -> k -> * newtype K1 i c p = K1 {unK1 :: c} - M1 :: forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p type role M1 phantom phantom representational nominal type M1 :: forall k. * -> Meta -> (k -> *) -> k -> * newtype M1 i c f p = M1 {unM1 :: f p} type Meta :: * data Meta = MetaData GHC.Types.Symbol GHC.Types.Symbol GHC.Types.Symbol GHC.Types.Bool | MetaCons GHC.Types.Symbol FixityI GHC.Types.Bool | MetaSel (GHC.Maybe.Maybe GHC.Types.Symbol) SourceUnpackedness SourceStrictness DecidedStrictness - Par1 :: forall p. p -> Par1 p type Par1 :: * -> * newtype Par1 p = Par1 {unPar1 :: p} type R :: * data R type Rec0 :: forall {k}. * -> k -> * type Rec0 = K1 R :: * -> k -> * - Rec1 :: forall k (f :: k -> *) (p :: k). f p -> Rec1 f p type role Rec1 representational nominal type Rec1 :: forall k. (k -> *) -> k -> * newtype Rec1 f p = Rec1 {unRec1 :: f p} @@ -7500,7 +7266,6 @@ module GHC.Generics where data SourceStrictness = NoSourceStrictness | SourceLazy | SourceStrict type SourceUnpackedness :: * data SourceUnpackedness = NoSourceUnpackedness | SourceNoUnpack | SourceUnpack - U1 :: forall k (p :: k). U1 p type role U1 phantom type U1 :: forall k. k -> * data U1 p = U1 @@ -7534,16 +7299,11 @@ module GHC.Generics where uFloat# :: forall k (p :: k). URec GHC.Types.Float p -> GHC.Prim.Float# uInt# :: forall k (p :: k). URec GHC.Types.Int p -> GHC.Prim.Int# uWord# :: forall k (p :: k). URec GHC.Types.Word p -> GHC.Prim.Word# - unK1 :: forall k i c (p :: k). K1 i c p -> c - unM1 :: forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p - unPar1 :: forall p. Par1 p -> p - unRec1 :: forall k (f :: k -> *) (p :: k). Rec1 f p -> f p module GHC.IO where -- Safety: Unsafe type FilePath :: * type FilePath = GHC.Base.String - IO :: forall a. (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) -> IO a type IO :: * -> * newtype IO a = IO (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) type MaskingState :: * @@ -7579,7 +7339,6 @@ module GHC.IO where module GHC.IO.Buffer where -- Safety: Trustworthy - Buffer :: forall e. RawBuffer e -> BufferState -> GHC.Types.Int -> GHC.Word.Word64 -> GHC.Types.Int -> GHC.Types.Int -> Buffer e type role Buffer phantom type Buffer :: * -> * data Buffer e = Buffer {bufRaw :: {-# UNPACK #-}(RawBuffer e), bufState :: BufferState, bufSize :: {-# UNPACK #-}GHC.Types.Int, bufOffset :: {-# UNPACK #-}GHC.Word.Word64, bufL :: {-# UNPACK #-}GHC.Types.Int, bufR :: {-# UNPACK #-}GHC.Types.Int} @@ -7593,12 +7352,6 @@ module GHC.IO.Buffer where type RawBuffer e = GHC.ForeignPtr.ForeignPtr e type RawCharBuffer :: * type RawCharBuffer = RawBuffer CharBufElem - bufL :: forall e. Buffer e -> GHC.Types.Int - bufOffset :: forall e. Buffer e -> GHC.Word.Word64 - bufR :: forall e. Buffer e -> GHC.Types.Int - bufRaw :: forall e. Buffer e -> RawBuffer e - bufSize :: forall e. Buffer e -> GHC.Types.Int - bufState :: forall e. Buffer e -> BufferState bufferAdd :: forall e. GHC.Types.Int -> Buffer e -> Buffer e bufferAddOffset :: forall e. GHC.Types.Int -> Buffer e -> Buffer e bufferAdjustL :: forall e. GHC.Types.Int -> Buffer e -> Buffer e @@ -7678,7 +7431,6 @@ module GHC.IO.Device where module GHC.IO.Encoding where -- Safety: Trustworthy - BufferCodec :: forall from to state. GHC.IO.Encoding.Types.CodeBuffer from to -> (GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)) -> GHC.Types.IO () -> GHC.Types.IO state -> (state -> GHC.Types.IO ()) -> BufferCodec from to state type role BufferCodec phantom phantom representational type BufferCodec :: * -> * -> * -> * data BufferCodec from to state = BufferCodec {encode :: GHC.IO.Encoding.Types.CodeBuffer from to, recover :: GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to), close :: GHC.Types.IO (), getState :: GHC.Types.IO state, setState :: state -> GHC.Types.IO ()} @@ -7688,30 +7440,21 @@ module GHC.IO.Encoding where type TextDecoder state = BufferCodec GHC.Word.Word8 GHC.IO.Buffer.CharBufElem state type TextEncoder :: * -> * type TextEncoder state = BufferCodec GHC.IO.Buffer.CharBufElem GHC.Word.Word8 state - TextEncoding :: forall dstate estate. GHC.Base.String -> GHC.Types.IO (TextDecoder dstate) -> GHC.Types.IO (TextEncoder estate) -> TextEncoding type TextEncoding :: * data TextEncoding = forall dstate estate. TextEncoding {textEncodingName :: GHC.Base.String, mkTextDecoder :: GHC.Types.IO (TextDecoder dstate), mkTextEncoder :: GHC.Types.IO (TextEncoder estate)} argvEncoding :: GHC.Types.IO TextEncoding char8 :: TextEncoding - close :: forall from to state. BufferCodec from to state -> GHC.Types.IO () - encode :: forall from to state. BufferCodec from to state -> GHC.IO.Encoding.Types.CodeBuffer from to getFileSystemEncoding :: GHC.Types.IO TextEncoding getForeignEncoding :: GHC.Types.IO TextEncoding getLocaleEncoding :: GHC.Types.IO TextEncoding - getState :: forall from to state. BufferCodec from to state -> GHC.Types.IO state initLocaleEncoding :: TextEncoding latin1 :: TextEncoding latin1_decode :: GHC.IO.Buffer.Buffer GHC.Word.Word8 -> GHC.IO.Buffer.CharBuffer -> GHC.Types.IO (GHC.IO.Buffer.Buffer GHC.Word.Word8, GHC.IO.Buffer.CharBuffer) latin1_encode :: GHC.IO.Buffer.CharBuffer -> GHC.IO.Buffer.Buffer GHC.Word.Word8 -> GHC.Types.IO (GHC.IO.Buffer.CharBuffer, GHC.IO.Buffer.Buffer GHC.Word.Word8) - mkTextDecoder :: () - mkTextEncoder :: () mkTextEncoding :: GHC.Base.String -> GHC.Types.IO TextEncoding - recover :: forall from to state. BufferCodec from to state -> GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to) setFileSystemEncoding :: TextEncoding -> GHC.Types.IO () setForeignEncoding :: TextEncoding -> GHC.Types.IO () setLocaleEncoding :: TextEncoding -> GHC.Types.IO () - setState :: forall from to state. BufferCodec from to state -> state -> GHC.Types.IO () - textEncodingName :: TextEncoding -> GHC.Base.String utf16 :: TextEncoding utf16be :: TextEncoding utf16le :: TextEncoding @@ -7755,7 +7498,6 @@ module GHC.IO.Encoding.Latin1 where module GHC.IO.Encoding.Types where -- Safety: Trustworthy - BufferCodec :: forall from to state. CodeBuffer from to -> (GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)) -> GHC.Types.IO () -> GHC.Types.IO state -> (state -> GHC.Types.IO ()) -> BufferCodec from to state type role BufferCodec phantom phantom representational type BufferCodec :: * -> * -> * -> * data BufferCodec from to state = BufferCodec {encode :: CodeBuffer from to, recover :: GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to), close :: GHC.Types.IO (), getState :: GHC.Types.IO state, setState :: state -> GHC.Types.IO ()} @@ -7771,17 +7513,8 @@ module GHC.IO.Encoding.Types where type TextDecoder state = BufferCodec GHC.Word.Word8 GHC.IO.Buffer.CharBufElem state type TextEncoder :: * -> * type TextEncoder state = BufferCodec GHC.IO.Buffer.CharBufElem GHC.Word.Word8 state - TextEncoding :: forall dstate estate. GHC.Base.String -> GHC.Types.IO (TextDecoder dstate) -> GHC.Types.IO (TextEncoder estate) -> TextEncoding type TextEncoding :: * data TextEncoding = forall dstate estate. TextEncoding {textEncodingName :: GHC.Base.String, mkTextDecoder :: GHC.Types.IO (TextDecoder dstate), mkTextEncoder :: GHC.Types.IO (TextEncoder estate)} - close :: forall from to state. BufferCodec from to state -> GHC.Types.IO () - encode :: forall from to state. BufferCodec from to state -> CodeBuffer from to - getState :: forall from to state. BufferCodec from to state -> GHC.Types.IO state - mkTextDecoder :: () - mkTextEncoder :: () - recover :: forall from to state. BufferCodec from to state -> GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to) - setState :: forall from to state. BufferCodec from to state -> state -> GHC.Types.IO () - textEncodingName :: TextEncoding -> GHC.Base.String module GHC.IO.Encoding.UTF16 where -- Safety: Trustworthy @@ -7822,31 +7555,24 @@ module GHC.IO.Encoding.UTF8 where module GHC.IO.Exception where -- Safety: Trustworthy - AllocationLimitExceeded :: AllocationLimitExceeded type AllocationLimitExceeded :: * data AllocationLimitExceeded = AllocationLimitExceeded type ArrayException :: * data ArrayException = IndexOutOfBounds GHC.Base.String | UndefinedElement GHC.Base.String - AssertionFailed :: GHC.Base.String -> AssertionFailed type AssertionFailed :: * newtype AssertionFailed = AssertionFailed GHC.Base.String type AsyncException :: * data AsyncException = StackOverflow | HeapOverflow | ThreadKilled | UserInterrupt - BlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar type BlockedIndefinitelyOnMVar :: * data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar - BlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM type BlockedIndefinitelyOnSTM :: * data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM - CompactionFailed :: GHC.Base.String -> CompactionFailed type CompactionFailed :: * newtype CompactionFailed = CompactionFailed GHC.Base.String - Deadlock :: Deadlock type Deadlock :: * data Deadlock = Deadlock type ExitCode :: * data ExitCode = ExitSuccess | ExitFailure GHC.Types.Int - FixIOException :: FixIOException type FixIOException :: * data FixIOException = FixIOException type IOError :: * @@ -7855,7 +7581,6 @@ module GHC.IO.Exception where data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy | ResourceExhausted | EOF | IllegalOperation | PermissionDenied | UserError | UnsatisfiedConstraints | SystemError | ProtocolError | OtherError | InvalidArgument | InappropriateType | HardwareFault | UnsupportedOperation | TimeExpired | ResourceVanished | Interrupted type IOException :: * data IOException = IOError {ioe_handle :: GHC.Maybe.Maybe GHC.IO.Handle.Types.Handle, ioe_type :: IOErrorType, ioe_location :: GHC.Base.String, ioe_description :: GHC.Base.String, ioe_errno :: GHC.Maybe.Maybe Foreign.C.Types.CInt, ioe_filename :: GHC.Maybe.Maybe GHC.IO.FilePath} - SomeAsyncException :: forall e. GHC.Exception.Type.Exception e => e -> SomeAsyncException type SomeAsyncException :: * data SomeAsyncException = forall e. GHC.Exception.Type.Exception e => SomeAsyncException e allocationLimitExceeded :: GHC.Exception.Type.SomeException @@ -7877,11 +7602,8 @@ module GHC.IO.Exception where module GHC.IO.FD where -- Safety: Trustworthy - FD :: Foreign.C.Types.CInt -> GHC.Types.Int -> FD type FD :: * data FD = FD {fdFD :: ! {-# UNPACK #-}(Foreign.C.Types.N:CInt[0])Foreign.C.Types.CInt, fdIsNonBlocking :: {-# UNPACK #-}GHC.Types.Int} - fdFD :: FD -> Foreign.C.Types.CInt - fdIsNonBlocking :: FD -> GHC.Types.Int mkFD :: Foreign.C.Types.CInt -> GHC.IO.IOMode.IOMode -> GHC.Maybe.Maybe (GHC.IO.Device.IODeviceType, System.Posix.Types.CDev, System.Posix.Types.CIno) -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.IO (FD, GHC.IO.Device.IODeviceType) openFile :: GHC.IO.FilePath -> GHC.IO.IOMode.IOMode -> GHC.Types.Bool -> GHC.Types.IO (FD, GHC.IO.Device.IODeviceType) openFileWith :: forall r s. GHC.IO.FilePath -> GHC.IO.IOMode.IOMode -> GHC.Types.Bool -> (FD -> GHC.IO.Device.IODeviceType -> GHC.Types.IO r) -> ((forall x. GHC.Types.IO x -> GHC.Types.IO x) -> r -> GHC.Types.IO s) -> GHC.Types.IO s @@ -7902,14 +7624,12 @@ module GHC.IO.Handle where data Handle = ... type HandlePosition :: * type HandlePosition = GHC.Num.Integer.Integer - HandlePosn :: Handle -> HandlePosition -> HandlePosn type HandlePosn :: * data HandlePosn = HandlePosn Handle HandlePosition type LockMode :: * data LockMode = SharedLock | ExclusiveLock type Newline :: * data Newline = LF | CRLF - NewlineMode :: Newline -> Newline -> NewlineMode type NewlineMode :: * data NewlineMode = NewlineMode {inputNL :: Newline, outputNL :: Newline} type SeekMode :: * @@ -7956,14 +7676,12 @@ module GHC.IO.Handle where hTell :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer hTryLock :: Handle -> LockMode -> GHC.Types.IO GHC.Types.Bool hWaitForInput :: Handle -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Bool - inputNL :: NewlineMode -> Newline isEOF :: GHC.Types.IO GHC.Types.Bool mkDuplexHandle :: forall dev. (GHC.IO.Device.RawIO dev, GHC.IO.Device.IODevice dev, GHC.IO.BufferedIO.BufferedIO dev, base-4.18.0.0:Data.Typeable.Internal.Typeable dev) => dev -> GHC.IO.FilePath -> GHC.Maybe.Maybe GHC.IO.Encoding.Types.TextEncoding -> NewlineMode -> GHC.Types.IO Handle mkFileHandle :: forall dev. (GHC.IO.Device.RawIO dev, GHC.IO.Device.IODevice dev, GHC.IO.BufferedIO.BufferedIO dev, base-4.18.0.0:Data.Typeable.Internal.Typeable dev) => dev -> GHC.IO.FilePath -> GHC.IO.IOMode.IOMode -> GHC.Maybe.Maybe GHC.IO.Encoding.Types.TextEncoding -> NewlineMode -> GHC.Types.IO Handle nativeNewline :: Newline nativeNewlineMode :: NewlineMode noNewlineTranslation :: NewlineMode - outputNL :: NewlineMode -> Newline universalNewlineMode :: NewlineMode module GHC.IO.Handle.FD where @@ -8033,7 +7751,6 @@ module GHC.IO.Handle.Internals where module GHC.IO.Handle.Lock where -- Safety: None - FileLockingNotSupported :: FileLockingNotSupported type FileLockingNotSupported :: * data FileLockingNotSupported = FileLockingNotSupported type LockMode :: * @@ -8062,7 +7779,6 @@ module GHC.IO.Handle.Text where module GHC.IO.Handle.Types where -- Safety: Trustworthy - BufferCodec :: forall from to state. GHC.IO.Encoding.Types.CodeBuffer from to -> (GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)) -> GHC.Types.IO () -> GHC.Types.IO state -> (state -> GHC.Types.IO ()) -> BufferCodec from to state type role BufferCodec phantom phantom representational type BufferCodec :: * -> * -> * -> * data BufferCodec from to state = BufferCodec {encode :: GHC.IO.Encoding.Types.CodeBuffer from to, recover :: GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to), close :: GHC.Types.IO (), getState :: GHC.Types.IO state, setState :: state -> GHC.Types.IO ()} @@ -8075,10 +7791,6 @@ module GHC.IO.Handle.Types where data Handle = FileHandle GHC.IO.FilePath {-# UNPACK #-}(GHC.MVar.MVar Handle__) | DuplexHandle GHC.IO.FilePath {-# UNPACK #-}(GHC.MVar.MVar Handle__) {-# UNPACK #-}(GHC.MVar.MVar Handle__) type HandleType :: * data HandleType = ClosedHandle | SemiClosedHandle | ReadHandle | WriteHandle | AppendHandle | ReadWriteHandle - Handle__ :: - forall dev enc_state dec_state. - (GHC.IO.Device.RawIO dev, GHC.IO.Device.IODevice dev, GHC.IO.BufferedIO.BufferedIO dev, base-4.18.0.0:Data.Typeable.Internal.Typeable dev) => - dev -> HandleType -> GHC.IORef.IORef (GHC.IO.Buffer.Buffer GHC.Word.Word8) -> BufferMode -> GHC.IORef.IORef (dec_state, GHC.IO.Buffer.Buffer GHC.Word.Word8) -> GHC.IORef.IORef (GHC.IO.Buffer.Buffer GHC.IO.Buffer.CharBufElem) -> GHC.IORef.IORef (BufferList GHC.IO.Buffer.CharBufElem) -> GHC.Maybe.Maybe (GHC.IO.Encoding.Types.TextEncoder enc_state) -> GHC.Maybe.Maybe (GHC.IO.Encoding.Types.TextDecoder dec_state) -> GHC.Maybe.Maybe GHC.IO.Encoding.Types.TextEncoding -> Newline -> Newline -> GHC.Maybe.Maybe (GHC.MVar.MVar Handle__) -> Handle__ type Handle__ :: * data Handle__ = forall dev enc_state dec_state. @@ -8098,27 +7810,9 @@ module GHC.IO.Handle.Types where haOtherSide :: GHC.Maybe.Maybe (GHC.MVar.MVar Handle__)} type Newline :: * data Newline = LF | CRLF - NewlineMode :: Newline -> Newline -> NewlineMode type NewlineMode :: * data NewlineMode = NewlineMode {inputNL :: Newline, outputNL :: Newline} checkHandleInvariants :: Handle__ -> GHC.Types.IO () - close :: forall from to state. BufferCodec from to state -> GHC.Types.IO () - encode :: forall from to state. BufferCodec from to state -> GHC.IO.Encoding.Types.CodeBuffer from to - getState :: forall from to state. BufferCodec from to state -> GHC.Types.IO state - haBufferMode :: Handle__ -> BufferMode - haBuffers :: Handle__ -> GHC.IORef.IORef (BufferList GHC.IO.Buffer.CharBufElem) - haByteBuffer :: Handle__ -> GHC.IORef.IORef (GHC.IO.Buffer.Buffer GHC.Word.Word8) - haCharBuffer :: Handle__ -> GHC.IORef.IORef (GHC.IO.Buffer.Buffer GHC.IO.Buffer.CharBufElem) - haCodec :: Handle__ -> GHC.Maybe.Maybe GHC.IO.Encoding.Types.TextEncoding - haDecoder :: () - haDevice :: () - haEncoder :: () - haInputNL :: Handle__ -> Newline - haLastDecode :: () - haOtherSide :: Handle__ -> GHC.Maybe.Maybe (GHC.MVar.MVar Handle__) - haOutputNL :: Handle__ -> Newline - haType :: Handle__ -> HandleType - inputNL :: NewlineMode -> Newline isAppendHandleType :: HandleType -> GHC.Types.Bool isReadWriteHandleType :: HandleType -> GHC.Types.Bool isReadableHandleType :: HandleType -> GHC.Types.Bool @@ -8126,9 +7820,6 @@ module GHC.IO.Handle.Types where nativeNewline :: Newline nativeNewlineMode :: NewlineMode noNewlineTranslation :: NewlineMode - outputNL :: NewlineMode -> Newline - recover :: forall from to state. BufferCodec from to state -> GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to) - setState :: forall from to state. BufferCodec from to state -> state -> GHC.Types.IO () showHandle :: GHC.IO.FilePath -> GHC.Base.String -> GHC.Base.String universalNewlineMode :: NewlineMode @@ -8171,7 +7862,6 @@ module GHC.IO.Unsafe where module GHC.IOArray where -- Safety: Unsafe - IOArray :: forall i e. GHC.Arr.STArray GHC.Prim.RealWorld i e -> IOArray i e type role IOArray nominal representational type IOArray :: * -> * -> * newtype IOArray i e = IOArray (GHC.Arr.STArray GHC.Prim.RealWorld i e) @@ -8184,7 +7874,6 @@ module GHC.IOArray where module GHC.IOPort where -- Safety: Unsafe - IOPort :: forall a. GHC.Prim.IOPort# GHC.Prim.RealWorld a -> IOPort a type IOPort :: * -> * data IOPort a = IOPort (GHC.Prim.IOPort# GHC.Prim.RealWorld a) doubleReadException :: GHC.Exception.Type.SomeException @@ -8195,7 +7884,6 @@ module GHC.IOPort where module GHC.IORef where -- Safety: Unsafe - IORef :: forall a. GHC.STRef.STRef GHC.Prim.RealWorld a -> IORef a type IORef :: * -> * newtype IORef a = IORef (GHC.STRef.STRef GHC.Prim.RealWorld a) atomicModifyIORef' :: forall a b. IORef a -> (a -> (a, b)) -> GHC.Types.IO b @@ -8211,19 +7899,11 @@ module GHC.IORef where module GHC.InfoProv where -- Safety: Trustworthy - InfoProv :: GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> InfoProv type InfoProv :: * data InfoProv = InfoProv {ipName :: GHC.Base.String, ipDesc :: GHC.Base.String, ipTyDesc :: GHC.Base.String, ipLabel :: GHC.Base.String, ipMod :: GHC.Base.String, ipSrcFile :: GHC.Base.String, ipSrcSpan :: GHC.Base.String} type InfoProvEnt :: * data InfoProvEnt - ipDesc :: InfoProv -> GHC.Base.String - ipLabel :: InfoProv -> GHC.Base.String ipLoc :: InfoProv -> GHC.Base.String - ipMod :: InfoProv -> GHC.Base.String - ipName :: InfoProv -> GHC.Base.String - ipSrcFile :: InfoProv -> GHC.Base.String - ipSrcSpan :: InfoProv -> GHC.Base.String - ipTyDesc :: InfoProv -> GHC.Base.String ipeProv :: GHC.Ptr.Ptr InfoProvEnt -> GHC.Ptr.Ptr InfoProv peekInfoProv :: GHC.Ptr.Ptr InfoProv -> GHC.Types.IO InfoProv whereFrom :: forall a. a -> GHC.Types.IO (GHC.Maybe.Maybe InfoProv) @@ -8419,7 +8099,6 @@ module GHC.List where module GHC.MVar where -- Safety: Unsafe - MVar :: forall a. GHC.Prim.MVar# GHC.Prim.RealWorld a -> MVar a type MVar :: * -> * data MVar a = MVar (GHC.Prim.MVar# GHC.Prim.RealWorld a) addMVarFinalizer :: forall a. MVar a -> GHC.Types.IO () -> GHC.Types.IO () @@ -9156,11 +8835,9 @@ module GHC.Profiling where module GHC.Ptr where -- Safety: Unsafe - FunPtr :: forall a. GHC.Prim.Addr# -> FunPtr a type role FunPtr phantom type FunPtr :: * -> * data FunPtr a = FunPtr GHC.Prim.Addr# - Ptr :: forall a. GHC.Prim.Addr# -> Ptr a type role Ptr phantom type Ptr :: * -> * data Ptr a = Ptr GHC.Prim.Addr# @@ -9176,13 +8853,10 @@ module GHC.Ptr where module GHC.RTS.Flags where -- Safety: None - CCFlags :: DoCostCentres -> GHC.Types.Int -> GHC.Types.Int -> CCFlags type CCFlags :: * data CCFlags = CCFlags {doCostCentres :: DoCostCentres, profilerTicks :: GHC.Types.Int, msecsPerTick :: GHC.Types.Int} - ConcFlags :: RtsTime -> GHC.Types.Int -> ConcFlags type ConcFlags :: * data ConcFlags = ConcFlags {ctxtSwitchTime :: RtsTime, ctxtSwitchTicks :: GHC.Types.Int} - DebugFlags :: GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> DebugFlags type DebugFlags :: * data DebugFlags = DebugFlags {scheduler :: GHC.Types.Bool, interpreter :: GHC.Types.Bool, weak :: GHC.Types.Bool, gccafs :: GHC.Types.Bool, gc :: GHC.Types.Bool, nonmoving_gc :: GHC.Types.Bool, block_alloc :: GHC.Types.Bool, sanity :: GHC.Types.Bool, stable :: GHC.Types.Bool, prof :: GHC.Types.Bool, linker :: GHC.Types.Bool, apply :: GHC.Types.Bool, stm :: GHC.Types.Bool, squeeze :: GHC.Types.Bool, hpc :: GHC.Types.Bool, sparks :: GHC.Types.Bool} type DoCostCentres :: * @@ -9191,7 +8865,6 @@ module GHC.RTS.Flags where data DoHeapProfile = NoHeapProfiling | HeapByCCS | HeapByMod | HeapByDescr | HeapByType | HeapByRetainer | HeapByLDV | HeapByClosureType | HeapByInfoTable type DoTrace :: * data DoTrace = TraceNone | TraceEventLog | TraceStderr - GCFlags :: GHC.Maybe.Maybe GHC.IO.FilePath -> GiveGCStats -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Types.Double -> GHC.Types.Double -> GHC.Types.Double -> GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Double -> GHC.Types.Bool -> GHC.Types.Bool -> RtsTime -> GHC.Types.Bool -> GHC.Types.Word -> GHC.Types.Word -> GHC.Types.Bool -> GHC.Types.Word -> GCFlags type GCFlags :: * data GCFlags = GCFlags {statsFile :: GHC.Maybe.Maybe GHC.IO.FilePath, @@ -9226,51 +8899,20 @@ module GHC.RTS.Flags where data GiveGCStats = NoGCStats | CollectGCStats | OneLineGCStats | SummaryGCStats | VerboseGCStats type IoSubSystem :: * data IoSubSystem = IoPOSIX | IoNative - MiscFlags :: RtsTime -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Word -> IoSubSystem -> GHC.Word.Word32 -> MiscFlags type MiscFlags :: * data MiscFlags = MiscFlags {tickInterval :: RtsTime, installSignalHandlers :: GHC.Types.Bool, installSEHHandlers :: GHC.Types.Bool, generateCrashDumpFile :: GHC.Types.Bool, generateStackTrace :: GHC.Types.Bool, machineReadable :: GHC.Types.Bool, disableDelayedOsMemoryReturn :: GHC.Types.Bool, internalCounters :: GHC.Types.Bool, linkerAlwaysPic :: GHC.Types.Bool, linkerMemBase :: GHC.Types.Word, ioManager :: IoSubSystem, numIoWorkerThreads :: GHC.Word.Word32} - ParFlags :: GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Types.Bool -> ParFlags type ParFlags :: * data ParFlags = ParFlags {nCapabilities :: GHC.Word.Word32, migrate :: GHC.Types.Bool, maxLocalSparks :: GHC.Word.Word32, parGcEnabled :: GHC.Types.Bool, parGcGen :: GHC.Word.Word32, parGcLoadBalancingEnabled :: GHC.Types.Bool, parGcLoadBalancingGen :: GHC.Word.Word32, parGcNoSyncWithIdle :: GHC.Word.Word32, parGcThreads :: GHC.Word.Word32, setAffinity :: GHC.Types.Bool} - ProfFlags :: DoHeapProfile -> RtsTime -> GHC.Types.Word -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Word -> GHC.Types.Word -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> ProfFlags type ProfFlags :: * data ProfFlags = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String} - RTSFlags :: GCFlags -> ConcFlags -> MiscFlags -> DebugFlags -> CCFlags -> ProfFlags -> TraceFlags -> TickyFlags -> ParFlags -> RTSFlags type RTSFlags :: * data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags} type RtsTime :: * type RtsTime = GHC.Word.Word64 - TickyFlags :: GHC.Types.Bool -> GHC.Maybe.Maybe GHC.IO.FilePath -> TickyFlags type TickyFlags :: * data TickyFlags = TickyFlags {showTickyStats :: GHC.Types.Bool, tickyFile :: GHC.Maybe.Maybe GHC.IO.FilePath} - TraceFlags :: DoTrace -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> TraceFlags type TraceFlags :: * data TraceFlags = TraceFlags {tracing :: DoTrace, timestamp :: GHC.Types.Bool, traceScheduler :: GHC.Types.Bool, traceGc :: GHC.Types.Bool, traceNonmovingGc :: GHC.Types.Bool, sparksSampled :: GHC.Types.Bool, sparksFull :: GHC.Types.Bool, user :: GHC.Types.Bool} - allocLimitGrace :: GCFlags -> GHC.Types.Word - apply :: DebugFlags -> GHC.Types.Bool - bioSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String - block_alloc :: DebugFlags -> GHC.Types.Bool - ccSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String - ccsLength :: ProfFlags -> GHC.Types.Word - ccsSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String - compact :: GCFlags -> GHC.Types.Bool - compactThreshold :: GCFlags -> GHC.Types.Double - concurrentFlags :: RTSFlags -> ConcFlags - costCentreFlags :: RTSFlags -> CCFlags - ctxtSwitchTicks :: ConcFlags -> GHC.Types.Int - ctxtSwitchTime :: ConcFlags -> RtsTime - debugFlags :: RTSFlags -> DebugFlags - descrSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String - disableDelayedOsMemoryReturn :: MiscFlags -> GHC.Types.Bool - doCostCentres :: CCFlags -> DoCostCentres - doHeapProfile :: ProfFlags -> DoHeapProfile - doIdleGC :: GCFlags -> GHC.Types.Bool - gc :: DebugFlags -> GHC.Types.Bool - gcFlags :: RTSFlags -> GCFlags - gccafs :: DebugFlags -> GHC.Types.Bool - generateCrashDumpFile :: MiscFlags -> GHC.Types.Bool - generateStackTrace :: MiscFlags -> GHC.Types.Bool - generations :: GCFlags -> GHC.Word.Word32 getCCFlags :: GHC.Types.IO CCFlags getConcFlags :: GHC.Types.IO ConcFlags getDebugFlags :: GHC.Types.IO DebugFlags @@ -9282,85 +8924,6 @@ module GHC.RTS.Flags where getRTSFlags :: GHC.Types.IO RTSFlags getTickyFlags :: GHC.Types.IO TickyFlags getTraceFlags :: GHC.Types.IO TraceFlags - giveStats :: GCFlags -> GiveGCStats - heapBase :: GCFlags -> GHC.Types.Word - heapProfileInterval :: ProfFlags -> RtsTime - heapProfileIntervalTicks :: ProfFlags -> GHC.Types.Word - heapSizeSuggestion :: GCFlags -> GHC.Word.Word32 - heapSizeSuggestionAuto :: GCFlags -> GHC.Types.Bool - hpc :: DebugFlags -> GHC.Types.Bool - idleGCDelayTime :: GCFlags -> RtsTime - initialStkSize :: GCFlags -> GHC.Word.Word32 - installSEHHandlers :: MiscFlags -> GHC.Types.Bool - installSignalHandlers :: MiscFlags -> GHC.Types.Bool - internalCounters :: MiscFlags -> GHC.Types.Bool - interpreter :: DebugFlags -> GHC.Types.Bool - ioManager :: MiscFlags -> IoSubSystem - largeAllocLim :: GCFlags -> GHC.Word.Word32 - linker :: DebugFlags -> GHC.Types.Bool - linkerAlwaysPic :: MiscFlags -> GHC.Types.Bool - linkerMemBase :: MiscFlags -> GHC.Types.Word - machineReadable :: MiscFlags -> GHC.Types.Bool - maxHeapSize :: GCFlags -> GHC.Word.Word32 - maxLocalSparks :: ParFlags -> GHC.Word.Word32 - maxRetainerSetSize :: ProfFlags -> GHC.Types.Word - maxStkSize :: GCFlags -> GHC.Word.Word32 - migrate :: ParFlags -> GHC.Types.Bool - minAllocAreaSize :: GCFlags -> GHC.Word.Word32 - minOldGenSize :: GCFlags -> GHC.Word.Word32 - miscFlags :: RTSFlags -> MiscFlags - modSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String - msecsPerTick :: CCFlags -> GHC.Types.Int - nCapabilities :: ParFlags -> GHC.Word.Word32 - nonmoving_gc :: DebugFlags -> GHC.Types.Bool - numIoWorkerThreads :: MiscFlags -> GHC.Word.Word32 - numa :: GCFlags -> GHC.Types.Bool - numaMask :: GCFlags -> GHC.Types.Word - nurseryChunkSize :: GCFlags -> GHC.Word.Word32 - oldGenFactor :: GCFlags -> GHC.Types.Double - parFlags :: RTSFlags -> ParFlags - parGcEnabled :: ParFlags -> GHC.Types.Bool - parGcGen :: ParFlags -> GHC.Word.Word32 - parGcLoadBalancingEnabled :: ParFlags -> GHC.Types.Bool - parGcLoadBalancingGen :: ParFlags -> GHC.Word.Word32 - parGcNoSyncWithIdle :: ParFlags -> GHC.Word.Word32 - parGcThreads :: ParFlags -> GHC.Word.Word32 - pcFreeHeap :: GCFlags -> GHC.Types.Double - prof :: DebugFlags -> GHC.Types.Bool - profilerTicks :: CCFlags -> GHC.Types.Int - profilingFlags :: RTSFlags -> ProfFlags - retainerSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String - returnDecayFactor :: GCFlags -> GHC.Types.Double - ringBell :: GCFlags -> GHC.Types.Bool - sanity :: DebugFlags -> GHC.Types.Bool - scheduler :: DebugFlags -> GHC.Types.Bool - setAffinity :: ParFlags -> GHC.Types.Bool - showCCSOnException :: ProfFlags -> GHC.Types.Bool - showTickyStats :: TickyFlags -> GHC.Types.Bool - sparks :: DebugFlags -> GHC.Types.Bool - sparksFull :: TraceFlags -> GHC.Types.Bool - sparksSampled :: TraceFlags -> GHC.Types.Bool - squeeze :: DebugFlags -> GHC.Types.Bool - squeezeUpdFrames :: GCFlags -> GHC.Types.Bool - stable :: DebugFlags -> GHC.Types.Bool - startHeapProfileAtStartup :: ProfFlags -> GHC.Types.Bool - statsFile :: GCFlags -> GHC.Maybe.Maybe GHC.IO.FilePath - stkChunkBufferSize :: GCFlags -> GHC.Word.Word32 - stkChunkSize :: GCFlags -> GHC.Word.Word32 - stm :: DebugFlags -> GHC.Types.Bool - sweep :: GCFlags -> GHC.Types.Bool - tickInterval :: MiscFlags -> RtsTime - tickyFile :: TickyFlags -> GHC.Maybe.Maybe GHC.IO.FilePath - tickyFlags :: RTSFlags -> TickyFlags - timestamp :: TraceFlags -> GHC.Types.Bool - traceFlags :: RTSFlags -> TraceFlags - traceGc :: TraceFlags -> GHC.Types.Bool - traceNonmovingGc :: TraceFlags -> GHC.Types.Bool - traceScheduler :: TraceFlags -> GHC.Types.Bool - tracing :: TraceFlags -> DoTrace - typeSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String - user :: TraceFlags -> GHC.Types.Bool - weak :: DebugFlags -> GHC.Types.Bool module GHC.Read where -- Safety: Trustworthy @@ -9480,13 +9043,11 @@ module GHC.ResponseFile where module GHC.ST where -- Safety: Unsafe - ST :: forall s a. STRep s a -> ST s a type role ST nominal representational type ST :: * -> * -> * newtype ST s a = ST (STRep s a) type STRep :: * -> * -> * type STRep s a = GHC.Prim.State# s -> (# GHC.Prim.State# s, a #) - STret :: forall s a. GHC.Prim.State# s -> a -> STret s a type role STret nominal representational type STret :: * -> * -> * data STret s a = STret (GHC.Prim.State# s) a @@ -9497,7 +9058,6 @@ module GHC.ST where module GHC.STRef where -- Safety: Unsafe - STRef :: forall s a. GHC.Prim.MutVar# s a -> STRef s a type role STRef nominal representational type STRef :: * -> * -> * data STRef s a = STRef (GHC.Prim.MutVar# s a) @@ -9534,7 +9094,6 @@ module GHC.Show where module GHC.Stable where -- Safety: Unsafe - StablePtr :: forall a. GHC.Prim.StablePtr# a -> StablePtr a type StablePtr :: * -> * data StablePtr a = StablePtr (GHC.Prim.StablePtr# a) castPtrToStablePtr :: forall a. GHC.Ptr.Ptr () -> StablePtr a @@ -9545,7 +9104,6 @@ module GHC.Stable where module GHC.StableName where -- Safety: Trustworthy - StableName :: forall a. GHC.Prim.StableName# a -> StableName a type role StableName phantom type StableName :: * -> * data StableName a = StableName (GHC.Prim.StableName# a) @@ -9563,7 +9121,6 @@ module GHC.Stack where data CostCentreStack type HasCallStack :: Constraint type HasCallStack = ?callStack::CallStack :: Constraint - SrcLoc :: [GHC.Types.Char] -> [GHC.Types.Char] -> [GHC.Types.Char] -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc type SrcLoc :: * data SrcLoc = SrcLoc {srcLocPackage :: [GHC.Types.Char], srcLocModule :: [GHC.Types.Char], srcLocFile :: [GHC.Types.Char], srcLocStartLine :: GHC.Types.Int, srcLocStartCol :: GHC.Types.Int, srcLocEndLine :: GHC.Types.Int, srcLocEndCol :: GHC.Types.Int} callStack :: HasCallStack => CallStack @@ -9587,13 +9144,6 @@ module GHC.Stack where prettySrcLoc :: SrcLoc -> GHC.Base.String pushCallStack :: ([GHC.Types.Char], SrcLoc) -> CallStack -> CallStack renderStack :: [GHC.Base.String] -> GHC.Base.String - srcLocEndCol :: SrcLoc -> GHC.Types.Int - srcLocEndLine :: SrcLoc -> GHC.Types.Int - srcLocFile :: SrcLoc -> [GHC.Types.Char] - srcLocModule :: SrcLoc -> [GHC.Types.Char] - srcLocPackage :: SrcLoc -> [GHC.Types.Char] - srcLocStartCol :: SrcLoc -> GHC.Types.Int - srcLocStartLine :: SrcLoc -> GHC.Types.Int whoCreated :: forall a. a -> GHC.Types.IO [GHC.Base.String] withFrozenCallStack :: forall a. HasCallStack => (HasCallStack => a) -> a @@ -9618,19 +9168,13 @@ module GHC.Stack.CCS where module GHC.Stack.CloneStack where -- Safety: None - StackEntry :: GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Types.Word -> StackEntry type StackEntry :: * data StackEntry = StackEntry {functionName :: GHC.Base.String, moduleName :: GHC.Base.String, srcLoc :: GHC.Base.String, closureType :: GHC.Types.Word} - StackSnapshot :: GHC.Prim.StackSnapshot# -> StackSnapshot type StackSnapshot :: * data StackSnapshot = StackSnapshot GHC.Prim.StackSnapshot# cloneMyStack :: GHC.Types.IO StackSnapshot cloneThreadStack :: GHC.Conc.Sync.ThreadId -> GHC.Types.IO StackSnapshot - closureType :: StackEntry -> GHC.Types.Word decode :: StackSnapshot -> GHC.Types.IO [StackEntry] - functionName :: StackEntry -> GHC.Base.String - moduleName :: StackEntry -> GHC.Base.String - srcLoc :: StackEntry -> GHC.Base.String module GHC.Stack.Types where -- Safety: Trustworthy @@ -9638,7 +9182,6 @@ module GHC.Stack.Types where data CallStack = EmptyCallStack | PushCallStack [GHC.Types.Char] SrcLoc CallStack | FreezeCallStack CallStack type HasCallStack :: Constraint type HasCallStack = ?callStack::CallStack :: Constraint - SrcLoc :: [GHC.Types.Char] -> [GHC.Types.Char] -> [GHC.Types.Char] -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc type SrcLoc :: * data SrcLoc = SrcLoc {srcLocPackage :: [GHC.Types.Char], srcLocModule :: [GHC.Types.Char], srcLocFile :: [GHC.Types.Char], srcLocStartLine :: GHC.Types.Int, srcLocStartCol :: GHC.Types.Int, srcLocEndLine :: GHC.Types.Int, srcLocEndCol :: GHC.Types.Int} emptyCallStack :: CallStack @@ -9646,13 +9189,6 @@ module GHC.Stack.Types where fromCallSiteList :: [([GHC.Types.Char], SrcLoc)] -> CallStack getCallStack :: CallStack -> [([GHC.Types.Char], SrcLoc)] pushCallStack :: ([GHC.Types.Char], SrcLoc) -> CallStack -> CallStack - srcLocEndCol :: SrcLoc -> GHC.Types.Int - srcLocEndLine :: SrcLoc -> GHC.Types.Int - srcLocFile :: SrcLoc -> [GHC.Types.Char] - srcLocModule :: SrcLoc -> [GHC.Types.Char] - srcLocPackage :: SrcLoc -> [GHC.Types.Char] - srcLocStartCol :: SrcLoc -> GHC.Types.Int - srcLocStartLine :: SrcLoc -> GHC.Types.Int module GHC.StaticPtr where -- Safety: None @@ -9664,13 +9200,9 @@ module GHC.StaticPtr where type StaticKey = GHC.Fingerprint.Type.Fingerprint type StaticPtr :: * -> * data StaticPtr a = ... - StaticPtrInfo :: GHC.Base.String -> GHC.Base.String -> (GHC.Types.Int, GHC.Types.Int) -> StaticPtrInfo type StaticPtrInfo :: * data StaticPtrInfo = StaticPtrInfo {spInfoUnitId :: GHC.Base.String, spInfoModuleName :: GHC.Base.String, spInfoSrcLoc :: (GHC.Types.Int, GHC.Types.Int)} deRefStaticPtr :: forall a. StaticPtr a -> a - spInfoModuleName :: StaticPtrInfo -> GHC.Base.String - spInfoSrcLoc :: StaticPtrInfo -> (GHC.Types.Int, GHC.Types.Int) - spInfoUnitId :: StaticPtrInfo -> GHC.Base.String staticKey :: forall a. StaticPtr a -> StaticKey staticPtrInfo :: forall a. StaticPtr a -> StaticPtrInfo staticPtrKeys :: GHC.Types.IO [StaticKey] @@ -9678,7 +9210,6 @@ module GHC.StaticPtr where module GHC.Stats where -- Safety: Trustworthy - GCDetails :: GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> GCDetails type GCDetails :: * data GCDetails = GCDetails {gcdetails_gen :: GHC.Word.Word32, @@ -9698,7 +9229,6 @@ module GHC.Stats where gcdetails_elapsed_ns :: RtsTime, gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime, gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime} - RTSStats :: GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> GCDetails -> RTSStats type RTSStats :: * data RTSStats = RTSStats {gcs :: GHC.Word.Word32, @@ -9731,53 +9261,8 @@ module GHC.Stats where gc :: GCDetails} type RtsTime :: * type RtsTime = GHC.Int.Int64 - allocated_bytes :: RTSStats -> GHC.Word.Word64 - copied_bytes :: RTSStats -> GHC.Word.Word64 - cpu_ns :: RTSStats -> RtsTime - cumulative_live_bytes :: RTSStats -> GHC.Word.Word64 - cumulative_par_balanced_copied_bytes :: RTSStats -> GHC.Word.Word64 - cumulative_par_max_copied_bytes :: RTSStats -> GHC.Word.Word64 - elapsed_ns :: RTSStats -> RtsTime - gc :: RTSStats -> GCDetails - gc_cpu_ns :: RTSStats -> RtsTime - gc_elapsed_ns :: RTSStats -> RtsTime - gcdetails_allocated_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_block_fragmentation_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_compact_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_copied_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_cpu_ns :: GCDetails -> RtsTime - gcdetails_elapsed_ns :: GCDetails -> RtsTime - gcdetails_gen :: GCDetails -> GHC.Word.Word32 - gcdetails_large_objects_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_live_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_mem_in_use_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_nonmoving_gc_sync_cpu_ns :: GCDetails -> RtsTime - gcdetails_nonmoving_gc_sync_elapsed_ns :: GCDetails -> RtsTime - gcdetails_par_balanced_copied_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_par_max_copied_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_slop_bytes :: GCDetails -> GHC.Word.Word64 - gcdetails_sync_elapsed_ns :: GCDetails -> RtsTime - gcdetails_threads :: GCDetails -> GHC.Word.Word32 - gcs :: RTSStats -> GHC.Word.Word32 getRTSStats :: GHC.Types.IO RTSStats getRTSStatsEnabled :: GHC.Types.IO GHC.Types.Bool - init_cpu_ns :: RTSStats -> RtsTime - init_elapsed_ns :: RTSStats -> RtsTime - major_gcs :: RTSStats -> GHC.Word.Word32 - max_compact_bytes :: RTSStats -> GHC.Word.Word64 - max_large_objects_bytes :: RTSStats -> GHC.Word.Word64 - max_live_bytes :: RTSStats -> GHC.Word.Word64 - max_mem_in_use_bytes :: RTSStats -> GHC.Word.Word64 - max_slop_bytes :: RTSStats -> GHC.Word.Word64 - mutator_cpu_ns :: RTSStats -> RtsTime - mutator_elapsed_ns :: RTSStats -> RtsTime - nonmoving_gc_cpu_ns :: RTSStats -> RtsTime - nonmoving_gc_elapsed_ns :: RTSStats -> RtsTime - nonmoving_gc_max_elapsed_ns :: RTSStats -> RtsTime - nonmoving_gc_sync_cpu_ns :: RTSStats -> RtsTime - nonmoving_gc_sync_elapsed_ns :: RTSStats -> RtsTime - nonmoving_gc_sync_max_elapsed_ns :: RTSStats -> RtsTime - par_copied_bytes :: RTSStats -> GHC.Word.Word64 module GHC.Storable where -- Safety: Trustworthy @@ -9910,13 +9395,10 @@ module GHC.TypeLits where type role SSymbol phantom type SSymbol :: Symbol -> * newtype SSymbol s = ... - SomeChar :: forall (n :: GHC.Types.Char). KnownChar n => Data.Proxy.Proxy n -> SomeChar type SomeChar :: * data SomeChar = forall (n :: GHC.Types.Char). KnownChar n => SomeChar (Data.Proxy.Proxy n) - SomeNat :: forall (n :: Nat). KnownNat n => Data.Proxy.Proxy n -> SomeNat type SomeNat :: * data SomeNat = forall (n :: Nat). KnownNat n => SomeNat (Data.Proxy.Proxy n) - SomeSymbol :: forall (n :: Symbol). KnownSymbol n => Data.Proxy.Proxy n -> SomeSymbol type SomeSymbol :: * data SomeSymbol = forall (n :: Symbol). KnownSymbol n => SomeSymbol (Data.Proxy.Proxy n) type Symbol :: * @@ -9996,7 +9478,6 @@ module GHC.TypeNats where type role SNat phantom type SNat :: Nat -> * newtype SNat n = ... - SomeNat :: forall (n :: Nat). KnownNat n => Data.Proxy.Proxy n -> SomeNat type SomeNat :: * data SomeNat = forall (n :: Nat). KnownNat n => SomeNat (Data.Proxy.Proxy n) type (^) :: Natural -> Natural -> Natural @@ -10048,7 +9529,6 @@ module GHC.Unicode where module GHC.Weak where -- Safety: Unsafe - Weak :: forall v. GHC.Prim.Weak# v -> Weak v type Weak :: * -> * data Weak v = Weak (GHC.Prim.Weak# v) deRefWeak :: forall v. Weak v -> GHC.Types.IO (GHC.Maybe.Maybe v) @@ -10561,7 +10041,6 @@ module System.IO where data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode type Newline :: * data Newline = LF | CRLF - NewlineMode :: Newline -> Newline -> NewlineMode type NewlineMode :: * data NewlineMode = NewlineMode {inputNL :: Newline, outputNL :: Newline} type SeekMode :: * @@ -10615,7 +10094,6 @@ module System.IO where hShow :: Handle -> IO GHC.Base.String hTell :: Handle -> IO GHC.Num.Integer.Integer hWaitForInput :: Handle -> GHC.Types.Int -> IO GHC.Types.Bool - inputNL :: NewlineMode -> Newline interact :: (GHC.Base.String -> GHC.Base.String) -> IO () isEOF :: IO GHC.Types.Bool latin1 :: TextEncoding @@ -10630,7 +10108,6 @@ module System.IO where openFile :: FilePath -> IOMode -> IO Handle openTempFile :: FilePath -> GHC.Base.String -> IO (FilePath, Handle) openTempFileWithDefaultPermissions :: FilePath -> GHC.Base.String -> IO (FilePath, Handle) - outputNL :: NewlineMode -> Newline print :: forall a. GHC.Show.Show a => a -> IO () putChar :: GHC.Types.Char -> IO () putStr :: GHC.Base.String -> IO () @@ -10966,14 +10443,12 @@ module Text.ParserCombinators.ReadPrec where module Text.Printf where -- Safety: Safe - FieldFormat :: GHC.Maybe.Maybe GHC.Types.Int -> GHC.Maybe.Maybe GHC.Types.Int -> GHC.Maybe.Maybe FormatAdjustment -> GHC.Maybe.Maybe FormatSign -> GHC.Types.Bool -> GHC.Base.String -> GHC.Types.Char -> FieldFormat type FieldFormat :: * data FieldFormat = FieldFormat {fmtWidth :: GHC.Maybe.Maybe GHC.Types.Int, fmtPrecision :: GHC.Maybe.Maybe GHC.Types.Int, fmtAdjust :: GHC.Maybe.Maybe FormatAdjustment, fmtSign :: GHC.Maybe.Maybe FormatSign, fmtAlternate :: GHC.Types.Bool, fmtModifiers :: GHC.Base.String, fmtChar :: GHC.Types.Char} type FieldFormatter :: * type FieldFormatter = FieldFormat -> GHC.Show.ShowS type FormatAdjustment :: * data FormatAdjustment = LeftAdjust | ZeroPad - FormatParse :: GHC.Base.String -> GHC.Types.Char -> GHC.Base.String -> FormatParse type FormatParse :: * data FormatParse = FormatParse {fpModifiers :: GHC.Base.String, fpChar :: GHC.Types.Char, fpRest :: GHC.Base.String} type FormatSign :: * @@ -11002,21 +10477,11 @@ module Text.Printf where errorBadFormat :: forall a. GHC.Types.Char -> a errorMissingArgument :: forall a. a errorShortFormat :: forall a. a - fmtAdjust :: FieldFormat -> GHC.Maybe.Maybe FormatAdjustment - fmtAlternate :: FieldFormat -> GHC.Types.Bool - fmtChar :: FieldFormat -> GHC.Types.Char - fmtModifiers :: FieldFormat -> GHC.Base.String - fmtPrecision :: FieldFormat -> GHC.Maybe.Maybe GHC.Types.Int - fmtSign :: FieldFormat -> GHC.Maybe.Maybe FormatSign - fmtWidth :: FieldFormat -> GHC.Maybe.Maybe GHC.Types.Int formatChar :: GHC.Types.Char -> FieldFormatter formatInt :: forall a. (GHC.Real.Integral a, GHC.Enum.Bounded a) => a -> FieldFormatter formatInteger :: GHC.Num.Integer.Integer -> FieldFormatter formatRealFloat :: forall a. GHC.Float.RealFloat a => a -> FieldFormatter formatString :: forall a. IsChar a => [a] -> FieldFormatter - fpChar :: FormatParse -> GHC.Types.Char - fpModifiers :: FormatParse -> GHC.Base.String - fpRest :: FormatParse -> GHC.Base.String hPrintf :: forall r. HPrintfType r => GHC.IO.Handle.Types.Handle -> GHC.Base.String -> r perror :: forall a. GHC.Base.String -> a printf :: forall r. PrintfType r => GHC.Base.String -> r @@ -11068,7 +10533,7 @@ module Text.Read where module Text.Read.Lex where -- Safety: Trustworthy type Lexeme :: * - data Lexeme = Char GHC.Types.Char | String GHC.Base.String | Punc GHC.Base.String | Ident GHC.Base.String | Symbol GHC.Base.String | ... | EOF + data Lexeme = Char GHC.Types.Char | String GHC.Base.String | Punc GHC.Base.String | Ident GHC.Base.String | Symbol GHC.Base.String | Number Number | EOF type Number :: * data Number = ... expect :: Lexeme -> Text.ParserCombinators.ReadP.ReadP () @@ -11121,7 +10586,6 @@ module Type.Reflection where pattern Fun :: forall k (fun :: k). () => forall (r1 :: GHC.Types.RuntimeRep) (r2 :: GHC.Types.RuntimeRep) (arg :: TYPE r1) (res :: TYPE r2). (k ~ *, fun ~~ (arg -> res)) => TypeRep arg -> TypeRep res -> TypeRep fun type Module :: * data Module = ... - SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep type SomeTypeRep :: * data SomeTypeRep where SomeTypeRep :: forall k (a :: k). !(TypeRep a) -> SomeTypeRep ===================================== utils/dump-decls/Main.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Types.Unique.Set (nonDetEltsUniqSet) import GHC.Types.TyThing (tyThingParent_maybe) import GHC.Types.TyThing.Ppr (pprTyThing) import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) -import GHC.Types.Name.Occurrence (OccName, OccSet, mkOccSet, elemOccSet) +import GHC.Types.Name.Occurrence (OccName) import GHC.Unit.External (eps_inst_env) import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) import GHC.Iface.Type (ShowForAllFlag(..)) @@ -127,11 +127,11 @@ reportModuleDecls modl_nm let names = GHC.modInfoExports mod_info sorted_names = sortBy (compare `on` nameOccName) names - exported_occs :: OccSet - exported_occs = mkOccSet $ map nameOccName names + exported_occs :: [OccName] + exported_occs = map nameOccName names is_exported :: OccName -> Bool - is_exported = (`elemOccSet` exported_occs) + is_exported = (`elem` exported_occs) things <- mapM GHC.lookupName sorted_names let contents = vcat $ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7ca88b0bec358b5f57affda1514cc74b3337fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7ca88b0bec358b5f57affda1514cc74b3337fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 11:59:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 07:59:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: base: Export {get,set}ExceptionFinalizer from System.Mem.Weak Message-ID: <64637016667d2_171ad99b1753e01191638@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 9b71f890 by Josh Meredith at 2023-05-16T07:59:10-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 3fca6feb by Zubin Duggal at 2023-05-16T07:59:11-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - bf25d15a by Zubin Duggal at 2023-05-16T07:59:11-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - bf16934e by Zubin Duggal at 2023-05-16T07:59:11-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 12cc0147 by Zubin Duggal at 2023-05-16T07:59:11-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/IPE.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Types/Tickish.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06aee51968e65dbd5ca7cb79702cce7b9c7cda18...12cc0147d2ef7ecffb6721714369691e973e9350 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06aee51968e65dbd5ca7cb79702cce7b9c7cda18...12cc0147d2ef7ecffb6721714369691e973e9350 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 12:08:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 16 May 2023 08:08:03 -0400 Subject: [Git][ghc/ghc][wip/clear-block-info] rts: Clear block_info when unblocking Message-ID: <6463722353b2d_171ad99af7f7e81203527@gitlab.mail> Ben Gamari pushed to branch wip/clear-block-info at Glasgow Haskell Compiler / GHC Commits: c8f74d5f by Ben Gamari at 2023-05-16T08:07:57-04:00 rts: Clear block_info when unblocking Otherwise we may end up with dangling pointers which may complicate debugging. Also, introduce more strict checking of block_info in checkTSO. - - - - - 7 changed files: - rts/RaiseAsync.c - rts/Schedule.c - rts/Threads.c - rts/include/rts/storage/TSO.h - rts/posix/Select.c - rts/sm/Sanity.c - rts/win32/AsyncMIO.c Changes: ===================================== rts/RaiseAsync.c ===================================== @@ -729,6 +729,7 @@ removeFromQueues(Capability *cap, StgTSO *tso) done: tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap, tso); } @@ -1092,6 +1093,7 @@ done: // wake it up if (tso->why_blocked != NotBlocked) { tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); } ===================================== rts/Schedule.c ===================================== @@ -2565,7 +2565,8 @@ resumeThread (void *task_) traceEventRunThread(cap, tso); /* Reset blocking status */ - tso->why_blocked = NotBlocked; + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; if ((tso->flags & TSO_BLOCKEX) == 0) { // avoid locking the TSO if we don't have to ===================================== rts/Threads.c ===================================== @@ -334,6 +334,7 @@ unblock: // just run the thread now, if the BH is not really available, // we'll block again. tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); // We used to set the context switch flag here, which would ===================================== rts/include/rts/storage/TSO.h ===================================== @@ -289,8 +289,8 @@ void setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target); void dirty_STACK (Capability *cap, StgStack *stack); /* ----------------------------------------------------------------------------- - Invariants: - + Note [TSO invariants] + ~~~~~~~~~~~~~~~~~~~~~ An active thread has the following properties: tso->stack < tso->sp < tso->stack+tso->stack_size ===================================== rts/posix/Select.c ===================================== @@ -106,6 +106,7 @@ static bool wakeUpSleepingThreads (Capability *cap, LowResTime now) } iomgr->sleeping_queue = tso->_link; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %" FMT_StgThreadID "\n", tso->id)); @@ -437,6 +438,7 @@ awaitEvent(Capability *cap, bool wait) debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap,tso); break; ===================================== rts/sm/Sanity.c ===================================== @@ -737,6 +737,7 @@ checkSTACK (StgStack *stack) checkStackChunk(sp, stack_end); } +/* See Note [TSO invariants] in TSO.h */ void checkTSO(StgTSO *tso) { @@ -750,13 +751,42 @@ checkTSO(StgTSO *tso) info == &stg_WHITEHOLE_info); // used to happen due to STM doing // lockTSO(), might not happen now - if ( tso->why_blocked == BlockedOnMVar - || tso->why_blocked == BlockedOnMVarRead - || tso->why_blocked == BlockedOnBlackHole - || tso->why_blocked == BlockedOnMsgThrowTo - || tso->why_blocked == NotBlocked - ) { - ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + switch (tso->why_blocked) { + case NotBlocked: + ASSERT(tso->block_info.closure == (StgClosure*) END_TSO_QUEUE); + break; + case BlockedOnMVar: + case BlockedOnMVarRead: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + ASSERT(get_itbl(tso->block_info.closure) == MVAR_CLEAN + || get_itbl(tso->block_info.closure) == MVAR_DIRTY); + break; + case BlockedOnBlackHole: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + ASSERT(get_itbl(tso->block_info.closure) == &stg_MSG_BLACKHOLE_info); + break; + case BlockedOnRead: + case BlockedOnWrite: + case BlockedOnDelay: + case BlockedOnDoProc: + ASSERT(tso->block_info.closure == NULL); + break; + case BlockedOnSTM: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + ASSERT(tso->block_info.closure == (StgClosure*) END_TSO_QUEUE + || get_itbl(tso->block_info.closure) == STM_AWOKEN); + break; + case BlockedOnCCall: + case BlockedOnCCall_Interruptible: + break; + case BlockedOnMsgThrowTo: + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); + ASSERT(get_itbl(tso->block_info.closure) == &stg_MSG_THROWTO_info); + break; + case ThreadMigrating: + break; + default: + barf("checkTSO: Invalid why_blocked %x", tso->why_blocked); } ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ===================================== rts/win32/AsyncMIO.c ===================================== @@ -318,14 +318,16 @@ start: : END_TSO_QUEUE; } - // Terminates the run queue + this inner for-loop. - tso->_link = END_TSO_QUEUE; - tso->why_blocked = NotBlocked; // save the StgAsyncIOResult in the // stg_block_async_info stack frame, because // the block_info field will be overwritten by // pushOnRunQueue(). tso->stackobj->sp[1] = (W_)tso->block_info.async_result; + + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; + // Terminates the run queue + this inner for-loop. + tso->_link = END_TSO_QUEUE; pushOnRunQueue(&MainCapability, tso); break; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8f74d5f6e9874424c1e55f586ff44568308a94c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8f74d5f6e9874424c1e55f586ff44568308a94c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 12:11:59 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 16 May 2023 08:11:59 -0400 Subject: [Git][ghc/ghc][wip/T23025] 60 commits: testsuite: Add test for atomicSwapIORef Message-ID: <6463730f469b0_171ad99aff252c1204162@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23025 at Glasgow Haskell Compiler / GHC Commits: b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - b5369212 by Krzysztof Gogolewski at 2023-05-16T14:10:37+02:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - 1483551f by Krzysztof Gogolewski at 2023-05-16T14:11:33+02:00 WIP: test - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eda0d0da324842d5fed390bc04bbda29cd71cde2...1483551fb9966a6625415bb1e0d90affe28684bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eda0d0da324842d5fed390bc04bbda29cd71cde2...1483551fb9966a6625415bb1e0d90affe28684bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 12:50:43 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 May 2023 08:50:43 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tc-lcl-env-refactor Message-ID: <64637c23a6b0_171ad99a5313a412188b1@gitlab.mail> Matthew Pickering pushed new branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tc-lcl-env-refactor You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 12:52:20 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 May 2023 08:52:20 -0400 Subject: [Git][ghc/ghc][wip/restore-lcl-env] 21 commits: Turn "ambiguous import" error into a panic Message-ID: <64637c842a055_171ad99b1753e01221597@gitlab.mail> Matthew Pickering pushed to branch wip/restore-lcl-env at Glasgow Haskell Compiler / GHC Commits: 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - fc2d8ae7 by Matthew Pickering at 2023-05-16T13:51:36+01:00 Use setSrcSpan rather than setLclEnv in solveForAll TODO Fixes #23390 - - - - - 24 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Errors/Types.hs - + compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8d5fe2522c0bcbb21d9de77004134309cdfe282...fc2d8ae7e89c954758c5c025431f23cb39e84419 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8d5fe2522c0bcbb21d9de77004134309cdfe282...fc2d8ae7e89c954758c5c025431f23cb39e84419 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 13:18:28 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 16 May 2023 09:18:28 -0400 Subject: [Git][ghc/ghc][wip/T23146] 5 commits: Make LFInfos for DataCons on construction Message-ID: <646382a4c0f2a_171ad999e6801812220e9@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: adc3220d by Rodrigo Mesquita at 2023-05-16T14:18:00+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 3e4dc81d by Rodrigo Mesquita at 2023-05-16T14:18:07+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - 19bb23e8 by Rodrigo Mesquita at 2023-05-16T14:18:08+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - 3b953672 by Rodrigo Mesquita at 2023-05-16T14:18:08+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - d8080f75 by Rodrigo Mesquita at 2023-05-16T14:18:08+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,37 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In Core, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist, after CorePrep + only. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConRep`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -209,7 +221,8 @@ Note [Data constructor workers and wrappers] * See Note [Data Constructor Naming] for how the worker and wrapper are named -* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments +* The workers don't take the dcStupidTheta dicts as arguments, while the + wrappers currently do * The wrapper (if it exists) takes dcOrigArgTys as its arguments. The worker takes dataConRepArgTys as its arguments @@ -528,7 +541,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -586,12 +599,22 @@ Function call 'dataConKindEqSpec' returns [k'~k] Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~ -A `DataCon`'s source arity and core representation arity may differ: -`dcSourceArity` does not take constraints into account, but `dcRepArity` does. - -The additional arguments taken into account by `dcRepArity` include quantified -dictionaries and coercion arguments, lifted and unlifted (despite the unlifted -coercion arguments having a zero-width runtime representation). +A `DataCon`'s source and core representation may differ, meaning the source +arity (`dcSourceArity`) and the core representation arity (`dcRepArity`) may +differ too. + +Note that the source arity isn't exactly the number of arguments the data con +/wrapper/ has, since `dcSourceArity` doesn't count constraints -- which may +appear in the wrapper through `DatatypeContexts`, or if the constructor stores a +dictionary. In this sense, the source arity counts the number of non-constraint +arguments that appear at the source level. + On the other hand, the Core representation arity is the number of arguments +of the data constructor in its Core representation, which is also the number +of arguments of the data con /worker/. + +The arity might differ since `dcRepArity` takes into account arguments such as +quantified dictionaries and coercion arguments, lifted and unlifted (despite +the unlifted coercion arguments having a zero-width runtime representation). For example: MkT :: Ord a => a -> T a dcSourceArity = 1 @@ -601,6 +624,15 @@ For example: dcSourceArity = 0 dcRepArity = 1 +The arity might also differ due to unpacking, for example, consider the +following datatype and its wrapper and worker's type: + data V = MkV !() !Int + $WV :: () -> Int -> V + V :: Int# -> V +As you see, because of unpacking we have both dropped the unit argument and +unboxed the Int. In this case, the source arity (which is the arity of the +wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. + Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -969,51 +1001,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (mkLFImported) +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -271,11 +271,11 @@ isTagged v = do TagProper -> True TagTagged -> True TagTuple _ -> True -- Consider unboxed tuples tagged. - False -- Imported - -> return $! + -- Imported + False -> return $! -- Determine whether it is tagged from the LFInfo of the imported id. -- See Note [The LFInfo of Imported Ids] - case mkLFImported v of + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,52 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After the unarisation pass: +* In `StgConApp` and `StgRhsCon` and `StgAlt` we filter out the void arguments, + leaving only non-void ones. +* In `StgApp` and `StgOpApp` we retain void arguments. + +We can do this because we know that `StgConApp` and `StgRhsCon` are saturated applications, +so we lose no information by dropping those void args. In contrast, in `StgApp` we need the + void argument to compare the number of args in the call with the arity of the function. + +This is an open design choice. We could instead choose to treat all these applications +consistently (keeping the void args). But for some reason we don't, and this Note simply +documents that design choice. + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +291,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -422,7 +468,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] Type -- Type, for rewriting to an StgRhsClosure -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList $! reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -867,7 +869,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1660,9 +1662,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2117,7 +2118,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2125,13 +2126,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2189,8 +2190,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -96,6 +96,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import GHC.Data.Maybe (isNothing) import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 @@ -255,130 +256,67 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +-- | The 'LambdaFormInfo' of an imported Id. +-- See Note [The LFInfo of Imported Ids] +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of Just lf_info -> - -- Use the LambdaFormInfo from the interface + -- Use the existing LambdaFormInfo lf_info Nothing - -- Interface doesn't have a LambdaFormInfo, so make a conservative one from the type. - -- See Note [The LFInfo of Imported Ids]; The order of the guards musn't be changed! + -- Doesn't have a LambdaFormInfo, but we know it must be 'LFReEntrant' from its arity | arity > 0 -> LFReEntrant TopLevel arity True ArgUnknown - | Just con <- isDataConId_maybe id - -- See Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] in GHC.StgToCmm.Types - -- and Note [The LFInfo of Imported Ids] below - -> assert (hasNoNonZeroWidthArgs con) $ - LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - + -- We can't be sure of the LambdaFormInfo of this imported Id, + -- so make a conservative one from the type. | otherwise - -> mkLFArgument id -- Not sure of exact arity + -> assert (isNothing (isDataConId_maybe id)) $ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make + mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id - hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys {- Note [The LFInfo of Imported Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As explained in Note [Conveying CAF-info and LFInfo between modules] and -Note [Imported unlifted nullary datacon wrappers must have correct LFInfo], the -LambdaFormInfo records the details of a closure representation and is often, -when optimisations are enabled, serialized to the interface of a module. - -In particular, the `lfInfo` field of the `IdInfo` field of an `Id` -* For Ids defined in this module: is `Nothing` -* For imported Ids: +As explained in Note [Conveying CAF-info and LFInfo between modules] +the LambdaFormInfo records the details of a closure representation and is +often, when optimisations are enabled, serialized to the interface of a module. + +In particular, the `lfInfo` field of the `IdInfo` field of an `Id`: +* For DataCon workers and wrappers is populated as described in +Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make +* For other Ids defined in the module being compiled: is `Nothing` +* For other imported Ids: * is (Just lf_info) if the LFInfo was serialised into the interface file (typically, when the exporting module was compiled with -O) * is Nothing if it wasn't serialised -However, when an interface doesn't have a LambdaFormInfo for some imported Id -(so that its `lfInfo` field is `Nothing`), we can conservatively create one -using `mkLFImported`. - The LambdaFormInfo we give an Id is used in determining how to tag its pointer -(see `litIdInfo`). Therefore, it's crucial we re-construct a LambdaFormInfo as -faithfully as possible or otherwise risk having pointers incorrectly tagged, -which can lead to performance issues and even segmentation faults (see #23231 -and #23146). In particular, saturated data constructor applications *must* be -unambiguously given `LFCon`, and the invariant - - If the LFInfo (serialised or built with mkLFImported) says LFCon, then it - really is a static data constructor, and similar for LFReEntrant - -must be upheld. - -In `mkLFImported`, we make a conservative approximation to the real -LambdaFormInfo as follows: - -(1) Ids with an `idFunRepArity > 0` are `LFReEntrant` and pointers to them are -tagged (by `litIdInfo`) with the corresponding arity. - - This is also true of data con wrappers and workers with arity > 0, - regardless of the runtime relevance of the arguments - - For example, `Just :: a -> Maybe a` is given `LFReEntrant` - and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too - -(2) Data constructors with `idFunRepArity == 0` should be given `LFCon` because -they are fully saturated data constructor applications and pointers to them -should be tagged with the constructor index. - -(2.1) A datacon *wrapper* with zero arity must be a fully saturated application -of the worker to zero-width arguments only (which are dropped after unarisation) - -(2.2) A datacon *worker* with zero arity is trivially fully saturated, it takes -no arguments whatsoever (not even zero-width args) - -To ensure we properly give `LFReEntrant` to data constructors with some arity, -and `LFCon` only to data constructors with zero arity, we must first check for -`arity > 0` and only afterwards `isDataConId` -- the order of the guards in -`mkLFImported` is quite important. - -As an example, consider the following data constructors: - - data T1 a where - TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a - - data T2 a where - TCon2 :: {-# UNPACK #-} !() -> T2 a - - data T3 a where - TCon3 :: T3 '[] - -`TCon1`'s wrapper has a lifted equality argument, which is non-zero-width, while -the worker has an unlifted equality argument, which is zero-width. - -`TCon2`'s wrapper has a lifted equality argument, which is non-zero-width, -while the worker has no arguments. - -`TCon3`'s wrapper has no arguments, and the worker has 1 zero-width argument; -their Core representation: - - $WTCon3 :: T3 '[] - $WTCon3 = TCon3 @[] - - TCon3 :: forall (a :: * -> *). (a ~# []) => T a - TCon3 = /\a. \(co :: a~#[]). TCon3 co - -For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they -both have arity == 1. - -For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 -while the worker is `LFCon` since its arity == 0 - -For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the -worker `LFReEntrant` since its arity == 1 - -One might think we could give *workers* with only zero-width-args the `LFCon` -LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. -However, these workers, albeit rarely used, are unambiguously functions --- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. -See also the discussion in #23158. +(see `litIdInfo` and `lfDynTag`). Therefore, it's crucial we attribute a correct +LambdaFormInfo to imported Ids, or otherwise risk having pointers incorrectly +tagged which can lead to performance issues and even segmentation faults (see +#23231 and Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]). + +In particular, saturated data constructor applications *must* be unambiguously +given `LFCon`, and if the LFInfo says LFCon, then it really is a static data +constructor, and similar for LFReEntrant. + +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: + +(1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is +correct by construction (the invariant being that if it exists, it is correct): + (1.1) Either it was serialised to the interface we're importing the Id from, + (1.2) Or it's a DataCon worker or wrapper and its LFInfo was constructed + according to Note [LFInfo of DataCon workers and wrappers] +(2) When the `lfInfo` field is `Nothing` + (2.1) If the `idFunRepArity` of the Id is known and is greater than 0, then + the Id is unambiguously a function and is given `LFReEntrant`, and pointers + to this Id will be tagged (by `litIdInfo`) with the corresponding arity. + (2.2) Otherwise, we can make a conservative estimate from the type. -} ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -149,7 +149,7 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: @@ -75,9 +75,25 @@ Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As described in `Note [Conveying CAF-info and LFInfo between modules]`, imported unlifted nullary datacons must have their LambdaFormInfo set to -reflect the fact that they are evaluated . This is necessary as otherwise +reflect the fact that they are evaluated. This is necessary as otherwise references to them may be passed untagged to code that expects tagged -references. +references because of the unlifted nature of the argument. + +For example, in + + type T :: UnliftedType + data T = T1 + | T2 + + f :: T -> Int + f x = case x of T1 -> 1; T2 -> 2 + +`f` expects `x` to be evaluated and properly tagged due to its unliftedness. +We can guarantee all occurrences of `T1` and `T2` are considered evaluated and +are properly tagged by giving them the `LFCon` LambdaFormInfo which indicates +they are fully saturated constructor applications. +(The LambdaFormInfo is used to tag the pointer with the tag of the +constructor, in `litIdInfo`) What may be less obvious is that this must be done for not only datacon workers but also *wrappers*. The reason is found in this program @@ -109,11 +125,9 @@ pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage of the unlifted nature of its arguments by omitting handling of the zero tag when scrutinising them. -The fix is straightforward: extend the logic in `mkLFImported` to cover -(nullary) datacon wrappers as well as workers. This is safe because we -know that the wrapper of a nullary datacon will be in WHNF, even if it -includes equalities evidence (since such equalities are not runtime -relevant). This fixed #23146. +The fix is straightforward: ensure we always construct a /correct/ LFInfo for +datacon workers and wrappers, and populate the `lfInfo` with it. See +Note [LFInfo of DataCon workers and wrappers]. This fixed #23146. See also Note [The LFInfo of Imported Ids] -} ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -123,7 +123,8 @@ infixl 1 `setRuleInfo`, `setCafInfo`, `setDmdSigInfo`, `setCprSigInfo`, - `setDemandInfo` + `setDemandInfo`, + `setLFInfo` {- ************************************************************************ * * @@ -401,7 +402,12 @@ data IdInfo -- -- See documentation of the getters for what these packed fields mean. lfInfo :: !(Maybe LambdaFormInfo), - -- ^ See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- ^ If lfInfo = Just info, then the `info` is guaranteed /correct/. + -- If lfInfo = Nothing, then we do not have a `LambdaFormInfo` for this Id, + -- so (for imported Ids) we make a conservative version. + -- See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- For locally-defined Ids other than DataCons, the `lfInfo` field is always Nothing. + -- See also Note [LFInfo of DataCon workers and wrappers] -- See documentation of the getters for what these packed fields mean. tagSig :: !(Maybe TagSig) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Types.SourceText +import GHC.Types.RepType ( countFunRepArgs ) import GHC.Types.Name.Set import GHC.Types.Name import GHC.Types.ForeignCall @@ -87,6 +88,10 @@ import GHC.Data.FastString import GHC.Data.List.SetOps import Data.List ( zipWith4 ) +-- A bit of a shame we must import these here +import GHC.StgToCmm.Types (LambdaFormInfo(..)) +import GHC.Runtime.Heap.Layout (ArgDescr(ArgUnknown)) + {- ************************************************************************ * * @@ -595,11 +600,18 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setLFInfo` wkr_lf_info -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + -- See Note [LFInfo of DataCon workers and wrappers] + wkr_lf_info + | wkr_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wkr_arity wkr_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con ex_tcvs = dataConExTyCoVars data_con @@ -608,6 +620,7 @@ mkDataConWorkId wkr_name data_con `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma `setUnfoldingInfo` newtype_unf + `setLFInfo` (panic "mkDataConWorkId: we should never look at LFInfo for these newtype worker ids") id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) @@ -618,6 +631,82 @@ mkDataConWorkId wkr_name data_con wrapNewTypeBody tycon res_ty_args (Var id_arg1) {- +Note [LFInfo of DataCon workers and wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As noted in Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure, it's +crucial that saturated data con applications are given an LFInfo of `LFCon`. + +Since for data constructors we never serialise the worker and the wrapper (only +the data type declaration), we never serialise their lambda form info either. + +Therefore, when making data constructors workers and wrappers, we construct a +correct `LFInfo` for them right away, and put it it in the `lfInfo` field of the +worker/wrapper Id, ensuring that: + + The `lfInfo` field of a DataCon worker or wrapper is always populated with the correct LFInfo. + +How do we construct a /correct/ LFInfo for workers and wrappers? +(Remember: `LFCon` means "a saturated constructor application") + +(1) Data constructor workers and wrappers with arity > 0 are unambiguously +functions and should be given `LFReEntrant`, regardless of the runtime +relevance of the arguments. + - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, + and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + +(2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes +no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + +(3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. +A datacon /wrapper/ with zero arity must be a fully saturated application of +the worker to zero-width arguments only (which are dropped after unarisation), +and therefore is also given `LFCon`. + +For example, consider the following data constructors: + + data T1 a where + TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a + + data T2 a where + TCon2 :: {-# UNPACK #-} !() -> T2 a + + data T3 a where + TCon3 :: T3 '[] + +`TCon1`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has an unlifted equality argument, which is zero-width. + +`TCon2`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has no arguments. + +Wrinkle (W1). Perhaps surprisingly, it is possible for the /wrapper/ to be an +`LFCon` even though the /worker/ is not. Consider `T3` above. Here is the +Core representation of the worker and wrapper: + + $WTCon3 :: T3 '[] -- Wrapper + $WTCon3 = TCon3 @[] -- A saturated constructor application: LFCon + + TCon3 :: forall (a :: * -> *). (a ~# []) => T a -- Worker + TCon3 = /\a. \(co :: a~#[]). TCon3 co -- A function: LFReEntrant + +For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they +both have arity == 1. + +For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 +while the worker is `LFCon` since its arity == 0 + +For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the +worker `LFReEntrant` since its arity == 1 + +One might think we could give *workers* with only zero-width-args the `LFCon` +LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. +However, these workers are unambiguously functions +-- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. +See also the discussion in #23158. + +See also the Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +in GHC.StgToCmm.Types. + ------------------------------------------------- -- Data constructor representation -- @@ -709,11 +798,18 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + `setLFInfo` wrap_lf_info -- The signature is purely for passes like the Simplifier, not for -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv + -- See Note [LFInfo of DataCon workers and wrappers] + wrap_lf_info + | wrap_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wrap_arity wrap_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + wrap_arg_dmds = replicate (length theta) topDmd ++ map mk_dmd arg_ibangs -- Don't forget the dictionary arguments when building ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty @@ -124,6 +123,10 @@ unwrapType ty | otherwise = NS_Done +-- | Count the arity of a function post-unarisation, including zero-width arguments. +-- +-- The post-unarisation arity may be larger than the arity of the original +-- function type. See Note [Unarisation]. countFunRepArgs :: Arity -> Type -> RepArity countFunRepArgs 0 _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14358f34c34c27d20cc5b676e0b62a069a45d40f...d8080f75bc04d44ae770d36354df5334aa414dbe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14358f34c34c27d20cc5b676e0b62a069a45d40f...d8080f75bc04d44ae770d36354df5334aa414dbe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 13:45:08 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 16 May 2023 09:45:08 -0400 Subject: [Git][ghc/ghc][wip/T23146] 5 commits: Make LFInfos for DataCons on construction Message-ID: <646388e49516e_171ad99b3e9f901232273@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 762aeb57 by Rodrigo Mesquita at 2023-05-16T14:44:46+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 194c0e9e by Rodrigo Mesquita at 2023-05-16T14:44:56+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - b235c246 by Rodrigo Mesquita at 2023-05-16T14:44:56+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - 9a91bf67 by Rodrigo Mesquita at 2023-05-16T14:44:56+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - fa447a63 by Rodrigo Mesquita at 2023-05-16T14:44:56+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,37 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In Core, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist, after CorePrep + only. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConRep`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -209,7 +221,8 @@ Note [Data constructor workers and wrappers] * See Note [Data Constructor Naming] for how the worker and wrapper are named -* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments +* The workers don't take the dcStupidTheta dicts as arguments, while the + wrappers currently do * The wrapper (if it exists) takes dcOrigArgTys as its arguments. The worker takes dataConRepArgTys as its arguments @@ -528,7 +541,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -586,12 +599,22 @@ Function call 'dataConKindEqSpec' returns [k'~k] Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~ -A `DataCon`'s source arity and core representation arity may differ: -`dcSourceArity` does not take constraints into account, but `dcRepArity` does. - -The additional arguments taken into account by `dcRepArity` include quantified -dictionaries and coercion arguments, lifted and unlifted (despite the unlifted -coercion arguments having a zero-width runtime representation). +A `DataCon`'s source and core representation may differ, meaning the source +arity (`dcSourceArity`) and the core representation arity (`dcRepArity`) may +differ too. + +Note that the source arity isn't exactly the number of arguments the data con +/wrapper/ has, since `dcSourceArity` doesn't count constraints -- which may +appear in the wrapper through `DatatypeContexts`, or if the constructor stores a +dictionary. In this sense, the source arity counts the number of non-constraint +arguments that appear at the source level. + On the other hand, the Core representation arity is the number of arguments +of the data constructor in its Core representation, which is also the number +of arguments of the data con /worker/. + +The arity might differ since `dcRepArity` takes into account arguments such as +quantified dictionaries and coercion arguments, lifted and unlifted (despite +the unlifted coercion arguments having a zero-width runtime representation). For example: MkT :: Ord a => a -> T a dcSourceArity = 1 @@ -601,6 +624,15 @@ For example: dcSourceArity = 0 dcRepArity = 1 +The arity might also differ due to unpacking, for example, consider the +following datatype and its wrapper and worker's type: + data V = MkV !() !Int + $WV :: () -> Int -> V + V :: Int# -> V +As you see, because of unpacking we have both dropped the unit argument and +unboxed the Int. In this case, the source arity (which is the arity of the +wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. + Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -969,51 +1001,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (mkLFImported) +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -271,11 +271,11 @@ isTagged v = do TagProper -> True TagTagged -> True TagTuple _ -> True -- Consider unboxed tuples tagged. - False -- Imported - -> return $! + -- Imported + False -> return $! -- Determine whether it is tagged from the LFInfo of the imported id. -- See Note [The LFInfo of Imported Ids] - case mkLFImported v of + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,52 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After the unarisation pass: +* In `StgConApp` and `StgRhsCon` and `StgAlt` we filter out the void arguments, + leaving only non-void ones. +* In `StgApp` and `StgOpApp` we retain void arguments. + +We can do this because we know that `StgConApp` and `StgRhsCon` are saturated applications, +so we lose no information by dropping those void args. In contrast, in `StgApp` we need the + void argument to compare the number of args in the call with the arity of the function. + +This is an open design choice. We could instead choose to treat all these applications +consistently (keeping the void args). But for some reason we don't, and this Note simply +documents that design choice. + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +291,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -422,7 +468,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] Type -- Type, for rewriting to an StgRhsClosure -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList $! reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -867,7 +869,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1660,9 +1662,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2117,7 +2118,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2125,13 +2126,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2189,8 +2190,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -96,6 +96,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import GHC.Data.Maybe (isNothing) import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 @@ -255,130 +256,67 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +-- | The 'LambdaFormInfo' of an imported Id. +-- See Note [The LFInfo of Imported Ids] +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of Just lf_info -> - -- Use the LambdaFormInfo from the interface + -- Use the existing LambdaFormInfo lf_info Nothing - -- Interface doesn't have a LambdaFormInfo, so make a conservative one from the type. - -- See Note [The LFInfo of Imported Ids]; The order of the guards musn't be changed! + -- Doesn't have a LambdaFormInfo, but we know it must be 'LFReEntrant' from its arity | arity > 0 -> LFReEntrant TopLevel arity True ArgUnknown - | Just con <- isDataConId_maybe id - -- See Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] in GHC.StgToCmm.Types - -- and Note [The LFInfo of Imported Ids] below - -> assert (hasNoNonZeroWidthArgs con) $ - LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - + -- We can't be sure of the LambdaFormInfo of this imported Id, + -- so make a conservative one from the type. | otherwise - -> mkLFArgument id -- Not sure of exact arity + -> assert (isNothing (isDataConId_maybe id)) $ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make + mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id - hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys {- Note [The LFInfo of Imported Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As explained in Note [Conveying CAF-info and LFInfo between modules] and -Note [Imported unlifted nullary datacon wrappers must have correct LFInfo], the -LambdaFormInfo records the details of a closure representation and is often, -when optimisations are enabled, serialized to the interface of a module. - -In particular, the `lfInfo` field of the `IdInfo` field of an `Id` -* For Ids defined in this module: is `Nothing` -* For imported Ids: +As explained in Note [Conveying CAF-info and LFInfo between modules] +the LambdaFormInfo records the details of a closure representation and is +often, when optimisations are enabled, serialized to the interface of a module. + +In particular, the `lfInfo` field of the `IdInfo` field of an `Id`: +* For DataCon workers and wrappers is populated as described in +Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make +* For other Ids defined in the module being compiled: is `Nothing` +* For other imported Ids: * is (Just lf_info) if the LFInfo was serialised into the interface file (typically, when the exporting module was compiled with -O) * is Nothing if it wasn't serialised -However, when an interface doesn't have a LambdaFormInfo for some imported Id -(so that its `lfInfo` field is `Nothing`), we can conservatively create one -using `mkLFImported`. - The LambdaFormInfo we give an Id is used in determining how to tag its pointer -(see `litIdInfo`). Therefore, it's crucial we re-construct a LambdaFormInfo as -faithfully as possible or otherwise risk having pointers incorrectly tagged, -which can lead to performance issues and even segmentation faults (see #23231 -and #23146). In particular, saturated data constructor applications *must* be -unambiguously given `LFCon`, and the invariant - - If the LFInfo (serialised or built with mkLFImported) says LFCon, then it - really is a static data constructor, and similar for LFReEntrant - -must be upheld. - -In `mkLFImported`, we make a conservative approximation to the real -LambdaFormInfo as follows: - -(1) Ids with an `idFunRepArity > 0` are `LFReEntrant` and pointers to them are -tagged (by `litIdInfo`) with the corresponding arity. - - This is also true of data con wrappers and workers with arity > 0, - regardless of the runtime relevance of the arguments - - For example, `Just :: a -> Maybe a` is given `LFReEntrant` - and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too - -(2) Data constructors with `idFunRepArity == 0` should be given `LFCon` because -they are fully saturated data constructor applications and pointers to them -should be tagged with the constructor index. - -(2.1) A datacon *wrapper* with zero arity must be a fully saturated application -of the worker to zero-width arguments only (which are dropped after unarisation) - -(2.2) A datacon *worker* with zero arity is trivially fully saturated, it takes -no arguments whatsoever (not even zero-width args) - -To ensure we properly give `LFReEntrant` to data constructors with some arity, -and `LFCon` only to data constructors with zero arity, we must first check for -`arity > 0` and only afterwards `isDataConId` -- the order of the guards in -`mkLFImported` is quite important. - -As an example, consider the following data constructors: - - data T1 a where - TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a - - data T2 a where - TCon2 :: {-# UNPACK #-} !() -> T2 a - - data T3 a where - TCon3 :: T3 '[] - -`TCon1`'s wrapper has a lifted equality argument, which is non-zero-width, while -the worker has an unlifted equality argument, which is zero-width. - -`TCon2`'s wrapper has a lifted equality argument, which is non-zero-width, -while the worker has no arguments. - -`TCon3`'s wrapper has no arguments, and the worker has 1 zero-width argument; -their Core representation: - - $WTCon3 :: T3 '[] - $WTCon3 = TCon3 @[] - - TCon3 :: forall (a :: * -> *). (a ~# []) => T a - TCon3 = /\a. \(co :: a~#[]). TCon3 co - -For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they -both have arity == 1. - -For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 -while the worker is `LFCon` since its arity == 0 - -For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the -worker `LFReEntrant` since its arity == 1 - -One might think we could give *workers* with only zero-width-args the `LFCon` -LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. -However, these workers, albeit rarely used, are unambiguously functions --- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. -See also the discussion in #23158. +(see `litIdInfo` and `lfDynTag`). Therefore, it's crucial we attribute a correct +LambdaFormInfo to imported Ids, or otherwise risk having pointers incorrectly +tagged which can lead to performance issues and even segmentation faults (see +#23231 and Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]). + +In particular, saturated data constructor applications *must* be unambiguously +given `LFCon`, and if the LFInfo says LFCon, then it really is a static data +constructor, and similar for LFReEntrant. + +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: + +(1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is +correct by construction (the invariant being that if it exists, it is correct): + (1.1) Either it was serialised to the interface we're importing the Id from, + (1.2) Or it's a DataCon worker or wrapper and its LFInfo was constructed + according to Note [LFInfo of DataCon workers and wrappers] +(2) When the `lfInfo` field is `Nothing` + (2.1) If the `idFunRepArity` of the Id is known and is greater than 0, then + the Id is unambiguously a function and is given `LFReEntrant`, and pointers + to this Id will be tagged (by `litIdInfo`) with the corresponding arity. + (2.2) Otherwise, we can make a conservative estimate from the type. -} ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -149,7 +149,7 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: @@ -75,9 +75,25 @@ Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As described in `Note [Conveying CAF-info and LFInfo between modules]`, imported unlifted nullary datacons must have their LambdaFormInfo set to -reflect the fact that they are evaluated . This is necessary as otherwise +reflect the fact that they are evaluated. This is necessary as otherwise references to them may be passed untagged to code that expects tagged -references. +references because of the unlifted nature of the argument. + +For example, in + + type T :: UnliftedType + data T = T1 + | T2 + + f :: T -> Int + f x = case x of T1 -> 1; T2 -> 2 + +`f` expects `x` to be evaluated and properly tagged due to its unliftedness. +We can guarantee all occurrences of `T1` and `T2` are considered evaluated and +are properly tagged by giving them the `LFCon` LambdaFormInfo which indicates +they are fully saturated constructor applications. +(The LambdaFormInfo is used to tag the pointer with the tag of the +constructor, in `litIdInfo`) What may be less obvious is that this must be done for not only datacon workers but also *wrappers*. The reason is found in this program @@ -109,11 +125,9 @@ pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage of the unlifted nature of its arguments by omitting handling of the zero tag when scrutinising them. -The fix is straightforward: extend the logic in `mkLFImported` to cover -(nullary) datacon wrappers as well as workers. This is safe because we -know that the wrapper of a nullary datacon will be in WHNF, even if it -includes equalities evidence (since such equalities are not runtime -relevant). This fixed #23146. +The fix is straightforward: ensure we always construct a /correct/ LFInfo for +datacon workers and wrappers, and populate the `lfInfo` with it. See +Note [LFInfo of DataCon workers and wrappers]. This fixed #23146. See also Note [The LFInfo of Imported Ids] -} ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -123,7 +123,8 @@ infixl 1 `setRuleInfo`, `setCafInfo`, `setDmdSigInfo`, `setCprSigInfo`, - `setDemandInfo` + `setDemandInfo`, + `setLFInfo` {- ************************************************************************ * * @@ -401,7 +402,12 @@ data IdInfo -- -- See documentation of the getters for what these packed fields mean. lfInfo :: !(Maybe LambdaFormInfo), - -- ^ See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- ^ If lfInfo = Just info, then the `info` is guaranteed /correct/. + -- If lfInfo = Nothing, then we do not have a `LambdaFormInfo` for this Id, + -- so (for imported Ids) we make a conservative version. + -- See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- For locally-defined Ids other than DataCons, the `lfInfo` field is always Nothing. + -- See also Note [LFInfo of DataCon workers and wrappers] -- See documentation of the getters for what these packed fields mean. tagSig :: !(Maybe TagSig) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Types.SourceText +import GHC.Types.RepType ( countFunRepArgs ) import GHC.Types.Name.Set import GHC.Types.Name import GHC.Types.ForeignCall @@ -87,6 +88,10 @@ import GHC.Data.FastString import GHC.Data.List.SetOps import Data.List ( zipWith4 ) +-- A bit of a shame we must import these here +import GHC.StgToCmm.Types (LambdaFormInfo(..)) +import GHC.Runtime.Heap.Layout (ArgDescr(ArgUnknown)) + {- ************************************************************************ * * @@ -595,11 +600,18 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setLFInfo` wkr_lf_info -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + -- See Note [LFInfo of DataCon workers and wrappers] + wkr_lf_info + | wkr_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wkr_arity wkr_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con ex_tcvs = dataConExTyCoVars data_con @@ -608,6 +620,10 @@ mkDataConWorkId wkr_name data_con `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma `setUnfoldingInfo` newtype_unf + -- We don't generate code for newtype workers/wrappers, so we + -- should never have to look at their LFInfo (and in general + -- we can't; they may be representation-polymorphic). + `setLFInfo` (panic "mkDataConWorkId: we shouldn't look at LFInfo for newtype worker ids") id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) @@ -618,6 +634,82 @@ mkDataConWorkId wkr_name data_con wrapNewTypeBody tycon res_ty_args (Var id_arg1) {- +Note [LFInfo of DataCon workers and wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As noted in Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure, it's +crucial that saturated data con applications are given an LFInfo of `LFCon`. + +Since for data constructors we never serialise the worker and the wrapper (only +the data type declaration), we never serialise their lambda form info either. + +Therefore, when making data constructors workers and wrappers, we construct a +correct `LFInfo` for them right away, and put it it in the `lfInfo` field of the +worker/wrapper Id, ensuring that: + + The `lfInfo` field of a DataCon worker or wrapper is always populated with the correct LFInfo. + +How do we construct a /correct/ LFInfo for workers and wrappers? +(Remember: `LFCon` means "a saturated constructor application") + +(1) Data constructor workers and wrappers with arity > 0 are unambiguously +functions and should be given `LFReEntrant`, regardless of the runtime +relevance of the arguments. + - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, + and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + +(2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes +no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + +(3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. +A datacon /wrapper/ with zero arity must be a fully saturated application of +the worker to zero-width arguments only (which are dropped after unarisation), +and therefore is also given `LFCon`. + +For example, consider the following data constructors: + + data T1 a where + TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a + + data T2 a where + TCon2 :: {-# UNPACK #-} !() -> T2 a + + data T3 a where + TCon3 :: T3 '[] + +`TCon1`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has an unlifted equality argument, which is zero-width. + +`TCon2`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has no arguments. + +Wrinkle (W1). Perhaps surprisingly, it is possible for the /wrapper/ to be an +`LFCon` even though the /worker/ is not. Consider `T3` above. Here is the +Core representation of the worker and wrapper: + + $WTCon3 :: T3 '[] -- Wrapper + $WTCon3 = TCon3 @[] -- A saturated constructor application: LFCon + + TCon3 :: forall (a :: * -> *). (a ~# []) => T a -- Worker + TCon3 = /\a. \(co :: a~#[]). TCon3 co -- A function: LFReEntrant + +For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they +both have arity == 1. + +For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 +while the worker is `LFCon` since its arity == 0 + +For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the +worker `LFReEntrant` since its arity == 1 + +One might think we could give *workers* with only zero-width-args the `LFCon` +LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. +However, these workers are unambiguously functions +-- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. +See also the discussion in #23158. + +See also the Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +in GHC.StgToCmm.Types. + ------------------------------------------------- -- Data constructor representation -- @@ -709,11 +801,18 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + `setLFInfo` wrap_lf_info -- The signature is purely for passes like the Simplifier, not for -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv + -- See Note [LFInfo of DataCon workers and wrappers] + wrap_lf_info + | wrap_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wrap_arity wrap_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + wrap_arg_dmds = replicate (length theta) topDmd ++ map mk_dmd arg_ibangs -- Don't forget the dictionary arguments when building ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty @@ -124,6 +123,10 @@ unwrapType ty | otherwise = NS_Done +-- | Count the arity of a function post-unarisation, including zero-width arguments. +-- +-- The post-unarisation arity may be larger than the arity of the original +-- function type. See Note [Unarisation]. countFunRepArgs :: Arity -> Type -> RepArity countFunRepArgs 0 _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d8080f75bc04d44ae770d36354df5334aa414dbe...fa447a6321521c9813678601334d84ce486adb2a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d8080f75bc04d44ae770d36354df5334aa414dbe...fa447a6321521c9813678601334d84ce486adb2a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 13:57:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 16 May 2023 09:57:53 -0400 Subject: [Git][ghc/ghc][wip/T23146] 5 commits: Make LFInfos for DataCons on construction Message-ID: <64638be15f9f4_171ad99ab69d0c12369dd@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 831beea7 by Rodrigo Mesquita at 2023-05-16T14:57:36+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - f4233bf1 by Rodrigo Mesquita at 2023-05-16T14:57:39+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - a3528fad by Rodrigo Mesquita at 2023-05-16T14:57:39+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - aeba0b7a by Rodrigo Mesquita at 2023-05-16T14:57:39+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - efacf82b by Rodrigo Mesquita at 2023-05-16T14:57:39+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,37 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In Core, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist, after CorePrep + only. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConRep`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -209,7 +221,8 @@ Note [Data constructor workers and wrappers] * See Note [Data Constructor Naming] for how the worker and wrapper are named -* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments +* The workers don't take the dcStupidTheta dicts as arguments, while the + wrappers currently do * The wrapper (if it exists) takes dcOrigArgTys as its arguments. The worker takes dataConRepArgTys as its arguments @@ -528,7 +541,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -586,12 +599,22 @@ Function call 'dataConKindEqSpec' returns [k'~k] Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~ -A `DataCon`'s source arity and core representation arity may differ: -`dcSourceArity` does not take constraints into account, but `dcRepArity` does. - -The additional arguments taken into account by `dcRepArity` include quantified -dictionaries and coercion arguments, lifted and unlifted (despite the unlifted -coercion arguments having a zero-width runtime representation). +A `DataCon`'s source and core representation may differ, meaning the source +arity (`dcSourceArity`) and the core representation arity (`dcRepArity`) may +differ too. + +Note that the source arity isn't exactly the number of arguments the data con +/wrapper/ has, since `dcSourceArity` doesn't count constraints -- which may +appear in the wrapper through `DatatypeContexts`, or if the constructor stores a +dictionary. In this sense, the source arity counts the number of non-constraint +arguments that appear at the source level. + On the other hand, the Core representation arity is the number of arguments +of the data constructor in its Core representation, which is also the number +of arguments of the data con /worker/. + +The arity might differ since `dcRepArity` takes into account arguments such as +quantified dictionaries and coercion arguments, lifted and unlifted (despite +the unlifted coercion arguments having a zero-width runtime representation). For example: MkT :: Ord a => a -> T a dcSourceArity = 1 @@ -601,6 +624,15 @@ For example: dcSourceArity = 0 dcRepArity = 1 +The arity might also differ due to unpacking, for example, consider the +following datatype and its wrapper and worker's type: + data V = MkV !() !Int + $WV :: () -> Int -> V + V :: Int# -> V +As you see, because of unpacking we have both dropped the unit argument and +unboxed the Int. In this case, the source arity (which is the arity of the +wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. + Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -969,51 +1001,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (mkLFImported) +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -271,11 +271,11 @@ isTagged v = do TagProper -> True TagTagged -> True TagTuple _ -> True -- Consider unboxed tuples tagged. - False -- Imported - -> return $! + -- Imported + False -> return $! -- Determine whether it is tagged from the LFInfo of the imported id. -- See Note [The LFInfo of Imported Ids] - case mkLFImported v of + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,52 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After the unarisation pass: +* In `StgConApp` and `StgRhsCon` and `StgAlt` we filter out the void arguments, + leaving only non-void ones. +* In `StgApp` and `StgOpApp` we retain void arguments. + +We can do this because we know that `StgConApp` and `StgRhsCon` are saturated applications, +so we lose no information by dropping those void args. In contrast, in `StgApp` we need the + void argument to compare the number of args in the call with the arity of the function. + +This is an open design choice. We could instead choose to treat all these applications +consistently (keeping the void args). But for some reason we don't, and this Note simply +documents that design choice. + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +291,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -422,7 +468,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] Type -- Type, for rewriting to an StgRhsClosure -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList $! reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -867,7 +869,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1660,9 +1662,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2117,7 +2118,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2125,13 +2126,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2189,8 +2190,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -96,6 +96,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import GHC.Data.Maybe (isNothing) import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 @@ -255,130 +256,67 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +-- | The 'LambdaFormInfo' of an imported Id. +-- See Note [The LFInfo of Imported Ids] +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of Just lf_info -> - -- Use the LambdaFormInfo from the interface + -- Use the existing LambdaFormInfo lf_info Nothing - -- Interface doesn't have a LambdaFormInfo, so make a conservative one from the type. - -- See Note [The LFInfo of Imported Ids]; The order of the guards musn't be changed! + -- Doesn't have a LambdaFormInfo, but we know it must be 'LFReEntrant' from its arity | arity > 0 -> LFReEntrant TopLevel arity True ArgUnknown - | Just con <- isDataConId_maybe id - -- See Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] in GHC.StgToCmm.Types - -- and Note [The LFInfo of Imported Ids] below - -> assert (hasNoNonZeroWidthArgs con) $ - LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - + -- We can't be sure of the LambdaFormInfo of this imported Id, + -- so make a conservative one from the type. | otherwise - -> mkLFArgument id -- Not sure of exact arity + -> assert (isNothing (isDataConId_maybe id)) $ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make + mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id - hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys {- Note [The LFInfo of Imported Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As explained in Note [Conveying CAF-info and LFInfo between modules] and -Note [Imported unlifted nullary datacon wrappers must have correct LFInfo], the -LambdaFormInfo records the details of a closure representation and is often, -when optimisations are enabled, serialized to the interface of a module. - -In particular, the `lfInfo` field of the `IdInfo` field of an `Id` -* For Ids defined in this module: is `Nothing` -* For imported Ids: +As explained in Note [Conveying CAF-info and LFInfo between modules] +the LambdaFormInfo records the details of a closure representation and is +often, when optimisations are enabled, serialized to the interface of a module. + +In particular, the `lfInfo` field of the `IdInfo` field of an `Id`: +* For DataCon workers and wrappers is populated as described in +Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make +* For other Ids defined in the module being compiled: is `Nothing` +* For other imported Ids: * is (Just lf_info) if the LFInfo was serialised into the interface file (typically, when the exporting module was compiled with -O) * is Nothing if it wasn't serialised -However, when an interface doesn't have a LambdaFormInfo for some imported Id -(so that its `lfInfo` field is `Nothing`), we can conservatively create one -using `mkLFImported`. - The LambdaFormInfo we give an Id is used in determining how to tag its pointer -(see `litIdInfo`). Therefore, it's crucial we re-construct a LambdaFormInfo as -faithfully as possible or otherwise risk having pointers incorrectly tagged, -which can lead to performance issues and even segmentation faults (see #23231 -and #23146). In particular, saturated data constructor applications *must* be -unambiguously given `LFCon`, and the invariant - - If the LFInfo (serialised or built with mkLFImported) says LFCon, then it - really is a static data constructor, and similar for LFReEntrant - -must be upheld. - -In `mkLFImported`, we make a conservative approximation to the real -LambdaFormInfo as follows: - -(1) Ids with an `idFunRepArity > 0` are `LFReEntrant` and pointers to them are -tagged (by `litIdInfo`) with the corresponding arity. - - This is also true of data con wrappers and workers with arity > 0, - regardless of the runtime relevance of the arguments - - For example, `Just :: a -> Maybe a` is given `LFReEntrant` - and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too - -(2) Data constructors with `idFunRepArity == 0` should be given `LFCon` because -they are fully saturated data constructor applications and pointers to them -should be tagged with the constructor index. - -(2.1) A datacon *wrapper* with zero arity must be a fully saturated application -of the worker to zero-width arguments only (which are dropped after unarisation) - -(2.2) A datacon *worker* with zero arity is trivially fully saturated, it takes -no arguments whatsoever (not even zero-width args) - -To ensure we properly give `LFReEntrant` to data constructors with some arity, -and `LFCon` only to data constructors with zero arity, we must first check for -`arity > 0` and only afterwards `isDataConId` -- the order of the guards in -`mkLFImported` is quite important. - -As an example, consider the following data constructors: - - data T1 a where - TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a - - data T2 a where - TCon2 :: {-# UNPACK #-} !() -> T2 a - - data T3 a where - TCon3 :: T3 '[] - -`TCon1`'s wrapper has a lifted equality argument, which is non-zero-width, while -the worker has an unlifted equality argument, which is zero-width. - -`TCon2`'s wrapper has a lifted equality argument, which is non-zero-width, -while the worker has no arguments. - -`TCon3`'s wrapper has no arguments, and the worker has 1 zero-width argument; -their Core representation: - - $WTCon3 :: T3 '[] - $WTCon3 = TCon3 @[] - - TCon3 :: forall (a :: * -> *). (a ~# []) => T a - TCon3 = /\a. \(co :: a~#[]). TCon3 co - -For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they -both have arity == 1. - -For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 -while the worker is `LFCon` since its arity == 0 - -For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the -worker `LFReEntrant` since its arity == 1 - -One might think we could give *workers* with only zero-width-args the `LFCon` -LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. -However, these workers, albeit rarely used, are unambiguously functions --- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. -See also the discussion in #23158. +(see `litIdInfo` and `lfDynTag`). Therefore, it's crucial we attribute a correct +LambdaFormInfo to imported Ids, or otherwise risk having pointers incorrectly +tagged which can lead to performance issues and even segmentation faults (see +#23231 and Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]). + +In particular, saturated data constructor applications *must* be unambiguously +given `LFCon`, and if the LFInfo says LFCon, then it really is a static data +constructor, and similar for LFReEntrant. + +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: + +(1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is +correct by construction (the invariant being that if it exists, it is correct): + (1.1) Either it was serialised to the interface we're importing the Id from, + (1.2) Or it's a DataCon worker or wrapper and its LFInfo was constructed + according to Note [LFInfo of DataCon workers and wrappers] +(2) When the `lfInfo` field is `Nothing` + (2.1) If the `idFunRepArity` of the Id is known and is greater than 0, then + the Id is unambiguously a function and is given `LFReEntrant`, and pointers + to this Id will be tagged (by `litIdInfo`) with the corresponding arity. + (2.2) Otherwise, we can make a conservative estimate from the type. -} ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -149,7 +149,7 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: @@ -75,9 +75,25 @@ Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As described in `Note [Conveying CAF-info and LFInfo between modules]`, imported unlifted nullary datacons must have their LambdaFormInfo set to -reflect the fact that they are evaluated . This is necessary as otherwise +reflect the fact that they are evaluated. This is necessary as otherwise references to them may be passed untagged to code that expects tagged -references. +references because of the unlifted nature of the argument. + +For example, in + + type T :: UnliftedType + data T = T1 + | T2 + + f :: T -> Int + f x = case x of T1 -> 1; T2 -> 2 + +`f` expects `x` to be evaluated and properly tagged due to its unliftedness. +We can guarantee all occurrences of `T1` and `T2` are considered evaluated and +are properly tagged by giving them the `LFCon` LambdaFormInfo which indicates +they are fully saturated constructor applications. +(The LambdaFormInfo is used to tag the pointer with the tag of the +constructor, in `litIdInfo`) What may be less obvious is that this must be done for not only datacon workers but also *wrappers*. The reason is found in this program @@ -109,11 +125,9 @@ pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage of the unlifted nature of its arguments by omitting handling of the zero tag when scrutinising them. -The fix is straightforward: extend the logic in `mkLFImported` to cover -(nullary) datacon wrappers as well as workers. This is safe because we -know that the wrapper of a nullary datacon will be in WHNF, even if it -includes equalities evidence (since such equalities are not runtime -relevant). This fixed #23146. +The fix is straightforward: ensure we always construct a /correct/ LFInfo for +datacon workers and wrappers, and populate the `lfInfo` with it. See +Note [LFInfo of DataCon workers and wrappers]. This fixed #23146. See also Note [The LFInfo of Imported Ids] -} ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -123,7 +123,8 @@ infixl 1 `setRuleInfo`, `setCafInfo`, `setDmdSigInfo`, `setCprSigInfo`, - `setDemandInfo` + `setDemandInfo`, + `setLFInfo` {- ************************************************************************ * * @@ -401,7 +402,12 @@ data IdInfo -- -- See documentation of the getters for what these packed fields mean. lfInfo :: !(Maybe LambdaFormInfo), - -- ^ See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- ^ If lfInfo = Just info, then the `info` is guaranteed /correct/. + -- If lfInfo = Nothing, then we do not have a `LambdaFormInfo` for this Id, + -- so (for imported Ids) we make a conservative version. + -- See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- For locally-defined Ids other than DataCons, the `lfInfo` field is always Nothing. + -- See also Note [LFInfo of DataCon workers and wrappers] -- See documentation of the getters for what these packed fields mean. tagSig :: !(Maybe TagSig) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Types.SourceText +import GHC.Types.RepType ( countFunRepArgs ) import GHC.Types.Name.Set import GHC.Types.Name import GHC.Types.ForeignCall @@ -87,6 +88,10 @@ import GHC.Data.FastString import GHC.Data.List.SetOps import Data.List ( zipWith4 ) +-- A bit of a shame we must import these here +import GHC.StgToCmm.Types (LambdaFormInfo(..)) +import GHC.Runtime.Heap.Layout (ArgDescr(ArgUnknown)) + {- ************************************************************************ * * @@ -595,11 +600,18 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setLFInfo` wkr_lf_info -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + -- See Note [LFInfo of DataCon workers and wrappers] + wkr_lf_info + | wkr_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wkr_arity wkr_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con ex_tcvs = dataConExTyCoVars data_con @@ -608,6 +620,7 @@ mkDataConWorkId wkr_name data_con `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma `setUnfoldingInfo` newtype_unf + `setLFInfo` (panic "mkDataConWorkId: we shouldn't look at LFInfo for newtype worker ids") id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) @@ -618,6 +631,82 @@ mkDataConWorkId wkr_name data_con wrapNewTypeBody tycon res_ty_args (Var id_arg1) {- +Note [LFInfo of DataCon workers and wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As noted in Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure, it's +crucial that saturated data con applications are given an LFInfo of `LFCon`. + +Since for data constructors we never serialise the worker and the wrapper (only +the data type declaration), we never serialise their lambda form info either. + +Therefore, when making data constructors workers and wrappers, we construct a +correct `LFInfo` for them right away, and put it it in the `lfInfo` field of the +worker/wrapper Id, ensuring that: + + The `lfInfo` field of a DataCon worker or wrapper is always populated with the correct LFInfo. + +How do we construct a /correct/ LFInfo for workers and wrappers? +(Remember: `LFCon` means "a saturated constructor application") + +(1) Data constructor workers and wrappers with arity > 0 are unambiguously +functions and should be given `LFReEntrant`, regardless of the runtime +relevance of the arguments. + - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, + and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + +(2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes +no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + +(3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. +A datacon /wrapper/ with zero arity must be a fully saturated application of +the worker to zero-width arguments only (which are dropped after unarisation), +and therefore is also given `LFCon`. + +For example, consider the following data constructors: + + data T1 a where + TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a + + data T2 a where + TCon2 :: {-# UNPACK #-} !() -> T2 a + + data T3 a where + TCon3 :: T3 '[] + +`TCon1`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has an unlifted equality argument, which is zero-width. + +`TCon2`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has no arguments. + +Wrinkle (W1). Perhaps surprisingly, it is possible for the /wrapper/ to be an +`LFCon` even though the /worker/ is not. Consider `T3` above. Here is the +Core representation of the worker and wrapper: + + $WTCon3 :: T3 '[] -- Wrapper + $WTCon3 = TCon3 @[] -- A saturated constructor application: LFCon + + TCon3 :: forall (a :: * -> *). (a ~# []) => T a -- Worker + TCon3 = /\a. \(co :: a~#[]). TCon3 co -- A function: LFReEntrant + +For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they +both have arity == 1. + +For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 +while the worker is `LFCon` since its arity == 0 + +For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the +worker `LFReEntrant` since its arity == 1 + +One might think we could give *workers* with only zero-width-args the `LFCon` +LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. +However, these workers are unambiguously functions +-- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. +See also the discussion in #23158. + +See also the Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +in GHC.StgToCmm.Types. + ------------------------------------------------- -- Data constructor representation -- @@ -709,11 +798,18 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + `setLFInfo` wrap_lf_info -- The signature is purely for passes like the Simplifier, not for -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv + -- See Note [LFInfo of DataCon workers and wrappers] + wrap_lf_info + | wrap_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wrap_arity wrap_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + wrap_arg_dmds = replicate (length theta) topDmd ++ map mk_dmd arg_ibangs -- Don't forget the dictionary arguments when building ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty @@ -124,6 +123,10 @@ unwrapType ty | otherwise = NS_Done +-- | Count the arity of a function post-unarisation, including zero-width arguments. +-- +-- The post-unarisation arity may be larger than the arity of the original +-- function type. See Note [Unarisation]. countFunRepArgs :: Arity -> Type -> RepArity countFunRepArgs 0 _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fa447a6321521c9813678601334d84ce486adb2a...efacf82b6f8802124f3014aaf01fdaece5126181 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fa447a6321521c9813678601334d84ce486adb2a...efacf82b6f8802124f3014aaf01fdaece5126181 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 13:59:24 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 16 May 2023 09:59:24 -0400 Subject: [Git][ghc/ghc][wip/T23146] 5 commits: Make LFInfos for DataCons on construction Message-ID: <64638c3c3bbef_171ad99a5313a4123777d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 535a40a2 by Rodrigo Mesquita at 2023-05-16T14:59:04+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - b4319077 by Rodrigo Mesquita at 2023-05-16T14:59:09+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - f57adb0f by Rodrigo Mesquita at 2023-05-16T14:59:09+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - b938a8ef by Rodrigo Mesquita at 2023-05-16T14:59:09+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - 9048ced7 by Rodrigo Mesquita at 2023-05-16T14:59:09+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,37 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In Core, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist, after CorePrep + only. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConRep`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -209,7 +221,8 @@ Note [Data constructor workers and wrappers] * See Note [Data Constructor Naming] for how the worker and wrapper are named -* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments +* The workers don't take the dcStupidTheta dicts as arguments, while the + wrappers currently do * The wrapper (if it exists) takes dcOrigArgTys as its arguments. The worker takes dataConRepArgTys as its arguments @@ -528,7 +541,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -586,12 +599,22 @@ Function call 'dataConKindEqSpec' returns [k'~k] Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~ -A `DataCon`'s source arity and core representation arity may differ: -`dcSourceArity` does not take constraints into account, but `dcRepArity` does. - -The additional arguments taken into account by `dcRepArity` include quantified -dictionaries and coercion arguments, lifted and unlifted (despite the unlifted -coercion arguments having a zero-width runtime representation). +A `DataCon`'s source and core representation may differ, meaning the source +arity (`dcSourceArity`) and the core representation arity (`dcRepArity`) may +differ too. + +Note that the source arity isn't exactly the number of arguments the data con +/wrapper/ has, since `dcSourceArity` doesn't count constraints -- which may +appear in the wrapper through `DatatypeContexts`, or if the constructor stores a +dictionary. In this sense, the source arity counts the number of non-constraint +arguments that appear at the source level. + On the other hand, the Core representation arity is the number of arguments +of the data constructor in its Core representation, which is also the number +of arguments of the data con /worker/. + +The arity might differ since `dcRepArity` takes into account arguments such as +quantified dictionaries and coercion arguments, lifted and unlifted (despite +the unlifted coercion arguments having a zero-width runtime representation). For example: MkT :: Ord a => a -> T a dcSourceArity = 1 @@ -601,6 +624,15 @@ For example: dcSourceArity = 0 dcRepArity = 1 +The arity might also differ due to unpacking, for example, consider the +following datatype and its wrapper and worker's type: + data V = MkV !() !Int + $WV :: () -> Int -> V + V :: Int# -> V +As you see, because of unpacking we have both dropped the unit argument and +unboxed the Int. In this case, the source arity (which is the arity of the +wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. + Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -969,51 +1001,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (mkLFImported) +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -271,11 +271,11 @@ isTagged v = do TagProper -> True TagTagged -> True TagTuple _ -> True -- Consider unboxed tuples tagged. - False -- Imported - -> return $! + -- Imported + False -> return $! -- Determine whether it is tagged from the LFInfo of the imported id. -- See Note [The LFInfo of Imported Ids] - case mkLFImported v of + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,52 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After the unarisation pass: +* In `StgConApp` and `StgRhsCon` and `StgAlt` we filter out the void arguments, + leaving only non-void ones. +* In `StgApp` and `StgOpApp` we retain void arguments. + +We can do this because we know that `StgConApp` and `StgRhsCon` are saturated applications, +so we lose no information by dropping those void args. In contrast, in `StgApp` we need the + void argument to compare the number of args in the call with the arity of the function. + +This is an open design choice. We could instead choose to treat all these applications +consistently (keeping the void args). But for some reason we don't, and this Note simply +documents that design choice. + +As an example, consider: + + data T a = MkT Int! a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WT :: Int -> a -> Void# -> T a + T :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = T 1# y + in ... + case x of + T int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +291,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -422,7 +468,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] Type -- Type, for rewriting to an StgRhsClosure -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList $! reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -867,7 +869,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1660,9 +1662,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2117,7 +2118,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2125,13 +2126,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2189,8 +2190,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -96,6 +96,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import GHC.Data.Maybe (isNothing) import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 @@ -255,130 +256,67 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +-- | The 'LambdaFormInfo' of an imported Id. +-- See Note [The LFInfo of Imported Ids] +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of Just lf_info -> - -- Use the LambdaFormInfo from the interface + -- Use the existing LambdaFormInfo lf_info Nothing - -- Interface doesn't have a LambdaFormInfo, so make a conservative one from the type. - -- See Note [The LFInfo of Imported Ids]; The order of the guards musn't be changed! + -- Doesn't have a LambdaFormInfo, but we know it must be 'LFReEntrant' from its arity | arity > 0 -> LFReEntrant TopLevel arity True ArgUnknown - | Just con <- isDataConId_maybe id - -- See Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] in GHC.StgToCmm.Types - -- and Note [The LFInfo of Imported Ids] below - -> assert (hasNoNonZeroWidthArgs con) $ - LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - + -- We can't be sure of the LambdaFormInfo of this imported Id, + -- so make a conservative one from the type. | otherwise - -> mkLFArgument id -- Not sure of exact arity + -> assert (isNothing (isDataConId_maybe id)) $ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make + mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id - hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys {- Note [The LFInfo of Imported Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As explained in Note [Conveying CAF-info and LFInfo between modules] and -Note [Imported unlifted nullary datacon wrappers must have correct LFInfo], the -LambdaFormInfo records the details of a closure representation and is often, -when optimisations are enabled, serialized to the interface of a module. - -In particular, the `lfInfo` field of the `IdInfo` field of an `Id` -* For Ids defined in this module: is `Nothing` -* For imported Ids: +As explained in Note [Conveying CAF-info and LFInfo between modules] +the LambdaFormInfo records the details of a closure representation and is +often, when optimisations are enabled, serialized to the interface of a module. + +In particular, the `lfInfo` field of the `IdInfo` field of an `Id`: +* For DataCon workers and wrappers is populated as described in +Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make +* For other Ids defined in the module being compiled: is `Nothing` +* For other imported Ids: * is (Just lf_info) if the LFInfo was serialised into the interface file (typically, when the exporting module was compiled with -O) * is Nothing if it wasn't serialised -However, when an interface doesn't have a LambdaFormInfo for some imported Id -(so that its `lfInfo` field is `Nothing`), we can conservatively create one -using `mkLFImported`. - The LambdaFormInfo we give an Id is used in determining how to tag its pointer -(see `litIdInfo`). Therefore, it's crucial we re-construct a LambdaFormInfo as -faithfully as possible or otherwise risk having pointers incorrectly tagged, -which can lead to performance issues and even segmentation faults (see #23231 -and #23146). In particular, saturated data constructor applications *must* be -unambiguously given `LFCon`, and the invariant - - If the LFInfo (serialised or built with mkLFImported) says LFCon, then it - really is a static data constructor, and similar for LFReEntrant - -must be upheld. - -In `mkLFImported`, we make a conservative approximation to the real -LambdaFormInfo as follows: - -(1) Ids with an `idFunRepArity > 0` are `LFReEntrant` and pointers to them are -tagged (by `litIdInfo`) with the corresponding arity. - - This is also true of data con wrappers and workers with arity > 0, - regardless of the runtime relevance of the arguments - - For example, `Just :: a -> Maybe a` is given `LFReEntrant` - and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too - -(2) Data constructors with `idFunRepArity == 0` should be given `LFCon` because -they are fully saturated data constructor applications and pointers to them -should be tagged with the constructor index. - -(2.1) A datacon *wrapper* with zero arity must be a fully saturated application -of the worker to zero-width arguments only (which are dropped after unarisation) - -(2.2) A datacon *worker* with zero arity is trivially fully saturated, it takes -no arguments whatsoever (not even zero-width args) - -To ensure we properly give `LFReEntrant` to data constructors with some arity, -and `LFCon` only to data constructors with zero arity, we must first check for -`arity > 0` and only afterwards `isDataConId` -- the order of the guards in -`mkLFImported` is quite important. - -As an example, consider the following data constructors: - - data T1 a where - TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a - - data T2 a where - TCon2 :: {-# UNPACK #-} !() -> T2 a - - data T3 a where - TCon3 :: T3 '[] - -`TCon1`'s wrapper has a lifted equality argument, which is non-zero-width, while -the worker has an unlifted equality argument, which is zero-width. - -`TCon2`'s wrapper has a lifted equality argument, which is non-zero-width, -while the worker has no arguments. - -`TCon3`'s wrapper has no arguments, and the worker has 1 zero-width argument; -their Core representation: - - $WTCon3 :: T3 '[] - $WTCon3 = TCon3 @[] - - TCon3 :: forall (a :: * -> *). (a ~# []) => T a - TCon3 = /\a. \(co :: a~#[]). TCon3 co - -For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they -both have arity == 1. - -For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 -while the worker is `LFCon` since its arity == 0 - -For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the -worker `LFReEntrant` since its arity == 1 - -One might think we could give *workers* with only zero-width-args the `LFCon` -LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. -However, these workers, albeit rarely used, are unambiguously functions --- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. -See also the discussion in #23158. +(see `litIdInfo` and `lfDynTag`). Therefore, it's crucial we attribute a correct +LambdaFormInfo to imported Ids, or otherwise risk having pointers incorrectly +tagged which can lead to performance issues and even segmentation faults (see +#23231 and Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]). + +In particular, saturated data constructor applications *must* be unambiguously +given `LFCon`, and if the LFInfo says LFCon, then it really is a static data +constructor, and similar for LFReEntrant. + +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: + +(1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is +correct by construction (the invariant being that if it exists, it is correct): + (1.1) Either it was serialised to the interface we're importing the Id from, + (1.2) Or it's a DataCon worker or wrapper and its LFInfo was constructed + according to Note [LFInfo of DataCon workers and wrappers] +(2) When the `lfInfo` field is `Nothing` + (2.1) If the `idFunRepArity` of the Id is known and is greater than 0, then + the Id is unambiguously a function and is given `LFReEntrant`, and pointers + to this Id will be tagged (by `litIdInfo`) with the corresponding arity. + (2.2) Otherwise, we can make a conservative estimate from the type. -} ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -149,7 +149,7 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: @@ -75,9 +75,25 @@ Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As described in `Note [Conveying CAF-info and LFInfo between modules]`, imported unlifted nullary datacons must have their LambdaFormInfo set to -reflect the fact that they are evaluated . This is necessary as otherwise +reflect the fact that they are evaluated. This is necessary as otherwise references to them may be passed untagged to code that expects tagged -references. +references because of the unlifted nature of the argument. + +For example, in + + type T :: UnliftedType + data T = T1 + | T2 + + f :: T -> Int + f x = case x of T1 -> 1; T2 -> 2 + +`f` expects `x` to be evaluated and properly tagged due to its unliftedness. +We can guarantee all occurrences of `T1` and `T2` are considered evaluated and +are properly tagged by giving them the `LFCon` LambdaFormInfo which indicates +they are fully saturated constructor applications. +(The LambdaFormInfo is used to tag the pointer with the tag of the +constructor, in `litIdInfo`) What may be less obvious is that this must be done for not only datacon workers but also *wrappers*. The reason is found in this program @@ -109,11 +125,9 @@ pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage of the unlifted nature of its arguments by omitting handling of the zero tag when scrutinising them. -The fix is straightforward: extend the logic in `mkLFImported` to cover -(nullary) datacon wrappers as well as workers. This is safe because we -know that the wrapper of a nullary datacon will be in WHNF, even if it -includes equalities evidence (since such equalities are not runtime -relevant). This fixed #23146. +The fix is straightforward: ensure we always construct a /correct/ LFInfo for +datacon workers and wrappers, and populate the `lfInfo` with it. See +Note [LFInfo of DataCon workers and wrappers]. This fixed #23146. See also Note [The LFInfo of Imported Ids] -} ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -123,7 +123,8 @@ infixl 1 `setRuleInfo`, `setCafInfo`, `setDmdSigInfo`, `setCprSigInfo`, - `setDemandInfo` + `setDemandInfo`, + `setLFInfo` {- ************************************************************************ * * @@ -401,7 +402,12 @@ data IdInfo -- -- See documentation of the getters for what these packed fields mean. lfInfo :: !(Maybe LambdaFormInfo), - -- ^ See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- ^ If lfInfo = Just info, then the `info` is guaranteed /correct/. + -- If lfInfo = Nothing, then we do not have a `LambdaFormInfo` for this Id, + -- so (for imported Ids) we make a conservative version. + -- See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- For locally-defined Ids other than DataCons, the `lfInfo` field is always Nothing. + -- See also Note [LFInfo of DataCon workers and wrappers] -- See documentation of the getters for what these packed fields mean. tagSig :: !(Maybe TagSig) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Types.SourceText +import GHC.Types.RepType ( countFunRepArgs ) import GHC.Types.Name.Set import GHC.Types.Name import GHC.Types.ForeignCall @@ -87,6 +88,10 @@ import GHC.Data.FastString import GHC.Data.List.SetOps import Data.List ( zipWith4 ) +-- A bit of a shame we must import these here +import GHC.StgToCmm.Types (LambdaFormInfo(..)) +import GHC.Runtime.Heap.Layout (ArgDescr(ArgUnknown)) + {- ************************************************************************ * * @@ -595,11 +600,18 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setLFInfo` wkr_lf_info -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + -- See Note [LFInfo of DataCon workers and wrappers] + wkr_lf_info + | wkr_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wkr_arity wkr_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con ex_tcvs = dataConExTyCoVars data_con @@ -608,6 +620,10 @@ mkDataConWorkId wkr_name data_con `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma `setUnfoldingInfo` newtype_unf + -- We don't generate code for newtype workers/wrappers, so we + -- should never have to look at their LFInfo (and in general + -- we can't; they may be representation-polymorphic). + `setLFInfo` (panic "mkDataConWorkId: we shouldn't look at LFInfo for newtype worker ids") id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) @@ -618,6 +634,82 @@ mkDataConWorkId wkr_name data_con wrapNewTypeBody tycon res_ty_args (Var id_arg1) {- +Note [LFInfo of DataCon workers and wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As noted in Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure, it's +crucial that saturated data con applications are given an LFInfo of `LFCon`. + +Since for data constructors we never serialise the worker and the wrapper (only +the data type declaration), we never serialise their lambda form info either. + +Therefore, when making data constructors workers and wrappers, we construct a +correct `LFInfo` for them right away, and put it it in the `lfInfo` field of the +worker/wrapper Id, ensuring that: + + The `lfInfo` field of a DataCon worker or wrapper is always populated with the correct LFInfo. + +How do we construct a /correct/ LFInfo for workers and wrappers? +(Remember: `LFCon` means "a saturated constructor application") + +(1) Data constructor workers and wrappers with arity > 0 are unambiguously +functions and should be given `LFReEntrant`, regardless of the runtime +relevance of the arguments. + - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, + and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + +(2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes +no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + +(3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. +A datacon /wrapper/ with zero arity must be a fully saturated application of +the worker to zero-width arguments only (which are dropped after unarisation), +and therefore is also given `LFCon`. + +For example, consider the following data constructors: + + data T1 a where + TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a + + data T2 a where + TCon2 :: {-# UNPACK #-} !() -> T2 a + + data T3 a where + TCon3 :: T3 '[] + +`TCon1`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has an unlifted equality argument, which is zero-width. + +`TCon2`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has no arguments. + +Wrinkle (W1). Perhaps surprisingly, it is possible for the /wrapper/ to be an +`LFCon` even though the /worker/ is not. Consider `T3` above. Here is the +Core representation of the worker and wrapper: + + $WTCon3 :: T3 '[] -- Wrapper + $WTCon3 = TCon3 @[] -- A saturated constructor application: LFCon + + TCon3 :: forall (a :: * -> *). (a ~# []) => T a -- Worker + TCon3 = /\a. \(co :: a~#[]). TCon3 co -- A function: LFReEntrant + +For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they +both have arity == 1. + +For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 +while the worker is `LFCon` since its arity == 0 + +For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the +worker `LFReEntrant` since its arity == 1 + +One might think we could give *workers* with only zero-width-args the `LFCon` +LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. +However, these workers are unambiguously functions +-- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. +See also the discussion in #23158. + +See also the Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +in GHC.StgToCmm.Types. + ------------------------------------------------- -- Data constructor representation -- @@ -709,11 +801,18 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + `setLFInfo` wrap_lf_info -- The signature is purely for passes like the Simplifier, not for -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv + -- See Note [LFInfo of DataCon workers and wrappers] + wrap_lf_info + | wrap_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wrap_arity wrap_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + wrap_arg_dmds = replicate (length theta) topDmd ++ map mk_dmd arg_ibangs -- Don't forget the dictionary arguments when building ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty @@ -124,6 +123,10 @@ unwrapType ty | otherwise = NS_Done +-- | Count the arity of a function post-unarisation, including zero-width arguments. +-- +-- The post-unarisation arity may be larger than the arity of the original +-- function type. See Note [Unarisation]. countFunRepArgs :: Arity -> Type -> RepArity countFunRepArgs 0 _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efacf82b6f8802124f3014aaf01fdaece5126181...9048ced72ac1d8642990dc64ac7b2aebf1c0bea4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efacf82b6f8802124f3014aaf01fdaece5126181...9048ced72ac1d8642990dc64ac7b2aebf1c0bea4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 14:18:46 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 16 May 2023 10:18:46 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <646390c6cf243_171ad999e6801812509b4@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: cb6e2d6c by Ben Gamari at 2023-05-16T18:17:18+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - + docs/users_guide/exts/implicit_forall.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/exts/type_signatures.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.stderr - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb6e2d6c70bf0aa2d0a539bcf4b9c8d679fdba18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb6e2d6c70bf0aa2d0a539bcf4b9c8d679fdba18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 14:36:03 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 May 2023 10:36:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23398 Message-ID: <646394d3d8b0d_171ad99a5313a41261949@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23398 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23398 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 16:00:10 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 May 2023 12:00:10 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 6 commits: Integrate into zonking patch Message-ID: <6463a88a6d41f_171ad99a5313a413424b1@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 17653635 by Matthew Pickering at 2023-05-16T16:59:59+01:00 Integrate into zonking patch - - - - - 80196d71 by Matthew Pickering at 2023-05-16T16:59:59+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 39450a1d by Matthew Pickering at 2023-05-16T16:59:59+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - f9dfc904 by Matthew Pickering at 2023-05-16T16:59:59+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - 1bf3cd8f by Matthew Pickering at 2023-05-16T16:59:59+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - e7fb7ba4 by Matthew Pickering at 2023-05-16T16:59:59+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75915b28e3ee40c376e4457dcaf002b88170d09f...e7fb7ba4c9d89c24c0d6cc913787adbe532b6666 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75915b28e3ee40c376e4457dcaf002b88170d09f...e7fb7ba4c9d89c24c0d6cc913787adbe532b6666 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 16:14:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 16 May 2023 12:14:59 -0400 Subject: [Git][ghc/ghc][ghc-9.6] 15 commits: users guide: Note that base release notes are highlights of changelog Message-ID: <6463ac03ee1ea_171ad99b3e9f681347122@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: 65023412 by Ben Gamari at 2023-05-11T12:49:10-04:00 users guide: Note that base release notes are highlights of changelog - - - - - e0f3aec8 by Simon Peyton Jones at 2023-05-15T18:34:25-04:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. (cherry picked from commit e45eb82830d6de4d09abb548e190be980dd001b4) - - - - - 595edd68 by Josh Meredith at 2023-05-15T18:34:25-04:00 JS: Fix implementation of MK_JSVAL (cherry picked from commit bab232795865e9abb82b75c7e72329778e23a345) - - - - - dc291c00 by Josh Meredith at 2023-05-15T18:34:25-04:00 JS: fix implementation of forceBool to use JS backend syntax (cherry picked from commit 047e9d4f10e4124899887449dc52b9e72a7d3ea6) - - - - - 3db2b31b by Sebastian Graf at 2023-05-15T18:34:26-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 (cherry picked from commit 559a480427a841b5189f2e6a84a38b02a7c2b8a1) - - - - - 4532771a by Alexis King at 2023-05-15T18:34:26-04:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 (cherry picked from commit bed3a292df532935426987e1f0c5eaa4f605407e) - - - - - f70b9c49 by Matthew Pickering at 2023-05-16T07:56:09-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 (cherry picked from commit d7a768a415c3bd575a20b20ae9a3953aa5886ed7) - - - - - 6cd0f807 by Simon Peyton Jones at 2023-05-16T07:56:09-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 (cherry picked from commit 3b0ea4809d92581a10e0e501a6fbd7339e8922bf) - - - - - 5637364e by Ben Gamari at 2023-05-16T07:56:09-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 (cherry picked from commit d1bb16ed3e18a4f41fcfe31f0bf57dbaf589d6c5) - - - - - 373ec872 by Krzysztof Gogolewski at 2023-05-16T07:56:09-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). (cherry picked from commit 7c16f3be6e1ac92f87d752f12ad6c6e7b7fd6207) - - - - - ab677901 by Ben Gamari at 2023-05-16T07:56:09-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. (cherry picked from commit b8d783d24b9a617ad1e3038abeb75d322703ef65) - - - - - 7083db5a by Sylvain Henry at 2023-05-16T07:56:09-04:00 JS: fix thread-related primops (cherry picked from commit d442ac053f9ac7dbcc32318802daf686f377fe3d) - - - - - 35131c9d by Ben Gamari at 2023-05-16T07:56:09-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 (cherry picked from commit 52d3e9b4189440d26bad9c5a15f9420b67b1ca5b) - - - - - ac639721 by Ben Gamari at 2023-05-16T07:56:09-04:00 testsuite: Add test for #23071 (cherry picked from commit 1db30fe1dd38dd8ffedfadf3845706fcde02933b) - - - - - 1fdbbd8d by sheaf at 2023-05-16T07:56:09-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 (cherry picked from commit df1a581188694479a583270548896245fc23b525) - - - - - 30 changed files: - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Types/Id.hs - docs/index.html → docs/index.html.in - docs/users_guide/9.6.1-notes.rst - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - libraries/base/tests/all.T - + libraries/base/tests/listThreads1.hs - + libraries/base/tests/listThreads1.stdout - rts/Threads.c - rts/include/rts/storage/ClosureMacros.h - rts/js/mem.js - rts/js/thread.js - + testsuite/tests/bytecode/T23068.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40293d4eb0d56fff188b7bbdeb1eb55f40a8981b...1fdbbd8d81b3b5e80e8997d279764f62cdcc3c26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40293d4eb0d56fff188b7bbdeb1eb55f40a8981b...1fdbbd8d81b3b5e80e8997d279764f62cdcc3c26 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 16:14:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 16 May 2023 12:14:58 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.6 Message-ID: <6463ac02adaf9_171ad99aff252c134697b@gitlab.mail> Ben Gamari deleted branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 16:32:14 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 16 May 2023 12:32:14 -0400 Subject: [Git][ghc/ghc][wip/T23025] WIP: test Message-ID: <6463b00e6d4c6_171ad99aff252c1351440@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23025 at Glasgow Haskell Compiler / GHC Commits: b421cc35 by Krzysztof Gogolewski at 2023-05-16T18:32:04+02:00 WIP: test - - - - - 6 changed files: - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/Wasm/Utils.hs Changes: ===================================== compiler/GHC/CmmToAsm/CFG/Dominators.hs ===================================== @@ -2,7 +2,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Strict #-} {- | Module : GHC.CmmToAsm.CFG.Dominators ===================================== compiler/GHC/CmmToAsm/Wasm.hs ===================================== @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} module GHC.CmmToAsm.Wasm (ncgWasm) where ===================================== compiler/GHC/CmmToAsm/Wasm/Asm.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE Strict #-} module GHC.CmmToAsm.Wasm.Asm (asmTellEverything, execWasmAsmM) where ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -6,7 +6,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE Strict #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} ===================================== compiler/GHC/CmmToAsm/Wasm/Types.hs ===================================== @@ -6,7 +6,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE Strict #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-} ===================================== compiler/GHC/CmmToAsm/Wasm/Utils.hs ===================================== @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} module GHC.CmmToAsm.Wasm.Utils ( widthMax, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b421cc354d707a8b1610b68d92c16730fb159598 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b421cc354d707a8b1610b68d92c16730fb159598 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 16:48:45 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 May 2023 12:48:45 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Further improvements to insolubles and ambiguity checking Message-ID: <6463b3ed2edae_171ad99ab69d0c1358334@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: b53bd72d by Simon Peyton Jones at 2023-05-16T17:50:23+01:00 Further improvements to insolubles and ambiguity checking - - - - - 6 changed files: - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs Changes: ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqualityClass, isCTupleClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -217,11 +217,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -232,7 +227,7 @@ isEqPred ty -- True of (a ~ b) and (a ~~ b) -- ToDo: should we check saturation? | Just tc <- tyConAppTyCon_maybe ty , Just cls <- tyConClass_maybe tc - = isEqPredClass cls + = isEqualityClass cls | otherwise = False @@ -240,9 +235,18 @@ isEqPrimPred :: PredType -> Bool isEqPrimPred ty = isCoVarType ty -- True of (a ~# b) (a ~R# b) +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) + {- ********************************************************************* * * Implicit parameters ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -848,15 +848,6 @@ naturallyCoherentClass cls = isCTupleClass cls || isEqualityClass cls -} -isEqualityClass :: Class -> Bool --- True of (~), (~~), and Coercible --- These all have a single primitive-equality superclass, either (~N# or ~R#) -isEqualityClass cls - = cls `hasKey` heqTyConKey - || cls `hasKey` eqTyConKey - || cls `hasKey` coercibleTyConKey - - {- Note [Instance and Given overlap] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Example, from the OutsideIn(X) paper: ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -241,7 +241,7 @@ extendWorkListCt ct wl -> extendWorkListEq rewriters ct wl ClassPred cls _ -- See Note [Prioritise class equalities] - | isEqPredClass cls + | isEqualityClass cls -> extendWorkListEq rewriters ct wl _ -> extendWorkListNonEq ct wl ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -543,7 +543,7 @@ cteSolubleOccurs = CTEP (bit 3) -- Occurs-check under a type function, or in -- or in a representational equality; see -- See Note [Occurs check and representational equality] -- cteSolubleOccurs must be one bit to the left of cteInsolubleOccurs - -- See also Note [Insoluble occurs check] in GHC.Tc.Errors + -- See also Note [Insoluble mis-match] in GHC.Tc.Errors cteCoercionHole = CTEP (bit 4) -- Coercion hole encountered cteConcrete = CTEP (bit 5) -- Type variable that can't be made concrete ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -161,8 +161,8 @@ module GHC.Tc.Utils.TcType ( mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyCoVarTy, mkTyCoVarTys, - isClassPred, isEqPrimPred, isIPLikePred, isEqPred, isEqPredClass, - mkClassPred, + isClassPred, isEqPrimPred, isIPLikePred, isEqPred, + isEqualityClass, mkClassPred, tcSplitQuantPredTy, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy, isRuntimeRepVar, isFixedRuntimeRepKind, isVisiblePiTyBinder, isInvisiblePiTyBinder, @@ -2538,11 +2538,10 @@ isTerminatingClass cls = isIPClass cls -- Implicit parameter constraints always terminate because -- there are no instances for them --- they are only solved -- by "local instances" in expressions - || isEqPredClass cls + || isEqualityClass cls || cls `hasKey` typeableClassKey -- Typeable constraints are bigger than they appear due -- to kind polymorphism, but we can never get instance divergence this way - || cls `hasKey` coercibleTyConKey || cls `hasKey` unsatisfiableClassNameKey allDistinctTyVars :: TyVarSet -> [KindOrType] -> Bool ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -1230,7 +1230,7 @@ e.g. module A where check_class_pred :: TidyEnv -> DynFlags -> UserTypeCtxt -> PredType -> Class -> [TcType] -> TcM () check_class_pred env dflags ctxt pred cls tys - | isEqPredClass cls -- (~) and (~~) are classified as classes, + | isEqualityClass cls -- (~) and (~~) and Coercible are classified as classes, -- but here we want to treat them as equalities = -- Equational constraints are valid in all contexts, and -- we do not need to check e.g. for FlexibleContexts here, so just do nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b53bd72d5eaf8261551fb1c4bf010ba1e50af36d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b53bd72d5eaf8261551fb1c4bf010ba1e50af36d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 17:59:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 13:59:38 -0400 Subject: [Git][ghc/ghc][master] JS: Implement h$clock_gettime in the JavaScript RTS (#23360) Message-ID: <6463c48ac538c_171ad99a48b7101369746@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 3 changed files: - libraries/base/tests/Concurrent/all.T - + rts/js/time.js - rts/rts.cabal.in Changes: ===================================== libraries/base/tests/Concurrent/all.T ===================================== @@ -1,3 +1,3 @@ test('Chan002', [extra_run_opts('100'), fragile(22836)], compile_and_run, ['']) test('Chan003', extra_run_opts('200'), compile_and_run, ['']) -test('ThreadDelay001', js_broken(22374), compile_and_run, ['']) +test('ThreadDelay001', normal, compile_and_run, ['']) ===================================== rts/js/time.js ===================================== @@ -0,0 +1,20 @@ +function h$clock_gettime(when, p_d, p_o) { + var is64 = p_d.i3.length == 4 && p_o == 0; + var o = p_o >> 2; + var t = Date.now ? Date.now() : new Date().getTime(); + var tf = Math.floor(t / 1000); + var tn = 1000000 * (t - (1000 * tf)); + + if (is64) { + p_d.i3[o] = tf|0; + p_d.i3[o+1] = 0; + p_d.i3[o+2] = tn|0; + p_d.i3[o+3] = 0; + } else { + p_d.i3[o] = tf|0; + p_d.i3[o+1] = tn|0; + } + return 0; +} + +function h$CLOCK_REALTIME() { return 0; } ===================================== rts/rts.cabal.in ===================================== @@ -112,6 +112,7 @@ library js/verify.js js/weak.js js/globals.js + js/time.js install-includes: HsFFI.h MachDeps.h Rts.h RtsAPI.h Stg.h ghcautoconf.h ghcconfig.h ghcplatform.h ghcversion.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e3f9bb57680a40f6a9531e41dc2617c5f028e5c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e3f9bb57680a40f6a9531e41dc2617c5f028e5c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 18:00:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 14:00:19 -0400 Subject: [Git][ghc/ghc][master] 4 commits: compiler: Use compact representation for SourceText Message-ID: <6463c4b3f30d6_171ad99a5313a41373285@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/IPE.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Types/Tickish.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e3f9bb57680a40f6a9531e41dc2617c5f028e5c...47a5815070a8ebf4ce1e00de0a44863fd9c1fb84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e3f9bb57680a40f6a9531e41dc2617c5f028e5c...47a5815070a8ebf4ce1e00de0a44863fd9c1fb84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 18:23:40 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Tue, 16 May 2023 14:23:40 -0400 Subject: [Git][ghc/ghc][wip/warns-messages-drivermessage] Don't error on deprecated flags Message-ID: <6463ca2cbd6eb_171ad9a2e1ee501379527@gitlab.mail> Oleg Grenrus pushed to branch wip/warns-messages-drivermessage at Glasgow Haskell Compiler / GHC Commits: aaaa3e77 by Oleg Grenrus at 2023-05-16T21:23:15+03:00 Don't error on deprecated flags .. with werror flavour - - - - - 1 changed file: - hadrian/src/Flavour.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -127,8 +127,9 @@ werror = ( builder Ghc ? notStage0 ? mconcat - [ arg "-Werror", - flag CrossCompiling + [ arg "-Werror" + , arg "-Wwarn=deprecated-flags" + , flag CrossCompiling ? package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaaa3e77a088de691debd7732c4393cf8d7cb5b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaaa3e77a088de691debd7732c4393cf8d7cb5b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 18:31:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 14:31:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: JS: Implement h$clock_gettime in the JavaScript RTS (#23360) Message-ID: <6463cc05a44a2_171ad9a3154de0138339e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 484c6289 by Ben Gamari at 2023-05-16T14:31:17-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 3d2baa25 by Ben Gamari at 2023-05-16T14:31:17-04:00 Update glossary.rst - - - - - 718d6a57 by Ben Gamari at 2023-05-16T14:31:17-04:00 Use glossary directive - - - - - 25e54003 by Sylvain Henry at 2023-05-16T14:31:28-04:00 JS: fix getpid (fix #23399) - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/IPE.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Types/Tickish.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12cc0147d2ef7ecffb6721714369691e973e9350...25e5400381d7656a862578172bd7f1497af41d88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12cc0147d2ef7ecffb6721714369691e973e9350...25e5400381d7656a862578172bd7f1497af41d88 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 19:56:16 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 16 May 2023 15:56:16 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] Remove unecessary SOURCE import Message-ID: <6463dfe09ce1b_171ad9a2996d381401872@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 96d86d8d by Matthew Pickering at 2023-05-16T20:55:53+01:00 Remove unecessary SOURCE import - - - - - 2 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Types/Hint/Ppr.hs Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -76,7 +76,7 @@ import GHC.Types.Name.Set import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.TyThing -import {-# SOURCE #-} GHC.Types.TyThing.Ppr ( pprTyThingInContext ) +import GHC.Types.TyThing.Ppr ( pprTyThingInContext ) import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import GHC.Types.Var import GHC.Types.Var.Set ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Core.TyCon import GHC.Hs.Expr () -- instance Outputable -import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) +import GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96d86d8dcf522d473cd1fda7a8e69d95394dd9ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96d86d8dcf522d473cd1fda7a8e69d95394dd9ee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 20:08:11 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 16 May 2023 16:08:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/lint-stderr Message-ID: <6463e2abf12d6_171ad9a2e1eeb4140551f@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/lint-stderr at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/lint-stderr You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 16 22:17:35 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 16 May 2023 18:17:35 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Wibble imports Message-ID: <646400ffca856_171ad9a2e133fc14274a1@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 18b50348 by Simon Peyton Jones at 2023-05-16T23:17:15+01:00 Wibble imports - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Dict.hs Changes: ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -24,8 +24,6 @@ import GHC.Tc.Utils.Unify( uType ) import GHC.Hs.Type( HsIPName(..) ) -import GHC.Builtin.Names ( coercibleTyConKey, heqTyConKey, eqTyConKey ) - import GHC.Core import GHC.Core.Type import GHC.Core.InstEnv ( DFunInstType, Coherence(..) ) @@ -40,7 +38,6 @@ import GHC.Types.Id( mkTemplateLocals ) import GHC.Types.Var.Set import GHC.Types.SrcLoc import GHC.Types.Var.Env -import GHC.Types.Unique( hasKey ) import GHC.Utils.Monad ( concatMapM, foldlM ) import GHC.Utils.Outputable View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18b50348f130e74b89b4facfb4ad110e6dceea58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18b50348f130e74b89b4facfb4ad110e6dceea58 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 01:31:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 21:31:55 -0400 Subject: [Git][ghc/ghc][master] 3 commits: users guide: Add glossary Message-ID: <64642e8b3a755_171ad9a2e1ee50144073a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2 changed files: - + docs/users_guide/glossary.rst - docs/users_guide/index.rst Changes: ===================================== docs/users_guide/glossary.rst ===================================== @@ -0,0 +1,13 @@ +Glossary +======== + +.. glossary:: + technology preview + + GHC will occassionally ship features advertised as being in a *technology + preview* state. Such features are generally opt-in in nature (e.g. new + language extensions) and may have various shortcomings. These may include + known bugs (which we will try to document), lacking optimisation, and + unhandled interactions with other language features. As such, behavior + of such features may change in the future. However, we do expect features + to converge to non-preview state over the course of a few GHC major releases. ===================================== docs/users_guide/index.rst ===================================== @@ -27,6 +27,7 @@ Contents: wasm bugs eventlog-formats + glossary editing-guide View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47a5815070a8ebf4ce1e00de0a44863fd9c1fb84...3d23060c6f088e786b95865b9ac1ca84e97c1e6d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47a5815070a8ebf4ce1e00de0a44863fd9c1fb84...3d23060c6f088e786b95865b9ac1ca84e97c1e6d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 01:32:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 16 May 2023 21:32:37 -0400 Subject: [Git][ghc/ghc][master] JS: fix getpid (fix #23399) Message-ID: <64642eb5646e4_171ad9a2e1addc144538a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 4 changed files: - libraries/base/System/Posix/Internals.hs - + libraries/base/tests/System/T23399.hs - + libraries/base/tests/System/T23399.stdout - libraries/base/tests/System/all.T Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -499,7 +499,7 @@ foreign import javascript interruptible "(($1,$2_1,$2_2,$c) => { return h$base_f c_ftruncate :: CInt -> FileOffset -> IO CInt foreign import javascript interruptible "(($1_1,$1_2,$c) => { return h$base_unlink($1_1,$1_2,$c); })" c_unlink :: CString -> IO CInt -foreign import javascript unsafe "(() => { return h$base_getpid; })" +foreign import javascript unsafe "h$base_getpid" c_getpid :: IO CPid -- foreign import ccall unsafe "HsBase.h fork" -- c_fork :: IO CPid ===================================== libraries/base/tests/System/T23399.hs ===================================== @@ -0,0 +1,9 @@ +module Main where + +import System.Posix.Internals + +main = do + r <- c_getpid + -- #23399: JS backend wasn't returning a valid JS number as a CPid hence + -- "read" would fail because the string was "0\0" (not a number, NUL byte) + print ((read (show r) :: Int) /= -1) ===================================== libraries/base/tests/System/T23399.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== libraries/base/tests/System/all.T ===================================== @@ -8,3 +8,4 @@ test('system001', [js_broken(22349), when(opsys("mingw32"), skip), req_process], compile_and_run, ['']) test('Timeout001', js_broken(22261), compile_and_run, ['']) test('T16466', normal, compile_and_run, ['']) +test('T23399', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2972fd66f91cb51426a1df86b8166a067015e231 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2972fd66f91cb51426a1df86b8166a067015e231 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 05:53:46 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Wed, 17 May 2023 01:53:46 -0400 Subject: [Git][ghc/ghc][wip/warns-messages-drivermessage] Only warn about deprecated flags in hadrian-multi Message-ID: <64646beaa4c6c_171ad9ab051c9c1468784@gitlab.mail> Oleg Grenrus pushed to branch wip/warns-messages-drivermessage at Glasgow Haskell Compiler / GHC Commits: 422f23a2 by Oleg Grenrus at 2023-05-17T08:53:37+03:00 Only warn about deprecated flags in hadrian-multi - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -396,7 +396,7 @@ hadrian-multi: # workaround for docker permissions - sudo chown ghc:ghc -R . variables: - GHC_FLAGS: -Werror + GHC_FLAGS: -Werror -Wwarn=deprecated-flags CONFIGURE_ARGS: --enable-bootstrap-with-devel-snapshot tags: - x86_64-linux View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/422f23a2343f7d57165ad36d757b3bb9d910e8ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/422f23a2343f7d57165ad36d757b3bb9d910e8ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 06:51:43 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 17 May 2023 02:51:43 -0400 Subject: [Git][ghc/ghc][wip/no-binary-char] 96 commits: Add sized primitive literal syntax Message-ID: <6464797fa3b71_171ad9ab051c9c14721fa@gitlab.mail> Zubin pushed to branch wip/no-binary-char at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 17fcce4c by Zubin Duggal at 2023-05-17T12:21:31+05:30 compiler: Remove instance Binary Char It is generally not a good idea to serialise strings as [Char] into interface files, as upon deserialisation each of these would be turned into a highly memory inefficient structure mostly composed of cons cells and pointers. If you really want to serialise a Char, use the SerialisableChar newtype. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c36c513a9ea619ad7cb0f1c8f22de0407178affe...17fcce4ca5bf1418d8f335e869d328e1913d3f95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c36c513a9ea619ad7cb0f1c8f22de0407178affe...17fcce4ca5bf1418d8f335e869d328e1913d3f95 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 08:10:11 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 17 May 2023 04:10:11 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 10 commits: Zonking monad transformers Message-ID: <64648be3713ec_171ad9ab2836281492650@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 06b5f71d by sheaf at 2023-05-17T09:00:48+01:00 Zonking monad transformers - Introduce two zonking monad transformers, ZonkT and ZonkBndrT. ZonkT is a reader monad transformer over ZonkEnv. ZonkBndrT m is the codensity monad over ZonkT m. ZonkBndrT is used for computations that accumulate binders in the ZonkEnv. - Split up the zonking functions relating purely to types into GHC.Tc.Zonk.Type. This should allow us to introduce a slimmed-down zonking monad, which doesn't wrap the full TcM but a much smaller monad. This opens up the possibility of refactoring ErrCtxt to use this smaller zonking monad. - Refactor the remaining zonking functions to work over the monads ZonkTcM = ZonkT TcM and ZonkBndrTcM = ZonkBndrT TcM. - - - - - e722f3e3 by Matthew Pickering at 2023-05-17T09:00:48+01:00 Use setSrcSpan rather than setLclEnv in solveForAll TODO Fixes #23390 - - - - - b524595e by Matthew Pickering at 2023-05-17T09:06:03+01:00 Split up TcLclEnv from GHC.Tc.Types By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. * New modules for the LclEnv and all its basic parts * CtLocEnv * TcLclCtxt (setLclEnv vs restoreLclEnv) - - - - - 0d0441e9 by Matthew Pickering at 2023-05-17T09:08:49+01:00 Integrate into zonking patch - - - - - c7ef7bc6 by Matthew Pickering at 2023-05-17T09:09:41+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 3ed792c7 by Matthew Pickering at 2023-05-17T09:09:42+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 6cc6c144 by Matthew Pickering at 2023-05-17T09:09:43+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - 740013e9 by Matthew Pickering at 2023-05-17T09:09:43+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 3fb4e6c1 by Matthew Pickering at 2023-05-17T09:09:43+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 0b0e48ad by Matthew Pickering at 2023-05-17T09:09:43+01:00 Remove unecessary SOURCE import - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole.hs-boot - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96d86d8dcf522d473cd1fda7a8e69d95394dd9ee...0b0e48ad87297472d8dacf6e6334b7d29b348fc5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96d86d8dcf522d473cd1fda7a8e69d95394dd9ee...0b0e48ad87297472d8dacf6e6334b7d29b348fc5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 08:17:28 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 17 May 2023 04:17:28 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 4 commits: hole fit plugins: Split definition into own module Message-ID: <64648d98f2929_171ad9ab2847d014930de@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 08992bc4 by Matthew Pickering at 2023-05-17T09:13:36+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - bd960d65 by Matthew Pickering at 2023-05-17T09:13:36+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 38b6f624 by Matthew Pickering at 2023-05-17T09:13:36+01:00 Remove unecessary SOURCE import - - - - - 67225975 by Matthew Pickering at 2023-05-17T09:16:48+01:00 Comment out traceZonk for now - - - - - 18 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Plugins.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Zonk/Monad.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -15,14 +15,11 @@ module GHC.Core.Opt.CallerCC , parseCallerCcFilter ) where -import Data.Word (Word8) import Data.Maybe import Control.Applicative import GHC.Utils.Monad.State.Strict -import Data.Either import Control.Monad -import qualified Text.ParserCombinators.ReadP as P import GHC.Prelude import GHC.Utils.Outputable as Outputable @@ -38,11 +35,8 @@ import GHC.Unit.Types import GHC.Data.FastString import GHC.Core import GHC.Core.Opt.Monad -import GHC.Utils.Panic -import qualified GHC.Utils.Binary as B -import Data.Char +import GHC.Core.Opt.CallerCC.Types -import Language.Haskell.Syntax.Module.Name addCallerCostCentres :: ModGuts -> CoreM ModGuts addCallerCostCentres guts = do @@ -139,90 +133,3 @@ needsCallSiteCostCentre env i = checkFunc = occNameMatches (ccfFuncName ccf) (getOccName i) -data NamePattern - = PChar Char NamePattern - | PWildcard NamePattern - | PEnd - -instance Outputable NamePattern where - ppr (PChar c rest) = char c <> ppr rest - ppr (PWildcard rest) = char '*' <> ppr rest - ppr PEnd = Outputable.empty - -instance B.Binary NamePattern where - get bh = do - tag <- B.get bh - case tag :: Word8 of - 0 -> PChar <$> B.get bh <*> B.get bh - 1 -> PWildcard <$> B.get bh - 2 -> pure PEnd - _ -> panic "Binary(NamePattern): Invalid tag" - put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y - put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x - put_ bh PEnd = B.put_ bh (2 :: Word8) - -occNameMatches :: NamePattern -> OccName -> Bool -occNameMatches pat = go pat . occNameString - where - go :: NamePattern -> String -> Bool - go PEnd "" = True - go (PChar c rest) (d:s) - = d == c && go rest s - go (PWildcard rest) s - = go rest s || go (PWildcard rest) (tail s) - go _ _ = False - -type Parser = P.ReadP - -parseNamePattern :: Parser NamePattern -parseNamePattern = pattern - where - pattern = star P.<++ wildcard P.<++ char P.<++ end - star = PChar '*' <$ P.string "\\*" <*> pattern - wildcard = do - void $ P.char '*' - PWildcard <$> pattern - char = PChar <$> P.get <*> pattern - end = PEnd <$ P.eof - -data CallerCcFilter - = CallerCcFilter { ccfModuleName :: Maybe ModuleName - , ccfFuncName :: NamePattern - } - -instance Outputable CallerCcFilter where - ppr ccf = - maybe (char '*') ppr (ccfModuleName ccf) - <> char '.' - <> ppr (ccfFuncName ccf) - -instance B.Binary CallerCcFilter where - get bh = CallerCcFilter <$> B.get bh <*> B.get bh - put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y - -parseCallerCcFilter :: String -> Either String CallerCcFilter -parseCallerCcFilter inp = - case P.readP_to_S parseCallerCcFilter' inp of - ((result, ""):_) -> Right result - _ -> Left $ "parse error on " ++ inp - -parseCallerCcFilter' :: Parser CallerCcFilter -parseCallerCcFilter' = - CallerCcFilter - <$> moduleFilter - <* P.char '.' - <*> parseNamePattern - where - moduleFilter :: Parser (Maybe ModuleName) - moduleFilter = - (Just . mkModuleName <$> moduleName) - <|> - (Nothing <$ P.char '*') - - moduleName :: Parser String - moduleName = do - c <- P.satisfy isUpper - cs <- P.munch1 (\c -> isUpper c || isLower c || isDigit c || c == '_') - rest <- optional $ P.char '.' >> fmap ('.':) moduleName - return $ c : (cs ++ fromMaybe "" rest) - ===================================== compiler/GHC/Core/Opt/CallerCC.hs-boot deleted ===================================== @@ -1,8 +0,0 @@ -module GHC.Core.Opt.CallerCC where - -import GHC.Prelude - --- Necessary due to import in GHC.Driver.Session. -data CallerCcFilter - -parseCallerCcFilter :: String -> Either String CallerCcFilter ===================================== compiler/GHC/Core/Opt/CallerCC/Types.hs ===================================== @@ -0,0 +1,108 @@ +module GHC.Core.Opt.CallerCC.Types where + +import Data.Word (Word8) +import Data.Maybe + +import Control.Applicative +import Data.Either +import Control.Monad +import qualified Text.ParserCombinators.ReadP as P + +import GHC.Prelude +import GHC.Utils.Outputable as Outputable +import GHC.Types.Name hiding (varName) +import GHC.Utils.Panic +import qualified GHC.Utils.Binary as B +import Data.Char + +import Language.Haskell.Syntax.Module.Name + + +data NamePattern + = PChar Char NamePattern + | PWildcard NamePattern + | PEnd + +instance Outputable NamePattern where + ppr (PChar c rest) = char c <> ppr rest + ppr (PWildcard rest) = char '*' <> ppr rest + ppr PEnd = Outputable.empty + +instance B.Binary NamePattern where + get bh = do + tag <- B.get bh + case tag :: Word8 of + 0 -> PChar <$> B.get bh <*> B.get bh + 1 -> PWildcard <$> B.get bh + 2 -> pure PEnd + _ -> panic "Binary(NamePattern): Invalid tag" + put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y + put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x + put_ bh PEnd = B.put_ bh (2 :: Word8) + +occNameMatches :: NamePattern -> OccName -> Bool +occNameMatches pat = go pat . occNameString + where + go :: NamePattern -> String -> Bool + go PEnd "" = True + go (PChar c rest) (d:s) + = d == c && go rest s + go (PWildcard rest) s + = go rest s || go (PWildcard rest) (tail s) + go _ _ = False + + + +type Parser = P.ReadP + +parseNamePattern :: Parser NamePattern +parseNamePattern = pattern + where + pattern = star P.<++ wildcard P.<++ char P.<++ end + star = PChar '*' <$ P.string "\\*" <*> pattern + wildcard = do + void $ P.char '*' + PWildcard <$> pattern + char = PChar <$> P.get <*> pattern + end = PEnd <$ P.eof + +data CallerCcFilter + = CallerCcFilter { ccfModuleName :: Maybe ModuleName + , ccfFuncName :: NamePattern + } + +instance Outputable CallerCcFilter where + ppr ccf = + maybe (char '*') ppr (ccfModuleName ccf) + <> char '.' + <> ppr (ccfFuncName ccf) + +instance B.Binary CallerCcFilter where + get bh = CallerCcFilter <$> B.get bh <*> B.get bh + put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y + +parseCallerCcFilter :: String -> Either String CallerCcFilter +parseCallerCcFilter inp = + case P.readP_to_S parseCallerCcFilter' inp of + ((result, ""):_) -> Right result + _ -> Left $ "parse error on " ++ inp + +parseCallerCcFilter' :: Parser CallerCcFilter +parseCallerCcFilter' = + CallerCcFilter + <$> moduleFilter + <* P.char '.' + <*> parseNamePattern + where + moduleFilter :: Parser (Maybe ModuleName) + moduleFilter = + (Just . mkModuleName <$> moduleName) + <|> + (Nothing <$ P.char '*') + + moduleName :: Parser String + moduleName = do + c <- P.satisfy isUpper + cs <- P.munch1 (\c -> isUpper c || isLower c || isDigit c || c == '_') + rest <- optional $ P.char '.' >> fmap ('.':) moduleName + return $ c : (cs ++ fromMaybe "" rest) \ No newline at end of file ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -106,7 +106,7 @@ import qualified GHC.Types.FieldLabel as FieldLabel import qualified GHC.Utils.Ppr.Colour as Col import qualified GHC.Data.EnumSet as EnumSet -import {-# SOURCE #-} GHC.Core.Opt.CallerCC +import GHC.Core.Opt.CallerCC.Types import Control.Monad (msum, (<=<)) import Control.Monad.Trans.Class (lift) ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -82,7 +82,7 @@ import GHC.Parser.Errors.Types (PsWarning, PsError) import qualified GHC.Tc.Types import GHC.Tc.Types ( TcGblEnv, IfM, TcM, tcg_rn_decls, tcg_rn_exports ) -import GHC.Tc.Errors.Hole.FitTypes ( HoleFitPluginR ) +import GHC.Tc.Errors.Hole.Plugin ( HoleFitPluginR ) import GHC.Core.Opt.Monad ( CoreM ) import GHC.Core.Opt.Pipeline.Types ( CoreToDo ) ===================================== compiler/GHC/Plugins.hs ===================================== @@ -55,6 +55,7 @@ module GHC.Plugins , module GHC.Types.Unique.Supply , module GHC.Data.FastString , module GHC.Tc.Errors.Hole.FitTypes -- for hole-fit plugins + , module GHC.Tc.Errors.Hole.Plugin -- for hole-fit plugins , module GHC.Unit.Module.ModGuts , module GHC.Unit.Module.ModSummary , module GHC.Unit.Module.ModIface @@ -148,6 +149,7 @@ import GHC.Tc.Utils.Env ( lookupGlobal ) import GHC.Types.Name.Cache ( NameCache ) import GHC.Tc.Errors.Hole.FitTypes +import GHC.Tc.Errors.Hole.Plugin -- For parse result plugins import GHC.Parser.Errors.Types ( PsWarning, PsError ) ===================================== compiler/GHC/Tc/Errors/Hole.hs ===================================== @@ -23,7 +23,7 @@ module GHC.Tc.Errors.Hole , sortHoleFitsBySize - -- Re-exported from GHC.Tc.Errors.Hole.FitTypes + -- Re-exported from GHC.Tc.Errors.Hole.Plugin , HoleFitPlugin (..), HoleFitPluginR (..) ) where @@ -78,6 +78,7 @@ import GHC.Iface.Load ( loadInterfaceForName ) import GHC.Builtin.Utils (knownKeyNames) import GHC.Tc.Errors.Hole.FitTypes +import GHC.Tc.Errors.Hole.Plugin import qualified Data.Set as Set import GHC.Types.SrcLoc import GHC.Data.FastString (NonDetFastString(..)) ===================================== compiler/GHC/Tc/Errors/Hole/FitTypes.hs ===================================== @@ -1,13 +1,11 @@ {-# LANGUAGE ExistentialQuantification #-} module GHC.Tc.Errors.Hole.FitTypes ( TypedHole (..), HoleFit (..), HoleFitCandidate (..), - CandPlugin, FitPlugin, HoleFitPlugin (..), HoleFitPluginR (..), hfIsLcl, pprHoleFitCand ) where import GHC.Prelude -import GHC.Tc.Types import GHC.Tc.Types.Constraint import GHC.Tc.Utils.TcType @@ -126,25 +124,3 @@ hfIsLcl hf@(HoleFit {}) = case hfCand hf of hfIsLcl _ = False --- | A plugin for modifying the candidate hole fits *before* they're checked. -type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] - --- | A plugin for modifying hole fits *after* they've been found. -type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] - --- | A HoleFitPlugin is a pair of candidate and fit plugins. -data HoleFitPlugin = HoleFitPlugin - { candPlugin :: CandPlugin - , fitPlugin :: FitPlugin } - --- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can --- track internal state. Note the existential quantification, ensuring that --- the state cannot be modified from outside the plugin. -data HoleFitPluginR = forall s. HoleFitPluginR - { hfPluginInit :: TcM (TcRef s) - -- ^ Initializes the TcRef to be passed to the plugin - , hfPluginRun :: TcRef s -> HoleFitPlugin - -- ^ The function defining the plugin itself - , hfPluginStop :: TcRef s -> TcM () - -- ^ Cleanup of state, guaranteed to be called even on error - } ===================================== compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot deleted ===================================== @@ -1,30 +0,0 @@ --- This boot file is in place to break the loop where: --- + GHC.Tc.Types needs 'HoleFitPlugin', --- + which needs 'GHC.Tc.Errors.Hole.FitTypes' --- + which needs 'GHC.Tc.Types' -module GHC.Tc.Errors.Hole.FitTypes where - -import GHC.Base (Int, Maybe) -import GHC.Types.Var (Id) -import GHC.Types.Name (Name) -import GHC.Types.Name.Reader (GlobalRdrElt) -import GHC.Tc.Utils.TcType (TcType) -import GHC.Hs.Doc (HsDocString) -import GHC.Utils.Outputable (SDoc) - -data HoleFitCandidate - = IdHFCand Id - | NameHFCand Name - | GreHFCand GlobalRdrElt - -data HoleFitPlugin -data HoleFit = - HoleFit { hfId :: Id - , hfCand :: HoleFitCandidate - , hfType :: TcType - , hfRefLvl :: Int - , hfWrap :: [TcType] - , hfMatches :: [TcType] - , hfDoc :: Maybe [HsDocString] - } - | RawHoleFit SDoc ===================================== compiler/GHC/Tc/Errors/Hole/Plugin.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE ExistentialQuantification #-} +module GHC.Tc.Errors.Hole.Plugin(CandPlugin, FitPlugin, HoleFitPlugin (..), HoleFitPluginR (..)) where + +import GHC.Tc.Errors.Hole.FitTypes +import GHC.Tc.Types ( TcRef, TcM ) + + +-- | A plugin for modifying the candidate hole fits *before* they're checked. +type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate] + +-- | A plugin for modifying hole fits *after* they've been found. +type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit] + +-- | A HoleFitPlugin is a pair of candidate and fit plugins. +data HoleFitPlugin = HoleFitPlugin + { candPlugin :: CandPlugin + , fitPlugin :: FitPlugin } + +-- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can +-- track internal state. Note the existential quantification, ensuring that +-- the state cannot be modified from outside the plugin. +data HoleFitPluginR = forall s. HoleFitPluginR + { hfPluginInit :: TcM (TcRef s) + -- ^ Initializes the TcRef to be passed to the plugin + , hfPluginRun :: TcRef s -> HoleFitPlugin + -- ^ The function defining the plugin itself + , hfPluginStop :: TcRef s -> TcM () + -- ^ Cleanup of state, guaranteed to be called even on error + } \ No newline at end of file ===================================== compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot ===================================== @@ -0,0 +1,3 @@ +module GHC.Tc.Errors.Hole.Plugin where + +data HoleFitPlugin \ No newline at end of file ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -76,7 +76,7 @@ import GHC.Types.Name.Set import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.TyThing -import {-# SOURCE #-} GHC.Types.TyThing.Ppr ( pprTyThingInContext ) +import GHC.Types.TyThing.Ppr ( pprTyThingInContext ) import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import GHC.Types.Var import GHC.Types.Var.Set ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -147,7 +147,7 @@ import GHC.Prelude import GHC.Hs import GHC.Tc.Types.TcTyThing -- (TcIdSigInfo, TcTyThing) -import {-# SOURCE #-} GHC.Tc.Errors.Hole.FitTypes (HoleFit) +import GHC.Tc.Errors.Hole.FitTypes (HoleFit) import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence (EvBindsVar) import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Config.Diagnostic -import GHC.Tc.Errors.Hole.FitTypes ( HoleFitPluginR (..) ) +import GHC.Tc.Errors.Hole.Plugin ( HoleFitPluginR (..) ) import GHC.Tc.Errors.Types import {-# SOURCE #-} GHC.Tc.Gen.Splice ( finishTH, runRemoteModFinalizers ) import GHC.Tc.Gen.HsType ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -112,7 +112,7 @@ import GHC.Hs import GHC.Tc.Utils.TcType import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence -import {-# SOURCE #-} GHC.Tc.Errors.Hole.FitTypes ( HoleFitPlugin ) +import {-# SOURCE #-} GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin ) import GHC.Tc.Errors.Types import GHC.Core.Reduction ( Reduction(..) ) ===================================== compiler/GHC/Tc/Zonk/Monad.hs ===================================== @@ -10,7 +10,7 @@ import GHC.Prelude import GHC.Core.Type -import GHC.Driver.Flags +--import GHC.Driver.Flags import GHC.Types.Var ( TcTyVar, Id, isTyCoVar ) import GHC.Types.Var.Env @@ -298,11 +298,14 @@ writeTcRefZ :: IORef a -> a -> ZonkM () writeTcRefZ ref a = liftIO $ writeIORef ref a traceZonk :: String -> SDoc -> ZonkM () -traceZonk herald doc = ZonkM $ +traceZonk _herald _doc = ZonkM $ return (return ()) +{- \ ( ZonkLogEnv { le_logger = logger, le_name_ppr_ctx = ppr_ctx }) -> do { let sty = mkDumpStyle ppr_ctx flag = Opt_D_dump_tc_trace title = "" msg = hang (text herald) 2 doc - ; logDumpFile logger sty flag title FormatText msg +-- ; logDumpFile logger sty flag title FormatText msg + ; return () } + -} ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Core.TyCon import GHC.Hs.Expr () -- instance Outputable -import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) +import GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace) ===================================== compiler/ghc.cabal.in ===================================== @@ -311,6 +311,7 @@ Library GHC.Core.Opt.Arity GHC.Core.Opt.CallArity GHC.Core.Opt.CallerCC + GHC.Core.Opt.CallerCC.Types GHC.Core.Opt.ConstantFold GHC.Core.Opt.CprAnal GHC.Core.Opt.CSE @@ -708,6 +709,7 @@ Library GHC.Tc.Errors GHC.Tc.Errors.Hole GHC.Tc.Errors.Hole.FitTypes + GHC.Tc.Errors.Hole.Plugin GHC.Tc.Errors.Ppr GHC.Tc.Errors.Types GHC.Tc.Errors.Types.PromotionErr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b0e48ad87297472d8dacf6e6334b7d29b348fc5...672259755c94ef7bac2accfb3f52cb870f7e01b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b0e48ad87297472d8dacf6e6334b7d29b348fc5...672259755c94ef7bac2accfb3f52cb870f7e01b7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 08:48:32 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 17 May 2023 04:48:32 -0400 Subject: [Git][ghc/ghc][wip/restore-lcl-env] Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <646494e03c45_171ad9ab051a08151439a@gitlab.mail> Matthew Pickering pushed to branch wip/restore-lcl-env at Glasgow Haskell Compiler / GHC Commits: 20edcfca by Matthew Pickering at 2023-05-16T15:10:22+01:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 2 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -53,6 +53,7 @@ import GHC.Data.Bag import Data.Maybe ( isJust ) import qualified Data.Semigroup as S +import GHC.Tc.Utils.Monad (getLclEnvLoc) {- ************************************************************************ @@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] - setLclEnv (ctLocEnv loc) $ - -- This setLclEnv is important: the emitImplicationTcS uses that + setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $ + -- This setSrcSpan is important: the emitImplicationTcS uses that -- TcLclEnv for the implication, and that in turn sets the location -- for the Givens when solving the constraint (#21006) do { let empty_subst = mkEmptySubst $ mkInScopeSet $ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad ( getSolvedDicts, setSolvedDicts, getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, setLclEnv, + getTopEnv, getGblEnv, getLclEnv, setSrcSpan, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, tcLookupClass, tcLookupId, tcLookupTyCon, @@ -194,6 +194,7 @@ import Data.IORef import Data.List ( mapAccumL ) import Data.Foldable import qualified Data.Semigroup as S +import GHC.Types.SrcLoc #if defined(DEBUG) import GHC.Types.Unique.Set (nonDetEltsUniqSet) @@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv getLclEnv :: TcS TcLclEnv getLclEnv = wrapTcS $ TcM.getLclEnv -setLclEnv :: TcLclEnv -> TcS a -> TcS a -setLclEnv env = wrap2TcS (TcM.setLclEnv env) +setSrcSpan :: RealSrcSpan -> TcS a -> TcS a +setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20edcfcadd07b59d07e192714e47b8288e60c299 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20edcfcadd07b59d07e192714e47b8288e60c299 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 09:13:05 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Wed, 17 May 2023 05:13:05 -0400 Subject: [Git][ghc/ghc][wip/warns-messages-drivermessage] Deleted 1 commit: Only warn about deprecated flags in hadrian-multi Message-ID: <64649aa16ae4f_171ad9ab2847d015231de@gitlab.mail> Oleg Grenrus pushed to branch wip/warns-messages-drivermessage at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 422f23a2 by Oleg Grenrus at 2023-05-17T08:53:37+03:00 Only warn about deprecated flags in hadrian-multi - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -396,7 +396,7 @@ hadrian-multi: # workaround for docker permissions - sudo chown ghc:ghc -R . variables: - GHC_FLAGS: -Werror + GHC_FLAGS: -Werror -Wwarn=deprecated-flags CONFIGURE_ARGS: --enable-bootstrap-with-devel-snapshot tags: - x86_64-linux View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/422f23a2343f7d57165ad36d757b3bb9d910e8ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/422f23a2343f7d57165ad36d757b3bb9d910e8ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 10:01:12 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 17 May 2023 06:01:12 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 10 commits: Zonking monad transformers Message-ID: <6464a5e82b34c_171ad9ab299ce815317c5@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 09ca44bc by sheaf at 2023-05-17T09:51:17+01:00 Zonking monad transformers - Introduce two zonking monad transformers, ZonkT and ZonkBndrT. ZonkT is a reader monad transformer over ZonkEnv. ZonkBndrT m is the codensity monad over ZonkT m. ZonkBndrT is used for computations that accumulate binders in the ZonkEnv. - Split up the zonking functions relating purely to types into GHC.Tc.Zonk.Type. This should allow us to introduce a slimmed-down zonking monad, which doesn't wrap the full TcM but a much smaller monad. This opens up the possibility of refactoring ErrCtxt to use this smaller zonking monad. - Refactor the remaining zonking functions to work over the monads ZonkTcM = ZonkT TcM and ZonkBndrTcM = ZonkBndrT TcM. - - - - - dd8a541d by Matthew Pickering at 2023-05-17T10:57:39+01:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - be4380dc by Matthew Pickering at 2023-05-17T10:57:39+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.TcRef - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.TcIdSigInfo - GHC.Tc.Types.TcBinder - GHC.Tc.Types.TcTyThing - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. * New modules for the LclEnv and all its basic parts * CtLocEnv * TcLclCtxt (setLclEnv vs restoreLclEnv) - - - - - 6c85d227 by Matthew Pickering at 2023-05-17T10:57:39+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 740e3607 by Matthew Pickering at 2023-05-17T10:57:39+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 29995bc3 by Matthew Pickering at 2023-05-17T10:57:39+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - 289314c7 by Matthew Pickering at 2023-05-17T10:57:39+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - fb47a80d by Matthew Pickering at 2023-05-17T10:57:39+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 906061b7 by Matthew Pickering at 2023-05-17T10:57:39+01:00 Remove unecessary SOURCE import - - - - - f38c0422 by Matthew Pickering at 2023-05-17T10:57:39+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole.hs-boot - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/672259755c94ef7bac2accfb3f52cb870f7e01b7...f38c04224b7782b3083cd10ca292a798c8967a83 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/672259755c94ef7bac2accfb3f52cb870f7e01b7...f38c04224b7782b3083cd10ca292a798c8967a83 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 10:24:53 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Wed, 17 May 2023 06:24:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/warns-to-drivermessages Message-ID: <6464ab757b987_171ad9ab08b758153760@gitlab.mail> Oleg Grenrus pushed new branch wip/warns-to-drivermessages at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/warns-to-drivermessages You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 11:40:00 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 17 May 2023 07:40:00 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 8 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <6464bd10a89f8_171ad9ab08b758155139d@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 2d0dbf12 by Matthew Pickering at 2023-05-17T12:39:54+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.TcRef - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.TcIdSigInfo - GHC.Tc.Types.TcBinder - GHC.Tc.Types.TcTyThing - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 72c7d3d7 by Matthew Pickering at 2023-05-17T12:39:54+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - e913b920 by Matthew Pickering at 2023-05-17T12:39:54+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - f0877203 by Matthew Pickering at 2023-05-17T12:39:54+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - 62cc004d by Matthew Pickering at 2023-05-17T12:39:54+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - a8eb9a76 by Matthew Pickering at 2023-05-17T12:39:54+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 8cb9f210 by Matthew Pickering at 2023-05-17T12:39:54+01:00 Remove unecessary SOURCE import - - - - - 21e645c4 by Matthew Pickering at 2023-05-17T12:39:54+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f38c04224b7782b3083cd10ca292a798c8967a83...21e645c433f940eacb5cd3a52ab7390d9ebef059 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f38c04224b7782b3083cd10ca292a798c8967a83...21e645c433f940eacb5cd3a52ab7390d9ebef059 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 12:50:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 17 May 2023 08:50:38 -0400 Subject: [Git][ghc/ghc][wip/T13660] 62 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <6464cd9e70214_171ad9ab2847d015714e6@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - c37d9e26 by Ben Gamari at 2023-05-17T12:50:34+00:00 base: Add test for #13660 - - - - - 3f345d4e by Ben Gamari at 2023-05-17T12:50:34+00:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 2dbb615d by Ben Gamari at 2023-05-17T12:50:34+00:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - ae53f7b7 by Ben Gamari at 2023-05-17T12:50:34+00:00 base: Clean up documentation - - - - - 610eda9d by Ben Gamari at 2023-05-17T12:50:34+00:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/358fdd93deb94d7c04dcc1f197da1057ff2f2483...610eda9d9cd5ce5d1cdd71f28848a41582c40c97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/358fdd93deb94d7c04dcc1f197da1057ff2f2483...610eda9d9cd5ce5d1cdd71f28848a41582c40c97 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 13:58:54 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Wed, 17 May 2023 09:58:54 -0400 Subject: [Git][ghc/ghc][wip/warns-to-drivermessages] 25 commits: Replace the implementation of CodeBuffers with unboxed types Message-ID: <6464dd9e91512_171ad9ab2847d015950e9@gitlab.mail> Oleg Grenrus pushed to branch wip/warns-to-drivermessages at Glasgow Haskell Compiler / GHC Commits: fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 2b04bce3 by Oleg Grenrus at 2023-05-17T16:58:37+03:00 Make Warn = Located DriverMessage Resolves #23261 This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35e17b52bb673b672c42c512244b64e1fcfe5499...2b04bce3a94e3b191a5c43414b7f76d144f0d1f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35e17b52bb673b672c42c512244b64e1fcfe5499...2b04bce3a94e3b191a5c43414b7f76d144f0d1f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 14:01:40 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 17 May 2023 10:01:40 -0400 Subject: [Git][ghc/ghc][wip/T23083] 53 commits: rts: Ensure non-moving gc is not running when pausing Message-ID: <6464de4434acc_171ad9aad2366016005a0@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 7f7cdbe5 by Sebastian Graf at 2023-05-17T11:10:26+02:00 Cleanup a TODO introduced in 1f94e0f7 The change must have slipped through review of !4412 - - - - - 656f007e by Sebastian Graf at 2023-05-17T11:10:26+02:00 More explicit strictness in GHC.Real - - - - - d1a56c6a by Sebastian Graf at 2023-05-17T11:10:26+02:00 exprIsTrivial: Factor out shared implementation The duplication between `exprIsTrivial` and `getIdFromTrivialExpr_maybe` has been bugging me for a long time. This patch introduces an inlinable worker function `trivial_expr_fold` acting as the single, shared decision procedure of triviality. It "returns" a Church-encoded `Maybe (Maybe Id)`, so when it is inlined, it fuses to similar code as before. (Better code, even, in the case of `getIdFromTrivialExpr` which presently allocates a `Just` constructor that cancels away after this patch.) - - - - - b2a95018 by Sebastian Graf at 2023-05-17T11:10:26+02:00 Simplify: Simplification of arguments in a single function The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. - - - - - b3c30fea by Sebastian Graf at 2023-05-17T11:10:27+02:00 Core.Ppr: Omit case binder for empty case alternatives A minor improvement to pretty-printing - - - - - f76c3b53 by Sebastian Graf at 2023-05-17T11:10:27+02:00 Disable test RepPolyWrappedVar2 in JS backend - - - - - 790406b1 by Sebastian Graf at 2023-05-17T11:10:27+02:00 Inlining literals into boring contexts is OK - - - - - bcd1c835 by Sebastian Graf at 2023-05-17T11:10:27+02:00 Kill SetLevel.notWorthFloating.is_triv (#23270) We have had it since b84ba676034, when it operated on annotated expressions. Nowadays it operates on vanilla `CoreExpr` though, so we should just call `exprIsTrivial`; thus handling empty cases and string literals correctly. - - - - - 6ea01c67 by Sebastian Graf at 2023-05-17T16:00:30+02:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Fixes #23270. - - - - - 5e67e819 by Sebastian Graf at 2023-05-17T16:00:30+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - e2158d34 by Sebastian Graf at 2023-05-17T16:01:08+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - ff4a6c2e by Sebastian Graf at 2023-05-17T16:01:08+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e299449d425bff43ec85b7684928bf775aac32f...ff4a6c2ebdb2234862d778be1ba1babf929372e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e299449d425bff43ec85b7684928bf775aac32f...ff4a6c2ebdb2234862d778be1ba1babf929372e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 14:24:36 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 17 May 2023 10:24:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23408 Message-ID: <6464e3a4656e2_171ad9a3154ea8160861d@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23408 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23408 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 14:42:18 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 17 May 2023 10:42:18 -0400 Subject: [Git][ghc/ghc][wip/T23398] 13 commits: Add -Wmissing-role-annotations Message-ID: <6464e7caecfbb_171ad9ab08b7581620658@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23398 at Glasgow Haskell Compiler / GHC Commits: bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - ae00d825 by Simon Peyton Jones at 2023-05-17T15:44:16+01:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Errors/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9dced4cfd36f1bdc0d955d6a8865d250247fd2b...ae00d8257df41cf6aff588ed2b4a5a867f9c1c1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9dced4cfd36f1bdc0d955d6a8865d250247fd2b...ae00d8257df41cf6aff588ed2b4a5a867f9c1c1e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 15:18:12 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 17 May 2023 11:18:12 -0400 Subject: [Git][ghc/ghc][wip/T23083] 7 commits: Disable test RepPolyWrappedVar2 in JS backend Message-ID: <6464f03425f8e_171ad9b437a6401633034@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: fc9f0fbd by Sebastian Graf at 2023-05-17T17:17:24+02:00 Disable test RepPolyWrappedVar2 in JS backend - - - - - ad55ea4b by Sebastian Graf at 2023-05-17T17:17:24+02:00 Inlining literals into boring contexts is OK - - - - - 233bcdf6 by Sebastian Graf at 2023-05-17T17:17:24+02:00 Kill SetLevel.notWorthFloating.is_triv (#23270) We have had it since b84ba676034, when it operated on annotated expressions. Nowadays it operates on vanilla `CoreExpr` though, so we should just call `exprIsTrivial`; thus handling empty cases and string literals correctly. - - - - - c7d25122 by Sebastian Graf at 2023-05-17T17:17:24+02:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Fixes #23270. - - - - - fa7b91f7 by Sebastian Graf at 2023-05-17T17:17:24+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - faafe2a0 by Sebastian Graf at 2023-05-17T17:17:25+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - 5c885884 by Sebastian Graf at 2023-05-17T17:17:25+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Utils/Trace.hs - docs/users_guide/using-optimisation.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff4a6c2ebdb2234862d778be1ba1babf929372e2...5c8858846fb0d67a550f5943bf8bfced19b5f46b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff4a6c2ebdb2234862d778be1ba1babf929372e2...5c8858846fb0d67a550f5943bf8bfced19b5f46b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 15:34:55 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Wed, 17 May 2023 11:34:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/supersven/riscv64-ncg Message-ID: <6464f41fd158a_171ad9ab2847d0163829e@gitlab.mail> Sven Tennie pushed new branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/riscv64-ncg You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 17:09:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 17 May 2023 13:09:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.6 Message-ID: <64650a67cdb2b_9760ac02b073598@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 17:15:47 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 17 May 2023 13:15:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/test-nightlies Message-ID: <64650bc3edc38_9760ac029c769e8@gitlab.mail> Matthew Pickering pushed new branch wip/test-nightlies at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/test-nightlies You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 17:16:57 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 17 May 2023 13:16:57 -0400 Subject: [Git][ghc/ghc][wip/test-nightlies] fix testing Message-ID: <64650c099ae36_9760ac02c47718b@gitlab.mail> Matthew Pickering pushed to branch wip/test-nightlies at Glasgow Haskell Compiler / GHC Commits: 26948221 by Matthew Pickering at 2023-05-17T18:16:49+01:00 fix testing - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1012,7 +1012,7 @@ project-version: ghcup-metadata-nightly: extends: .ghcup-metadata # Explicit needs for validate pipeline because we only need certain bindists - needs: [] + needs: # - job: nightly-x86_64-linux-fedora33-release # artifacts: false # - job: nightly-x86_64-linux-centos7-validate @@ -1043,7 +1043,7 @@ ghcup-metadata-nightly: # artifacts: false # - job: source-tarball # artifacts: false - # - job: project-version + - job: project-version script: - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2694822185e11d29a4ab6602900079b435ed5824 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2694822185e11d29a4ab6602900079b435ed5824 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 19:53:07 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 17 May 2023 15:53:07 -0400 Subject: [Git][ghc/ghc][wip/T23398] Allow the demand analyser to unpack tuple and equality dictionaries Message-ID: <646530a3adeea_9760ac028810354f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23398 at Glasgow Haskell Compiler / GHC Commits: fe0e8c9c by Simon Peyton Jones at 2023-05-17T20:52:36+01:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. - - - - - 5 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - + testsuite/tests/stranal/should_compile/T23398.hs - + testsuite/tests/stranal/should_compile/T23398.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -16,37 +16,41 @@ where import GHC.Prelude -import GHC.Core.Opt.WorkWrap.Utils import GHC.Types.Demand -- All of it + import GHC.Core -import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Utils.Outputable -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic -import Data.List ( mapAccumL ) import GHC.Core.DataCon -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Predicate( isClassPred ) +import GHC.Core.Predicate( isEqualityClass, isCTupleClass ) import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain +import GHC.Core.Opt.WorkWrap.Utils + import GHC.Builtin.PrimOps import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) + import GHC.Types.Unique.Set import GHC.Types.Unique.MemoFun import GHC.Types.RepType +import GHC.Types.ForeignCall ( isSafeForeignCall ) +import GHC.Types.Id +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Outputable + +import Data.List ( mapAccumL ) {- ************************************************************************ @@ -1499,7 +1503,7 @@ bounds-checking. So we want to give `indexError` a signature like `<1!P(!S,!S)><1!S>b` where the !S (meaning Poly Unboxed C1N) says that the polymorphic arguments -are unboxed (recursively). The wrapper for `indexError` won't /acutally/ +are unboxed (recursively). The wrapper for `indexError` won't /actually/ unbox them (because their polymorphic type doesn't allow that) but when demand-analysing /callers/, we'll behave as if that call needs the args unboxed. @@ -1782,39 +1786,6 @@ applying the strictness demands to the final result of DmdAnal. The result is that we get the strict demand signature we wanted even if we can't float the case on `x` up through the case on `burble`. -Note [Do not unbox class dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never unbox class dictionaries in worker/wrapper. - -1. INLINABLE functions - If we have - f :: Ord a => [a] -> Int -> a - {-# INLINABLE f #-} - and we worker/wrapper f, we'll get a worker with an INLINABLE pragma - (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), - which can still be specialised by the type-class specialiser, something like - fw :: Ord a => [a] -> Int# -> a - - BUT if f is strict in the Ord dictionary, we might unpack it, to get - fw :: (a->a->Bool) -> [a] -> Int# -> a - and the type-class specialiser can't specialise that. An example is #6056. - - Historical note: #14955 describes how I got this fix wrong the first time. - I got aware of the issue in T5075 by the change in boxity of loop between - demand analysis runs. - -2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur - occur without INLINABLE, when we use -fexpose-all-unfoldings and - -fspecialise-aggressively to do vigorous cross-module specialisation. - -3. #18421 found that unboxing a dictionary can also make the worker less likely - to inline; the inlining heuristics seem to prefer to inline a function - applied to a dictionary over a function applied to a bunch of functions. - -TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing -a raft of higher-order functions isn't a huge win anyway -- you really want to -specialise the function. - Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of @@ -1998,22 +1969,13 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take threshold_arity $ - [ (bndr_ty, NotMarkedStrict, get_dmd bndr bndr_ty) - | bndr <- bndrs - , isRuntimeVar bndr, let bndr_ty = idType bndr ] - - get_dmd :: Id -> Type -> Demand - get_dmd bndr bndr_ty - | isClassPred bndr_ty = trimBoxity dmd - -- See Note [Do not unbox class dictionaries] - -- NB: 'ty' has not been normalised, so this will (rightly) - -- catch newtype dictionaries too. - -- NB: even for bottoming functions, don't unbox dictionaries - - | is_bot_fn = unboxDeeplyDmd dmd - -- See Note [Boxity for bottoming functions], case (B) - - | otherwise = dmd + [ (idType bndr, NotMarkedStrict, get_dmd bndr) + | bndr <- bndrs, isRuntimeVar bndr ] + + get_dmd :: Id -> Demand + get_dmd bndr + | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], + | otherwise = dmd -- case (B) where dmd = idDemandInfo bndr @@ -2119,6 +2081,12 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) -- isMarkedStrict: see Note [Unboxing evaluated arguments] in DmdAnal -> DontUnbox + | doNotUnbox ty + -> DontUnbox -- See Note [Do not unbox class dictionaries] + -- NB: 'ty' has not been normalised, so this will (rightly) + -- catch newtype dictionaries too. + -- NB: even for bottoming functions, don't unbox dictionaries + | DefinitelyRecursive <- ae_rec_dc env dc -- See Note [Which types are unboxed?] -- and Note [Demand analysis for recursive data constructors] @@ -2129,6 +2097,76 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) (dataConRepStrictness dc) dmds) + +doNotUnbox :: Type -> Bool +-- Do not unbox class dictionaries, except equality classes and tuples +-- Note [Do not unbox class dictionaries] +doNotUnbox arg_ty + = case tyConAppTyCon_maybe arg_ty of + Just tc | Just cls <- tyConClass_maybe tc + -> not (isEqualityClass cls || isCTupleClass cls) + -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] + + _ -> False + +{- Note [Do not unbox class dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never unbox class dictionaries in worker/wrapper. + +1. INLINABLE functions + If we have + f :: Ord a => [a] -> Int -> a + {-# INLINABLE f #-} + and we worker/wrapper f, we'll get a worker with an INLINABLE pragma + (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), + which can still be specialised by the type-class specialiser, something like + fw :: Ord a => [a] -> Int# -> a + + BUT if f is strict in the Ord dictionary, we might unpack it, to get + fw :: (a->a->Bool) -> [a] -> Int# -> a + and the type-class specialiser can't specialise that. An example is #6056. + + Historical note: #14955 describes how I got this fix wrong the first time. + I got aware of the issue in T5075 by the change in boxity of loop between + demand analysis runs. + +2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur + occur without INLINABLE, when we use -fexpose-all-unfoldings and + -fspecialise-aggressively to do vigorous cross-module specialisation. + +3. #18421 found that unboxing a dictionary can also make the worker less likely + to inline; the inlining heuristics seem to prefer to inline a function + applied to a dictionary over a function applied to a bunch of functions. + +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing +a raft of higher-order functions isn't a huge win anyway -- you really want to +specialise the function. + +Wrinkle (DNB1): we /do/ want to unbox tuple dictionaries (#23398) + f :: (% Eq a, Show a %) => blah + with -fdicts-strict it is great to unbox to + $wf :: Eq a => Show a => blah + (where I have written out the currying explicitly). Now we can specialise + $wf on the Eq or Show dictionary. Nothing is lost. + + And something is gained. It is possible that `f` will look like this: + f = /\a. \d:(% Eq a, Show a %). ... f @a (% sel1 d, sel2 d %)... + where there is a recurive call to `f`, or to another function that takes the + same tuple dictionary, but where the tuple is built from the components of + `d`. The Simplier does not fix this. But if we unpacked the dictionary + we'd get + $wf = /\a. \(d1:Eq a) (d2:Show a). let d = (% d1, d2 %) + in ...f @a (% sel1 d, sel2 d %) + and all the tuple building and taking apart will disappear. + +Wrinkle (DNB2): we /do/ wnat to unbox equality dictionaries, + for (~), (~~), and Coercible (#23398). Their payload is a single unboxed + coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is + to make a copy of the function's RHS with a particular coercion. Unlike + normal class methods, that does not unlock any new optimisation + opportunities in the specialised RHS. +-} + {- ********************************************************************* * * Fixpoints ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqPredClass, isCTupleClass, isEqualityClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -219,11 +219,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -245,6 +240,20 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) +isEqPredClass :: Class -> Bool +-- True of (~) and (~~) +isEqPredClass cls = cls `hasKey` eqTyConKey + || cls `hasKey` heqTyConKey + +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + + {- ********************************************************************* * * Implicit parameters ===================================== testsuite/tests/stranal/should_compile/T23398.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fdicts-strict #-} +module T23398 where + +type PairDict a = (Eq a, Show a) + +foo :: PairDict a => a -> a -> String +foo x y | x==y = show x + | otherwise = show y + +-- In worker/wrapper we'd like to unbox the pair +-- but not (Eq a) and (Show a) + +bar :: (a ~ b, Show a) => Int -> a -> (b, String) +bar 0 x = (x, show x) +bar n x = bar (n-1) x ===================================== testsuite/tests/stranal/should_compile/T23398.stderr ===================================== @@ -0,0 +1,109 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 76, types: 117, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} +T23398.$wfoo [InlPrag=[2]] + :: forall {a}. (Eq a, Show a) => a -> a -> String +[GblId[StrictWorker([!, !])], + Arity=4, + Str=, + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [30 60 0 0] 120 0}] +T23398.$wfoo + = \ (@a) (ww :: Eq a) (ww1 :: Show a) (eta :: a) (eta1 :: a) -> + case == @a ww eta eta1 of { + False -> show @a ww1 eta1; + True -> show @a ww1 eta + } + +-- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/0} +foo [InlPrag=[2]] :: forall a. PairDict a => a -> a -> String +[GblId, + Arity=3, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + ($d(%,%) [Occ=Once1!] :: PairDict a) + (eta [Occ=Once1] :: a) + (eta1 [Occ=Once1] :: a) -> + case $d(%,%) of { (ww [Occ=Once1], ww1 [Occ=Once1]) -> + T23398.$wfoo @a ww ww1 eta eta1 + }}] +foo + = \ (@a) ($d(%,%) :: PairDict a) (eta :: a) (eta1 :: a) -> + case $d(%,%) of { (ww, ww1) -> T23398.$wfoo @a ww ww1 eta eta1 } + +Rec { +-- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} +T23398.$wbar [InlPrag=[2], Occ=LoopBreaker] + :: forall {a} {b}. + (a GHC.Prim.~# b, Show a) => + GHC.Prim.Int# -> a -> (# b, String #) +[GblId[StrictWorker([~, !])], + Arity=4, + Str=<1L>, + Unf=OtherCon []] +T23398.$wbar + = \ (@a) + (@b) + (ww :: a GHC.Prim.~# b) + ($dShow :: Show a) + (ww1 :: GHC.Prim.Int#) + (eta :: a) -> + case ww1 of ds { + __DEFAULT -> + T23398.$wbar + @a @b @~(ww :: a GHC.Prim.~# b) $dShow (GHC.Prim.-# ds 1#) eta; + 0# -> (# eta `cast` (Sub ww :: a ~R# b), show @a $dShow eta #) + } +end Rec } + +-- RHS size: {terms: 21, types: 32, coercions: 1, joins: 0/0} +bar [InlPrag=[2]] + :: forall a b. (a ~ b, Show a) => Int -> a -> (b, String) +[GblId, + Arity=4, + Str=<1!P(1L)>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (@b) + ($d~ [Occ=Once1!] :: a ~ b) + ($dShow [Occ=Once1] :: Show a) + (eta [Occ=Once1!] :: Int) + (eta1 [Occ=Once1] :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 [Occ=Once1] -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2 [Occ=Once1], ww3 [Occ=Once1] #) -> + (ww2, ww3) + } + } + }}] +bar + = \ (@a) + (@b) + ($d~ :: a ~ b) + ($dShow :: Show a) + (eta :: Int) + (eta1 :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2, ww3 #) -> + (ww2, ww3) + } + } + } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -93,3 +93,4 @@ test('T22039', normal, compile, ['']) test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) # T22997: Just a panic that should not happen test('T22997', normal, compile, ['']) +test('T23398', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe0e8c9c13916d4e32b65543c083d227db256d23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe0e8c9c13916d4e32b65543c083d227db256d23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 19:50:48 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 17 May 2023 15:50:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/haddock-mem-fixes Message-ID: <64653018b888b_9760ac11b0103323@gitlab.mail> Finley McIlwaine pushed new branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/haddock-mem-fixes You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 19:59:01 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 17 May 2023 15:59:01 -0400 Subject: [Git][ghc/ghc][wip/t23315] 96 commits: Add sized primitive literal syntax Message-ID: <64653205557e_9760ac02c4108943@gitlab.mail> Finley McIlwaine pushed to branch wip/t23315 at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 57ba64db by Finley McIlwaine at 2023-05-17T19:58:53+00:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37f936856fcccb61cf52e57a08cbfa54a86e3c78...57ba64dba592f5efaea5e9b61f2e7e2e7267179e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37f936856fcccb61cf52e57a08cbfa54a86e3c78...57ba64dba592f5efaea5e9b61f2e7e2e7267179e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 20:31:08 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 17 May 2023 16:31:08 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 25 commits: Replace the implementation of CodeBuffers with unboxed types Message-ID: <6465398c914ce_9760ac02c41151c0@gitlab.mail> Ben Gamari pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 0190e9fe by Ben Gamari at 2023-05-17T16:30:54-04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.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/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - + compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb6e2d6c70bf0aa2d0a539bcf4b9c8d679fdba18...0190e9fe6f6f5989fbd016881388c20a7fde3bcb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb6e2d6c70bf0aa2d0a539bcf4b9c8d679fdba18...0190e9fe6f6f5989fbd016881388c20a7fde3bcb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 20:58:29 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 17 May 2023 16:58:29 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tuple-tests Message-ID: <64653ff5257c0_9760ac038c1275dc@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/tuple-tests at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tuple-tests You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 21:06:17 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 17 May 2023 17:06:17 -0400 Subject: [Git][ghc/ghc][wip/tuple-tests] Enable ghci tests for unboxed tuples Message-ID: <646541c9e0473_9760ac11b0131525@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/tuple-tests at Glasgow Haskell Compiler / GHC Commits: 02bf7d5f by Krzysztof Gogolewski at 2023-05-17T23:06:09+02:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - 3 changed files: - testsuite/tests/primops/should_run/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/unboxedsums/all.T Changes: ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -1,9 +1,8 @@ test('T6135', normal, compile_and_run, ['']) test('T7689', normal, compile_and_run, ['']) -# These tests are using unboxed tuples, so omit ghci -test('T9430', omit_ways(['ghci']), compile_and_run, ['']) +test('T9430', normal, compile_and_run, ['']) test('T4442', - [omit_ways(['ghci']), when(wordsize(32), expect_broken(15184))], + [when(wordsize(32), expect_broken(15184))], compile_and_run, ['']) test('T10481', exit_code(1), compile_and_run, ['']) test('T10678', @@ -18,13 +17,12 @@ test('T16164', normal, compile_and_run, ['']) test('ShowPrim', normal, compile_and_run, ['']) test('T12492', normal, compile_and_run, ['']) -# These tests use unboxed tuples, which GHCi doesn't support -test('ArithInt8', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord8', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithInt16', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord16', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithInt32', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord32', omit_ways(['ghci']), compile_and_run, ['']) +test('ArithInt8', normal, compile_and_run, ['']) +test('ArithWord8', normal, compile_and_run, ['']) +test('ArithInt16', normal, compile_and_run, ['']) +test('ArithWord16', normal, compile_and_run, ['']) +test('ArithInt32', normal, compile_and_run, ['']) +test('ArithWord32', normal, compile_and_run, ['']) test('CmpInt8', normal, compile_and_run, ['']) test('CmpWord8', normal, compile_and_run, ['']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -122,11 +122,9 @@ test('TypeRep', normal, compile_and_run, ['']) test('T11120', normal, compile_and_run, ['']) test('KindInvariant', normal, ghci_script, ['KindInvariant.script']) -# We omit the ghci way in these 3 tests because they use -# unboxed sums and ghci does not support those yet. -test('StrictPats', omit_ways(['ghci']), compile_and_run, ['']) -test('T12809', omit_ways(['ghci']), compile_and_run, ['']) -test('EtaExpandLevPoly', [omit_ways(['ghci'])], compile_and_run, ['']) +test('StrictPats', normal, compile_and_run, ['']) +test('T12809', normal, compile_and_run, ['']) +test('EtaExpandLevPoly', normal, compile_and_run, ['']) test('TestTypeableBinary', normal, compile_and_run, ['']) test('Typeable1', normal, compile_fail, ['-Werror']) ===================================== testsuite/tests/unboxedsums/all.T ===================================== @@ -3,29 +3,29 @@ test('unboxedsums_unit_tests', compile_and_run, ['-package ghc']) -test('unarise', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums1', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums2', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums3', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums4', omit_ways(['ghci']), compile_fail, ['']) -test('unboxedsums5', omit_ways(['ghci']), compile, ['']) -test('unboxedsums6', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums7', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums8', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums9', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums10', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums11', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums12', omit_ways(['ghci']), compile, ['']) +test('unarise', normal, compile_and_run, ['']) +test('unboxedsums1', normal, compile_and_run, ['']) +test('unboxedsums2', omit_ways(['ghci']), compile_and_run, ['']) # broken on ghci because of #23412 +test('unboxedsums3', normal, compile_and_run, ['']) +test('unboxedsums4', normal, compile_fail, ['']) +test('unboxedsums5', normal, compile, ['']) +test('unboxedsums6', normal, compile_and_run, ['']) +test('unboxedsums7', normal, compile_and_run, ['']) +test('unboxedsums8', normal, compile_and_run, ['']) +test('unboxedsums9', normal, compile_and_run, ['']) +test('unboxedsums10', normal, compile_and_run, ['']) +test('unboxedsums11', normal, compile_and_run, ['']) +test('unboxedsums12', normal, compile, ['']) -test('UnboxedSumsTH', [req_th,omit_ways(['ghci'])], compile, ['']) -test('UnboxedSumsTH_Fail', [req_th,omit_ways(['ghci'])], compile_fail, ['']) +test('UnboxedSumsTH', [req_th], compile, ['']) +test('UnboxedSumsTH_Fail', [req_th], compile_fail, ['']) test('ffi1', normal, compile_fail, ['']) test('thunk', only_ways(['normal']), compile_and_run, ['']) test('T12375', only_ways(['normal']), compile_and_run, ['']) test('empty_sum', only_ways(['normal']), compile_and_run, ['']) test('sum_rr', normal, compile, ['']) -test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) +test('T12711', normal, ghci_script, ['T12711.script']) test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns']) test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02bf7d5f8980c04122d20e048afcf61abc7c7f33 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02bf7d5f8980c04122d20e048afcf61abc7c7f33 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 21:11:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 17 May 2023 17:11:59 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: users guide: Add glossary Message-ID: <6465431fb9272_9760ac0454132019@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - eeea0ce0 by Matthew Pickering at 2023-05-17T17:11:41-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 14b690ed by Torsten Schmits at 2023-05-17T17:11:53-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 9 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - docs/users_guide/ghci.rst - + docs/users_guide/glossary.rst - docs/users_guide/index.rst - libraries/base/System/Posix/Internals.hs - + libraries/base/tests/System/T23399.hs - + libraries/base/tests/System/T23399.stdout - libraries/base/tests/System/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -53,6 +53,7 @@ import GHC.Data.Bag import Data.Maybe ( isJust ) import qualified Data.Semigroup as S +import GHC.Tc.Utils.Monad (getLclEnvLoc) {- ************************************************************************ @@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] - setLclEnv (ctLocEnv loc) $ - -- This setLclEnv is important: the emitImplicationTcS uses that + setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $ + -- This setSrcSpan is important: the emitImplicationTcS uses that -- TcLclEnv for the implication, and that in turn sets the location -- for the Givens when solving the constraint (#21006) do { let empty_subst = mkEmptySubst $ mkInScopeSet $ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad ( getSolvedDicts, setSolvedDicts, getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, setLclEnv, + getTopEnv, getGblEnv, getLclEnv, setSrcSpan, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, tcLookupClass, tcLookupId, tcLookupTyCon, @@ -194,6 +194,7 @@ import Data.IORef import Data.List ( mapAccumL ) import Data.Foldable import qualified Data.Semigroup as S +import GHC.Types.SrcLoc #if defined(DEBUG) import GHC.Types.Unique.Set (nonDetEltsUniqSet) @@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv getLclEnv :: TcS TcLclEnv getLclEnv = wrapTcS $ TcM.getLclEnv -setLclEnv :: TcLclEnv -> TcS a -> TcS a -setLclEnv env = wrap2TcS (TcM.setLclEnv env) +setSrcSpan :: RealSrcSpan -> TcS a -> TcS a +setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c ===================================== docs/users_guide/ghci.rst ===================================== @@ -3546,41 +3546,19 @@ The interpreter can't load modules with foreign export declarations! Unfortunately not. We haven't implemented it yet. Please compile any offending modules by hand before loading them into GHCi. -:ghc-flag:`-O` doesn't work with GHCi! +:ghc-flag:`-O` is ineffective in GHCi! .. index:: single: optimization; and GHCi - For technical reasons, the bytecode compiler doesn't interact well - with one of the optimisation passes, so we have disabled - optimisation when using the interpreter. This isn't a great loss: - you'll get a much bigger win by compiling the bits of your code that - need to go fast, rather than interpreting them with optimisation - turned on. + Before GHC 9.8, optimizations were considered too unstable to be used with + the bytecode interpreter. + This restriction has been lifted, but is still regarded as experimental and + guarded by :ghc-flag:`-funoptimized-core-for-interpreter`, which is enabled + by default. + In order to use optimizations, run: :: -Modules using unboxed tuples or sums will automatically enable :ghc-flag:`-fobject-code` - - .. index:: - single: unboxed tuples, sums; and GHCi - - The bytecode interpreter doesn't support most uses of unboxed tuples or - sums, so GHCi will automatically compile these modules, and all modules - they depend on, to object code instead of bytecode. - - GHCi checks for the presence of unboxed tuples and sums in a somewhat - conservative fashion: it simply checks to see if a module enables the - :extension:`UnboxedTuples` or :extension:`UnboxedSums` language extensions. - It is not always the case that code which enables :extension:`UnboxedTuples` - or :extension:`UnboxedSums` requires :ghc-flag:`-fobject-code`, so if you - *really* want to compile - :extension:`UnboxedTuples`/:extension:`UnboxedSums`-using code to - bytecode, you can do so explicitly by enabling the :ghc-flag:`-fbyte-code` - flag. If you do this, do note that bytecode interpreter will throw an error - if it encounters unboxed tuple/sum–related code that it cannot handle. - - Incidentally, the previous point, that :ghc-flag:`-O` is - incompatible with GHCi, is because the bytecode compiler can't - deal with unboxed tuples or sums. + ghci -fno-unoptimized-core-for-interpreter -O Concurrent threads don't carry on running when GHCi is waiting for input. This should work, as long as your GHCi was built with the ===================================== docs/users_guide/glossary.rst ===================================== @@ -0,0 +1,13 @@ +Glossary +======== + +.. glossary:: + technology preview + + GHC will occassionally ship features advertised as being in a *technology + preview* state. Such features are generally opt-in in nature (e.g. new + language extensions) and may have various shortcomings. These may include + known bugs (which we will try to document), lacking optimisation, and + unhandled interactions with other language features. As such, behavior + of such features may change in the future. However, we do expect features + to converge to non-preview state over the course of a few GHC major releases. ===================================== docs/users_guide/index.rst ===================================== @@ -27,6 +27,7 @@ Contents: wasm bugs eventlog-formats + glossary editing-guide ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -499,7 +499,7 @@ foreign import javascript interruptible "(($1,$2_1,$2_2,$c) => { return h$base_f c_ftruncate :: CInt -> FileOffset -> IO CInt foreign import javascript interruptible "(($1_1,$1_2,$c) => { return h$base_unlink($1_1,$1_2,$c); })" c_unlink :: CString -> IO CInt -foreign import javascript unsafe "(() => { return h$base_getpid; })" +foreign import javascript unsafe "h$base_getpid" c_getpid :: IO CPid -- foreign import ccall unsafe "HsBase.h fork" -- c_fork :: IO CPid ===================================== libraries/base/tests/System/T23399.hs ===================================== @@ -0,0 +1,9 @@ +module Main where + +import System.Posix.Internals + +main = do + r <- c_getpid + -- #23399: JS backend wasn't returning a valid JS number as a CPid hence + -- "read" would fail because the string was "0\0" (not a number, NUL byte) + print ((read (show r) :: Int) /= -1) ===================================== libraries/base/tests/System/T23399.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== libraries/base/tests/System/all.T ===================================== @@ -8,3 +8,4 @@ test('system001', [js_broken(22349), when(opsys("mingw32"), skip), req_process], compile_and_run, ['']) test('Timeout001', js_broken(22261), compile_and_run, ['']) test('T16466', normal, compile_and_run, ['']) +test('T23399', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25e5400381d7656a862578172bd7f1497af41d88...14b690edc8c8883e04a7632a6e73b8aace099497 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25e5400381d7656a862578172bd7f1497af41d88...14b690edc8c8883e04a7632a6e73b8aace099497 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 17 21:26:43 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 17 May 2023 17:26:43 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] 37 commits: Turn "ambiguous import" error into a panic Message-ID: <646546934aa1a_9760ac02b013745f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - f45747c0 by Simon Peyton Jones at 2023-05-17T22:26:07+01:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of GHC.Tc.Solver.Equality. I also added the new types (akin to EqCt). IrredCt DictCt New module GHC.Tc.Solver.Solve Killed off: GHC.Tc.Solver.Canonical GHC.Tc.Solver.Interact Better commit message to come - - - - - 12f892f6 by Simon Peyton Jones at 2023-05-17T22:26:07+01:00 Two fast paths * Naturally coherent constraints * Hole-fits - - - - - 2c18d099 by Simon Peyton Jones at 2023-05-17T22:26:07+01:00 Wibbles - - - - - 354c12ee by Simon Peyton Jones at 2023-05-17T22:26:07+01:00 After talking to Richard * Use SimplifierStage Void when no ContinueWith * Fast path for equality classes - - - - - 6c7c88ff by Simon Peyton Jones at 2023-05-17T22:26:07+01:00 Switch off the ambiguity check properly Needs more documentation - - - - - 3e810c27 by Simon Peyton Jones at 2023-05-17T22:26:07+01:00 Further improvements to insolubles and ambiguity checking - - - - - 8a916491 by Simon Peyton Jones at 2023-05-17T22:26:07+01:00 Wibble imports - - - - - fbf5bcef by Simon Peyton Jones at 2023-05-17T22:26:07+01:00 Wibbles - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Logger.hs - + compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18b50348f130e74b89b4facfb4ad110e6dceea58...fbf5bcef8d532a88b68c15744d4df3c08a1c736c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18b50348f130e74b89b4facfb4ad110e6dceea58...fbf5bcef8d532a88b68c15744d4df3c08a1c736c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 01:42:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 17 May 2023 21:42:20 -0400 Subject: [Git][ghc/ghc][master] Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <6465827c72058_9760ac045415016a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 2 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -53,6 +53,7 @@ import GHC.Data.Bag import Data.Maybe ( isJust ) import qualified Data.Semigroup as S +import GHC.Tc.Utils.Monad (getLclEnvLoc) {- ************************************************************************ @@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] - setLclEnv (ctLocEnv loc) $ - -- This setLclEnv is important: the emitImplicationTcS uses that + setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $ + -- This setSrcSpan is important: the emitImplicationTcS uses that -- TcLclEnv for the implication, and that in turn sets the location -- for the Givens when solving the constraint (#21006) do { let empty_subst = mkEmptySubst $ mkInScopeSet $ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad ( getSolvedDicts, setSolvedDicts, getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, setLclEnv, + getTopEnv, getGblEnv, getLclEnv, setSrcSpan, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, tcLookupClass, tcLookupId, tcLookupTyCon, @@ -194,6 +194,7 @@ import Data.IORef import Data.List ( mapAccumL ) import Data.Foldable import qualified Data.Semigroup as S +import GHC.Types.SrcLoc #if defined(DEBUG) import GHC.Types.Unique.Set (nonDetEltsUniqSet) @@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv getLclEnv :: TcS TcLclEnv getLclEnv = wrapTcS $ TcM.getLclEnv -setLclEnv :: TcLclEnv -> TcS a -> TcS a -setLclEnv env = wrap2TcS (TcM.setLclEnv env) +setSrcSpan :: RealSrcSpan -> TcS a -> TcS a +setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5fe1d3e662e7b0ce8c2da31514d553a7f50ef179 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5fe1d3e662e7b0ce8c2da31514d553a7f50ef179 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 01:42:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 17 May 2023 21:42:56 -0400 Subject: [Git][ghc/ghc][master] Update the users guide paragraph on -O in GHCi Message-ID: <646582a0ebb6_9760ac04541536bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 1 changed file: - docs/users_guide/ghci.rst Changes: ===================================== docs/users_guide/ghci.rst ===================================== @@ -3546,41 +3546,19 @@ The interpreter can't load modules with foreign export declarations! Unfortunately not. We haven't implemented it yet. Please compile any offending modules by hand before loading them into GHCi. -:ghc-flag:`-O` doesn't work with GHCi! +:ghc-flag:`-O` is ineffective in GHCi! .. index:: single: optimization; and GHCi - For technical reasons, the bytecode compiler doesn't interact well - with one of the optimisation passes, so we have disabled - optimisation when using the interpreter. This isn't a great loss: - you'll get a much bigger win by compiling the bits of your code that - need to go fast, rather than interpreting them with optimisation - turned on. + Before GHC 9.8, optimizations were considered too unstable to be used with + the bytecode interpreter. + This restriction has been lifted, but is still regarded as experimental and + guarded by :ghc-flag:`-funoptimized-core-for-interpreter`, which is enabled + by default. + In order to use optimizations, run: :: -Modules using unboxed tuples or sums will automatically enable :ghc-flag:`-fobject-code` - - .. index:: - single: unboxed tuples, sums; and GHCi - - The bytecode interpreter doesn't support most uses of unboxed tuples or - sums, so GHCi will automatically compile these modules, and all modules - they depend on, to object code instead of bytecode. - - GHCi checks for the presence of unboxed tuples and sums in a somewhat - conservative fashion: it simply checks to see if a module enables the - :extension:`UnboxedTuples` or :extension:`UnboxedSums` language extensions. - It is not always the case that code which enables :extension:`UnboxedTuples` - or :extension:`UnboxedSums` requires :ghc-flag:`-fobject-code`, so if you - *really* want to compile - :extension:`UnboxedTuples`/:extension:`UnboxedSums`-using code to - bytecode, you can do so explicitly by enabling the :ghc-flag:`-fbyte-code` - flag. If you do this, do note that bytecode interpreter will throw an error - if it encounters unboxed tuple/sum–related code that it cannot handle. - - Incidentally, the previous point, that :ghc-flag:`-O` is - incompatible with GHCi, is because the bytecode compiler can't - deal with unboxed tuples or sums. + ghci -fno-unoptimized-core-for-interpreter -O Concurrent threads don't carry on running when GHCi is waiting for input. This should work, as long as your GHCi was built with the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/385edb65878d9963ea0406887649f7312c188c57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/385edb65878d9963ea0406887649f7312c188c57 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 07:32:04 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 18 May 2023 03:32:04 -0400 Subject: [Git][ghc/ghc][wip/T23398] 3 commits: Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <6465d47478a82_9760abbb09801817ac@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23398 at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 41f77ee5 by Simon Peyton Jones at 2023-05-18T08:33:58+01:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - 9 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - docs/users_guide/ghci.rst - testsuite/tests/indexed-types/should_compile/T7837.stderr - + testsuite/tests/stranal/should_compile/T23398.hs - + testsuite/tests/stranal/should_compile/T23398.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -16,37 +16,41 @@ where import GHC.Prelude -import GHC.Core.Opt.WorkWrap.Utils import GHC.Types.Demand -- All of it + import GHC.Core -import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Utils.Outputable -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic -import Data.List ( mapAccumL ) import GHC.Core.DataCon -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Predicate( isClassPred ) +import GHC.Core.Predicate( isEqualityClass, isCTupleClass ) import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain +import GHC.Core.Opt.WorkWrap.Utils + import GHC.Builtin.PrimOps import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) + import GHC.Types.Unique.Set import GHC.Types.Unique.MemoFun import GHC.Types.RepType +import GHC.Types.ForeignCall ( isSafeForeignCall ) +import GHC.Types.Id +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Outputable + +import Data.List ( mapAccumL ) {- ************************************************************************ @@ -1499,7 +1503,7 @@ bounds-checking. So we want to give `indexError` a signature like `<1!P(!S,!S)><1!S>b` where the !S (meaning Poly Unboxed C1N) says that the polymorphic arguments -are unboxed (recursively). The wrapper for `indexError` won't /acutally/ +are unboxed (recursively). The wrapper for `indexError` won't /actually/ unbox them (because their polymorphic type doesn't allow that) but when demand-analysing /callers/, we'll behave as if that call needs the args unboxed. @@ -1782,39 +1786,6 @@ applying the strictness demands to the final result of DmdAnal. The result is that we get the strict demand signature we wanted even if we can't float the case on `x` up through the case on `burble`. -Note [Do not unbox class dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never unbox class dictionaries in worker/wrapper. - -1. INLINABLE functions - If we have - f :: Ord a => [a] -> Int -> a - {-# INLINABLE f #-} - and we worker/wrapper f, we'll get a worker with an INLINABLE pragma - (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), - which can still be specialised by the type-class specialiser, something like - fw :: Ord a => [a] -> Int# -> a - - BUT if f is strict in the Ord dictionary, we might unpack it, to get - fw :: (a->a->Bool) -> [a] -> Int# -> a - and the type-class specialiser can't specialise that. An example is #6056. - - Historical note: #14955 describes how I got this fix wrong the first time. - I got aware of the issue in T5075 by the change in boxity of loop between - demand analysis runs. - -2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur - occur without INLINABLE, when we use -fexpose-all-unfoldings and - -fspecialise-aggressively to do vigorous cross-module specialisation. - -3. #18421 found that unboxing a dictionary can also make the worker less likely - to inline; the inlining heuristics seem to prefer to inline a function - applied to a dictionary over a function applied to a bunch of functions. - -TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing -a raft of higher-order functions isn't a huge win anyway -- you really want to -specialise the function. - Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of @@ -1998,22 +1969,13 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take threshold_arity $ - [ (bndr_ty, NotMarkedStrict, get_dmd bndr bndr_ty) - | bndr <- bndrs - , isRuntimeVar bndr, let bndr_ty = idType bndr ] - - get_dmd :: Id -> Type -> Demand - get_dmd bndr bndr_ty - | isClassPred bndr_ty = trimBoxity dmd - -- See Note [Do not unbox class dictionaries] - -- NB: 'ty' has not been normalised, so this will (rightly) - -- catch newtype dictionaries too. - -- NB: even for bottoming functions, don't unbox dictionaries - - | is_bot_fn = unboxDeeplyDmd dmd - -- See Note [Boxity for bottoming functions], case (B) - - | otherwise = dmd + [ (idType bndr, NotMarkedStrict, get_dmd bndr) + | bndr <- bndrs, isRuntimeVar bndr ] + + get_dmd :: Id -> Demand + get_dmd bndr + | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], + | otherwise = dmd -- case (B) where dmd = idDemandInfo bndr @@ -2119,6 +2081,12 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) -- isMarkedStrict: see Note [Unboxing evaluated arguments] in DmdAnal -> DontUnbox + | doNotUnbox ty + -> DontUnbox -- See Note [Do not unbox class dictionaries] + -- NB: 'ty' has not been normalised, so this will (rightly) + -- catch newtype dictionaries too. + -- NB: even for bottoming functions, don't unbox dictionaries + | DefinitelyRecursive <- ae_rec_dc env dc -- See Note [Which types are unboxed?] -- and Note [Demand analysis for recursive data constructors] @@ -2129,6 +2097,76 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) (dataConRepStrictness dc) dmds) + +doNotUnbox :: Type -> Bool +-- Do not unbox class dictionaries, except equality classes and tuples +-- Note [Do not unbox class dictionaries] +doNotUnbox arg_ty + = case tyConAppTyCon_maybe arg_ty of + Just tc | Just cls <- tyConClass_maybe tc + -> not (isEqualityClass cls || isCTupleClass cls) + -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] + + _ -> False + +{- Note [Do not unbox class dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never unbox class dictionaries in worker/wrapper. + +1. INLINABLE functions + If we have + f :: Ord a => [a] -> Int -> a + {-# INLINABLE f #-} + and we worker/wrapper f, we'll get a worker with an INLINABLE pragma + (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), + which can still be specialised by the type-class specialiser, something like + fw :: Ord a => [a] -> Int# -> a + + BUT if f is strict in the Ord dictionary, we might unpack it, to get + fw :: (a->a->Bool) -> [a] -> Int# -> a + and the type-class specialiser can't specialise that. An example is #6056. + + Historical note: #14955 describes how I got this fix wrong the first time. + I got aware of the issue in T5075 by the change in boxity of loop between + demand analysis runs. + +2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur + occur without INLINABLE, when we use -fexpose-all-unfoldings and + -fspecialise-aggressively to do vigorous cross-module specialisation. + +3. #18421 found that unboxing a dictionary can also make the worker less likely + to inline; the inlining heuristics seem to prefer to inline a function + applied to a dictionary over a function applied to a bunch of functions. + +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing +a raft of higher-order functions isn't a huge win anyway -- you really want to +specialise the function. + +Wrinkle (DNB1): we /do/ want to unbox tuple dictionaries (#23398) + f :: (% Eq a, Show a %) => blah + with -fdicts-strict it is great to unbox to + $wf :: Eq a => Show a => blah + (where I have written out the currying explicitly). Now we can specialise + $wf on the Eq or Show dictionary. Nothing is lost. + + And something is gained. It is possible that `f` will look like this: + f = /\a. \d:(% Eq a, Show a %). ... f @a (% sel1 d, sel2 d %)... + where there is a recurive call to `f`, or to another function that takes the + same tuple dictionary, but where the tuple is built from the components of + `d`. The Simplier does not fix this. But if we unpacked the dictionary + we'd get + $wf = /\a. \(d1:Eq a) (d2:Show a). let d = (% d1, d2 %) + in ...f @a (% sel1 d, sel2 d %) + and all the tuple building and taking apart will disappear. + +Wrinkle (DNB2): we /do/ wnat to unbox equality dictionaries, + for (~), (~~), and Coercible (#23398). Their payload is a single unboxed + coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is + to make a copy of the function's RHS with a particular coercion. Unlike + normal class methods, that does not unlock any new optimisation + opportunities in the specialised RHS. +-} + {- ********************************************************************* * * Fixpoints ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqPredClass, isCTupleClass, isEqualityClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -219,11 +219,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -245,6 +240,20 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) +isEqPredClass :: Class -> Bool +-- True of (~) and (~~) +isEqPredClass cls = cls `hasKey` eqTyConKey + || cls `hasKey` heqTyConKey + +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + + {- ********************************************************************* * * Implicit parameters ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -53,6 +53,7 @@ import GHC.Data.Bag import Data.Maybe ( isJust ) import qualified Data.Semigroup as S +import GHC.Tc.Utils.Monad (getLclEnvLoc) {- ************************************************************************ @@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] - setLclEnv (ctLocEnv loc) $ - -- This setLclEnv is important: the emitImplicationTcS uses that + setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $ + -- This setSrcSpan is important: the emitImplicationTcS uses that -- TcLclEnv for the implication, and that in turn sets the location -- for the Givens when solving the constraint (#21006) do { let empty_subst = mkEmptySubst $ mkInScopeSet $ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad ( getSolvedDicts, setSolvedDicts, getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, setLclEnv, + getTopEnv, getGblEnv, getLclEnv, setSrcSpan, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, tcLookupClass, tcLookupId, tcLookupTyCon, @@ -194,6 +194,7 @@ import Data.IORef import Data.List ( mapAccumL ) import Data.Foldable import qualified Data.Semigroup as S +import GHC.Types.SrcLoc #if defined(DEBUG) import GHC.Types.Unique.Set (nonDetEltsUniqSet) @@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv getLclEnv :: TcS TcLclEnv getLclEnv = wrapTcS $ TcM.getLclEnv -setLclEnv :: TcLclEnv -> TcS a -> TcS a -setLclEnv env = wrap2TcS (TcM.setLclEnv env) +setSrcSpan :: RealSrcSpan -> TcS a -> TcS a +setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c ===================================== docs/users_guide/ghci.rst ===================================== @@ -3546,41 +3546,19 @@ The interpreter can't load modules with foreign export declarations! Unfortunately not. We haven't implemented it yet. Please compile any offending modules by hand before loading them into GHCi. -:ghc-flag:`-O` doesn't work with GHCi! +:ghc-flag:`-O` is ineffective in GHCi! .. index:: single: optimization; and GHCi - For technical reasons, the bytecode compiler doesn't interact well - with one of the optimisation passes, so we have disabled - optimisation when using the interpreter. This isn't a great loss: - you'll get a much bigger win by compiling the bits of your code that - need to go fast, rather than interpreting them with optimisation - turned on. + Before GHC 9.8, optimizations were considered too unstable to be used with + the bytecode interpreter. + This restriction has been lifted, but is still regarded as experimental and + guarded by :ghc-flag:`-funoptimized-core-for-interpreter`, which is enabled + by default. + In order to use optimizations, run: :: -Modules using unboxed tuples or sums will automatically enable :ghc-flag:`-fobject-code` - - .. index:: - single: unboxed tuples, sums; and GHCi - - The bytecode interpreter doesn't support most uses of unboxed tuples or - sums, so GHCi will automatically compile these modules, and all modules - they depend on, to object code instead of bytecode. - - GHCi checks for the presence of unboxed tuples and sums in a somewhat - conservative fashion: it simply checks to see if a module enables the - :extension:`UnboxedTuples` or :extension:`UnboxedSums` language extensions. - It is not always the case that code which enables :extension:`UnboxedTuples` - or :extension:`UnboxedSums` requires :ghc-flag:`-fobject-code`, so if you - *really* want to compile - :extension:`UnboxedTuples`/:extension:`UnboxedSums`-using code to - bytecode, you can do so explicitly by enabling the :ghc-flag:`-fbyte-code` - flag. If you do this, do note that bytecode interpreter will throw an error - if it encounters unboxed tuple/sum–related code that it cannot handle. - - Incidentally, the previous point, that :ghc-flag:`-O` is - incompatible with GHCi, is because the bytecode compiler can't - deal with unboxed tuples or sums. + ghci -fno-unoptimized-core-for-interpreter -O Concurrent threads don't carry on running when GHCi is waiting for input. This should work, as long as your GHCi was built with the ===================================== testsuite/tests/indexed-types/should_compile/T7837.stderr ===================================== @@ -1,3 +1,4 @@ Rule fired: Class op signum (BUILTIN) Rule fired: Class op abs (BUILTIN) Rule fired: normalize/Double (T7837) +Rule fired: Class op eq_sel (BUILTIN) ===================================== testsuite/tests/stranal/should_compile/T23398.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fdicts-strict #-} +module T23398 where + +type PairDict a = (Eq a, Show a) + +foo :: PairDict a => a -> a -> String +foo x y | x==y = show x + | otherwise = show y + +-- In worker/wrapper we'd like to unbox the pair +-- but not (Eq a) and (Show a) + +bar :: (a ~ b, Show a) => Int -> a -> (b, String) +bar 0 x = (x, show x) +bar n x = bar (n-1) x ===================================== testsuite/tests/stranal/should_compile/T23398.stderr ===================================== @@ -0,0 +1,109 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 76, types: 117, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} +T23398.$wfoo [InlPrag=[2]] + :: forall {a}. (Eq a, Show a) => a -> a -> String +[GblId[StrictWorker([!, !])], + Arity=4, + Str=, + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [30 60 0 0] 120 0}] +T23398.$wfoo + = \ (@a) (ww :: Eq a) (ww1 :: Show a) (eta :: a) (eta1 :: a) -> + case == @a ww eta eta1 of { + False -> show @a ww1 eta1; + True -> show @a ww1 eta + } + +-- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/0} +foo [InlPrag=[2]] :: forall a. PairDict a => a -> a -> String +[GblId, + Arity=3, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + ($d(%,%) [Occ=Once1!] :: PairDict a) + (eta [Occ=Once1] :: a) + (eta1 [Occ=Once1] :: a) -> + case $d(%,%) of { (ww [Occ=Once1], ww1 [Occ=Once1]) -> + T23398.$wfoo @a ww ww1 eta eta1 + }}] +foo + = \ (@a) ($d(%,%) :: PairDict a) (eta :: a) (eta1 :: a) -> + case $d(%,%) of { (ww, ww1) -> T23398.$wfoo @a ww ww1 eta eta1 } + +Rec { +-- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} +T23398.$wbar [InlPrag=[2], Occ=LoopBreaker] + :: forall {a} {b}. + (a GHC.Prim.~# b, Show a) => + GHC.Prim.Int# -> a -> (# b, String #) +[GblId[StrictWorker([~, !])], + Arity=4, + Str=<1L>, + Unf=OtherCon []] +T23398.$wbar + = \ (@a) + (@b) + (ww :: a GHC.Prim.~# b) + ($dShow :: Show a) + (ww1 :: GHC.Prim.Int#) + (eta :: a) -> + case ww1 of ds { + __DEFAULT -> + T23398.$wbar + @a @b @~(ww :: a GHC.Prim.~# b) $dShow (GHC.Prim.-# ds 1#) eta; + 0# -> (# eta `cast` (Sub ww :: a ~R# b), show @a $dShow eta #) + } +end Rec } + +-- RHS size: {terms: 21, types: 32, coercions: 1, joins: 0/0} +bar [InlPrag=[2]] + :: forall a b. (a ~ b, Show a) => Int -> a -> (b, String) +[GblId, + Arity=4, + Str=<1!P(1L)>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (@b) + ($d~ [Occ=Once1!] :: a ~ b) + ($dShow [Occ=Once1] :: Show a) + (eta [Occ=Once1!] :: Int) + (eta1 [Occ=Once1] :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 [Occ=Once1] -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2 [Occ=Once1], ww3 [Occ=Once1] #) -> + (ww2, ww3) + } + } + }}] +bar + = \ (@a) + (@b) + ($d~ :: a ~ b) + ($dShow :: Show a) + (eta :: Int) + (eta1 :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2, ww3 #) -> + (ww2, ww3) + } + } + } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -93,3 +93,4 @@ test('T22039', normal, compile, ['']) test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) # T22997: Just a panic that should not happen test('T22997', normal, compile, ['']) +test('T23398', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe0e8c9c13916d4e32b65543c083d227db256d23...41f77ee59cd74819f0e6c11d41b3020e12474a4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe0e8c9c13916d4e32b65543c083d227db256d23...41f77ee59cd74819f0e6c11d41b3020e12474a4a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 07:54:06 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 18 May 2023 03:54:06 -0400 Subject: [Git][ghc/ghc][wip/T23398] Allow the demand analyser to unpack tuple and equality dictionaries Message-ID: <6465d99e6f4e3_9760abbb096c1877e5@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23398 at Glasgow Haskell Compiler / GHC Commits: f78a43e9 by Simon Peyton Jones at 2023-05-18T08:55:50+01:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - 6 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - testsuite/tests/indexed-types/should_compile/T7837.stderr - + testsuite/tests/stranal/should_compile/T23398.hs - + testsuite/tests/stranal/should_compile/T23398.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -16,37 +16,41 @@ where import GHC.Prelude -import GHC.Core.Opt.WorkWrap.Utils import GHC.Types.Demand -- All of it + import GHC.Core -import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Utils.Outputable -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic -import Data.List ( mapAccumL ) import GHC.Core.DataCon -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Predicate( isClassPred ) +import GHC.Core.Predicate( isEqualityClass, isCTupleClass ) import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain +import GHC.Core.Opt.WorkWrap.Utils + import GHC.Builtin.PrimOps import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) + import GHC.Types.Unique.Set import GHC.Types.Unique.MemoFun import GHC.Types.RepType +import GHC.Types.ForeignCall ( isSafeForeignCall ) +import GHC.Types.Id +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Outputable + +import Data.List ( mapAccumL ) {- ************************************************************************ @@ -1499,7 +1503,7 @@ bounds-checking. So we want to give `indexError` a signature like `<1!P(!S,!S)><1!S>b` where the !S (meaning Poly Unboxed C1N) says that the polymorphic arguments -are unboxed (recursively). The wrapper for `indexError` won't /acutally/ +are unboxed (recursively). The wrapper for `indexError` won't /actually/ unbox them (because their polymorphic type doesn't allow that) but when demand-analysing /callers/, we'll behave as if that call needs the args unboxed. @@ -1782,39 +1786,6 @@ applying the strictness demands to the final result of DmdAnal. The result is that we get the strict demand signature we wanted even if we can't float the case on `x` up through the case on `burble`. -Note [Do not unbox class dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never unbox class dictionaries in worker/wrapper. - -1. INLINABLE functions - If we have - f :: Ord a => [a] -> Int -> a - {-# INLINABLE f #-} - and we worker/wrapper f, we'll get a worker with an INLINABLE pragma - (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), - which can still be specialised by the type-class specialiser, something like - fw :: Ord a => [a] -> Int# -> a - - BUT if f is strict in the Ord dictionary, we might unpack it, to get - fw :: (a->a->Bool) -> [a] -> Int# -> a - and the type-class specialiser can't specialise that. An example is #6056. - - Historical note: #14955 describes how I got this fix wrong the first time. - I got aware of the issue in T5075 by the change in boxity of loop between - demand analysis runs. - -2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur - occur without INLINABLE, when we use -fexpose-all-unfoldings and - -fspecialise-aggressively to do vigorous cross-module specialisation. - -3. #18421 found that unboxing a dictionary can also make the worker less likely - to inline; the inlining heuristics seem to prefer to inline a function - applied to a dictionary over a function applied to a bunch of functions. - -TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing -a raft of higher-order functions isn't a huge win anyway -- you really want to -specialise the function. - Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of @@ -1998,22 +1969,13 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take threshold_arity $ - [ (bndr_ty, NotMarkedStrict, get_dmd bndr bndr_ty) - | bndr <- bndrs - , isRuntimeVar bndr, let bndr_ty = idType bndr ] - - get_dmd :: Id -> Type -> Demand - get_dmd bndr bndr_ty - | isClassPred bndr_ty = trimBoxity dmd - -- See Note [Do not unbox class dictionaries] - -- NB: 'ty' has not been normalised, so this will (rightly) - -- catch newtype dictionaries too. - -- NB: even for bottoming functions, don't unbox dictionaries - - | is_bot_fn = unboxDeeplyDmd dmd - -- See Note [Boxity for bottoming functions], case (B) - - | otherwise = dmd + [ (idType bndr, NotMarkedStrict, get_dmd bndr) + | bndr <- bndrs, isRuntimeVar bndr ] + + get_dmd :: Id -> Demand + get_dmd bndr + | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], + | otherwise = dmd -- case (B) where dmd = idDemandInfo bndr @@ -2119,6 +2081,12 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) -- isMarkedStrict: see Note [Unboxing evaluated arguments] in DmdAnal -> DontUnbox + | doNotUnbox ty + -> DontUnbox -- See Note [Do not unbox class dictionaries] + -- NB: 'ty' has not been normalised, so this will (rightly) + -- catch newtype dictionaries too. + -- NB: even for bottoming functions, don't unbox dictionaries + | DefinitelyRecursive <- ae_rec_dc env dc -- See Note [Which types are unboxed?] -- and Note [Demand analysis for recursive data constructors] @@ -2129,6 +2097,76 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) (dataConRepStrictness dc) dmds) + +doNotUnbox :: Type -> Bool +-- Do not unbox class dictionaries, except equality classes and tuples +-- Note [Do not unbox class dictionaries] +doNotUnbox arg_ty + = case tyConAppTyCon_maybe arg_ty of + Just tc | Just cls <- tyConClass_maybe tc + -> not (isEqualityClass cls || isCTupleClass cls) + -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] + + _ -> False + +{- Note [Do not unbox class dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never unbox class dictionaries in worker/wrapper. + +1. INLINABLE functions + If we have + f :: Ord a => [a] -> Int -> a + {-# INLINABLE f #-} + and we worker/wrapper f, we'll get a worker with an INLINABLE pragma + (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), + which can still be specialised by the type-class specialiser, something like + fw :: Ord a => [a] -> Int# -> a + + BUT if f is strict in the Ord dictionary, we might unpack it, to get + fw :: (a->a->Bool) -> [a] -> Int# -> a + and the type-class specialiser can't specialise that. An example is #6056. + + Historical note: #14955 describes how I got this fix wrong the first time. + I got aware of the issue in T5075 by the change in boxity of loop between + demand analysis runs. + +2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur + occur without INLINABLE, when we use -fexpose-all-unfoldings and + -fspecialise-aggressively to do vigorous cross-module specialisation. + +3. #18421 found that unboxing a dictionary can also make the worker less likely + to inline; the inlining heuristics seem to prefer to inline a function + applied to a dictionary over a function applied to a bunch of functions. + +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing +a raft of higher-order functions isn't a huge win anyway -- you really want to +specialise the function. + +Wrinkle (DNB1): we /do/ want to unbox tuple dictionaries (#23398) + f :: (% Eq a, Show a %) => blah + with -fdicts-strict it is great to unbox to + $wf :: Eq a => Show a => blah + (where I have written out the currying explicitly). Now we can specialise + $wf on the Eq or Show dictionary. Nothing is lost. + + And something is gained. It is possible that `f` will look like this: + f = /\a. \d:(% Eq a, Show a %). ... f @a (% sel1 d, sel2 d %)... + where there is a recurive call to `f`, or to another function that takes the + same tuple dictionary, but where the tuple is built from the components of + `d`. The Simplier does not fix this. But if we unpacked the dictionary + we'd get + $wf = /\a. \(d1:Eq a) (d2:Show a). let d = (% d1, d2 %) + in ...f @a (% sel1 d, sel2 d %) + and all the tuple building and taking apart will disappear. + +Wrinkle (DNB2): we /do/ wnat to unbox equality dictionaries, + for (~), (~~), and Coercible (#23398). Their payload is a single unboxed + coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is + to make a copy of the function's RHS with a particular coercion. Unlike + normal class methods, that does not unlock any new optimisation + opportunities in the specialised RHS. +-} + {- ********************************************************************* * * Fixpoints ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqPredClass, isCTupleClass, isEqualityClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -219,11 +219,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -245,6 +240,20 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) +isEqPredClass :: Class -> Bool +-- True of (~) and (~~) +isEqPredClass cls = cls `hasKey` eqTyConKey + || cls `hasKey` heqTyConKey + +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + + {- ********************************************************************* * * Implicit parameters ===================================== testsuite/tests/indexed-types/should_compile/T7837.stderr ===================================== @@ -1,3 +1,4 @@ Rule fired: Class op signum (BUILTIN) Rule fired: Class op abs (BUILTIN) Rule fired: normalize/Double (T7837) +Rule fired: Class op eq_sel (BUILTIN) ===================================== testsuite/tests/stranal/should_compile/T23398.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fdicts-strict #-} +module T23398 where + +type PairDict a = (Eq a, Show a) + +foo :: PairDict a => a -> a -> String +foo x y | x==y = show x + | otherwise = show y + +-- In worker/wrapper we'd like to unbox the pair +-- but not (Eq a) and (Show a) + +bar :: (a ~ b, Show a) => Int -> a -> (b, String) +bar 0 x = (x, show x) +bar n x = bar (n-1) x ===================================== testsuite/tests/stranal/should_compile/T23398.stderr ===================================== @@ -0,0 +1,109 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 76, types: 117, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} +T23398.$wfoo [InlPrag=[2]] + :: forall {a}. (Eq a, Show a) => a -> a -> String +[GblId[StrictWorker([!, !])], + Arity=4, + Str=, + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [30 60 0 0] 120 0}] +T23398.$wfoo + = \ (@a) (ww :: Eq a) (ww1 :: Show a) (eta :: a) (eta1 :: a) -> + case == @a ww eta eta1 of { + False -> show @a ww1 eta1; + True -> show @a ww1 eta + } + +-- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/0} +foo [InlPrag=[2]] :: forall a. PairDict a => a -> a -> String +[GblId, + Arity=3, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + ($d(%,%) [Occ=Once1!] :: PairDict a) + (eta [Occ=Once1] :: a) + (eta1 [Occ=Once1] :: a) -> + case $d(%,%) of { (ww [Occ=Once1], ww1 [Occ=Once1]) -> + T23398.$wfoo @a ww ww1 eta eta1 + }}] +foo + = \ (@a) ($d(%,%) :: PairDict a) (eta :: a) (eta1 :: a) -> + case $d(%,%) of { (ww, ww1) -> T23398.$wfoo @a ww ww1 eta eta1 } + +Rec { +-- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} +T23398.$wbar [InlPrag=[2], Occ=LoopBreaker] + :: forall {a} {b}. + (a GHC.Prim.~# b, Show a) => + GHC.Prim.Int# -> a -> (# b, String #) +[GblId[StrictWorker([~, !])], + Arity=4, + Str=<1L>, + Unf=OtherCon []] +T23398.$wbar + = \ (@a) + (@b) + (ww :: a GHC.Prim.~# b) + ($dShow :: Show a) + (ww1 :: GHC.Prim.Int#) + (eta :: a) -> + case ww1 of ds { + __DEFAULT -> + T23398.$wbar + @a @b @~(ww :: a GHC.Prim.~# b) $dShow (GHC.Prim.-# ds 1#) eta; + 0# -> (# eta `cast` (Sub ww :: a ~R# b), show @a $dShow eta #) + } +end Rec } + +-- RHS size: {terms: 21, types: 32, coercions: 1, joins: 0/0} +bar [InlPrag=[2]] + :: forall a b. (a ~ b, Show a) => Int -> a -> (b, String) +[GblId, + Arity=4, + Str=<1!P(1L)>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (@b) + ($d~ [Occ=Once1!] :: a ~ b) + ($dShow [Occ=Once1] :: Show a) + (eta [Occ=Once1!] :: Int) + (eta1 [Occ=Once1] :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 [Occ=Once1] -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2 [Occ=Once1], ww3 [Occ=Once1] #) -> + (ww2, ww3) + } + } + }}] +bar + = \ (@a) + (@b) + ($d~ :: a ~ b) + ($dShow :: Show a) + (eta :: Int) + (eta1 :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2, ww3 #) -> + (ww2, ww3) + } + } + } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -93,3 +93,4 @@ test('T22039', normal, compile, ['']) test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) # T22997: Just a panic that should not happen test('T22997', normal, compile, ['']) +test('T23398', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f78a43e96c51fc4874e22e5aea629d2baeaca54d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f78a43e96c51fc4874e22e5aea629d2baeaca54d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 08:21:33 2023 From: gitlab at gitlab.haskell.org (Peter Trommler (@trommler)) Date: Thu, 18 May 2023 04:21:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23316 Message-ID: <6465e00d21503_9760abbb0994193066@gitlab.mail> Peter Trommler pushed new branch wip/T23316 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23316 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 09:13:10 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 May 2023 05:13:10 -0400 Subject: [Git][ghc/ghc][wip/test-nightlies] 18 commits: JS: Implement h$clock_gettime in the JavaScript RTS (#23360) Message-ID: <6465ec262be66_9760abbb09941961d1@gitlab.mail> Matthew Pickering pushed to branch wip/test-nightlies at Glasgow Haskell Compiler / GHC Commits: 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 49495825 by Matthew Pickering at 2023-05-18T10:00:20+01:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - 034ba78c by Matthew Pickering at 2023-05-18T10:01:17+01:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5bbd11cf by Matthew Pickering at 2023-05-18T10:04:52+01:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 5355aaa8 by Matthew Pickering at 2023-05-18T10:05:00+01:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 4c352de9 by Matthew Pickering at 2023-05-18T10:05:06+01:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 377b5e79 by Matthew Pickering at 2023-05-18T10:05:21+01:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 08bd7063 by Matthew Pickering at 2023-05-18T10:06:13+01:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2694822185e11d29a4ab6602900079b435ed5824...08bd7063963df86397392b5ef4a7322d715a0b23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2694822185e11d29a4ab6602900079b435ed5824...08bd7063963df86397392b5ef4a7322d715a0b23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 09:26:56 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 May 2023 05:26:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/stray-dump-flags Message-ID: <6465ef60caec5_9760ab41e65420061b@gitlab.mail> Matthew Pickering pushed new branch wip/stray-dump-flags at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/stray-dump-flags You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 09:47:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 May 2023 05:47:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <6465f43f3a9ab_9760abbb09942134fd@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - d0650886 by Ben Gamari at 2023-05-18T05:47:24-04:00 base: Add test for #13660 - - - - - 3a972838 by Ben Gamari at 2023-05-18T05:47:24-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 627446cb by Ben Gamari at 2023-05-18T05:47:24-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - fdd0582d by Ben Gamari at 2023-05-18T05:47:24-04:00 base: Clean up documentation - - - - - 1a9322ee by Ben Gamari at 2023-05-18T05:47:24-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 70c6bca2 by Torsten Schmits at 2023-05-18T05:47:26-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 17 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - docs/users_guide/ghci.rst - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - + libraries/base/tests/T13660.hs - + libraries/base/tests/T13660.stdout - libraries/base/tests/all.T - testsuite/tests/ghc-api/T10052/T10052.stderr - testsuite/tests/ghci.debugger/scripts/print007.stderr - testsuite/tests/ghci/should_fail/T10549.stderr - testsuite/tests/ghci/should_fail/T10549a.stderr - testsuite/tests/safeHaskell/ghci/p14.stderr - testsuite/tests/th/T8333.stderr Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3658,9 +3658,10 @@ makeDynFlagsConsistent dflags , gopt Opt_UnoptimizedCoreForInterpreter dflags , let (dflags', changed) = updOptLevelChanged 0 dflags , changed - = loop dflags' ("Optimization flags are incompatible with the " ++ - backendDescription (backend dflags) ++ - "; optimization flags ignored.") + = loop dflags' $ + "Using optimization flags with the " ++ + backendDescription (backend dflags) ++ " is experimental. " ++ + "Pass -fno-unoptimized-core-for-interpreter to enable this feature." | LinkInMemory <- ghcLink dflags , not (gopt Opt_ExternalInterpreter dflags) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -53,6 +53,7 @@ import GHC.Data.Bag import Data.Maybe ( isJust ) import qualified Data.Semigroup as S +import GHC.Tc.Utils.Monad (getLclEnvLoc) {- ************************************************************************ @@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] - setLclEnv (ctLocEnv loc) $ - -- This setLclEnv is important: the emitImplicationTcS uses that + setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $ + -- This setSrcSpan is important: the emitImplicationTcS uses that -- TcLclEnv for the implication, and that in turn sets the location -- for the Givens when solving the constraint (#21006) do { let empty_subst = mkEmptySubst $ mkInScopeSet $ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad ( getSolvedDicts, setSolvedDicts, getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, setLclEnv, + getTopEnv, getGblEnv, getLclEnv, setSrcSpan, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, tcLookupClass, tcLookupId, tcLookupTyCon, @@ -194,6 +194,7 @@ import Data.IORef import Data.List ( mapAccumL ) import Data.Foldable import qualified Data.Semigroup as S +import GHC.Types.SrcLoc #if defined(DEBUG) import GHC.Types.Unique.Set (nonDetEltsUniqSet) @@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv getLclEnv :: TcS TcLclEnv getLclEnv = wrapTcS $ TcM.getLclEnv -setLclEnv :: TcLclEnv -> TcS a -> TcS a -setLclEnv env = wrap2TcS (TcM.setLclEnv env) +setSrcSpan :: RealSrcSpan -> TcS a -> TcS a +setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c ===================================== docs/users_guide/ghci.rst ===================================== @@ -3546,41 +3546,19 @@ The interpreter can't load modules with foreign export declarations! Unfortunately not. We haven't implemented it yet. Please compile any offending modules by hand before loading them into GHCi. -:ghc-flag:`-O` doesn't work with GHCi! +:ghc-flag:`-O` is ineffective in GHCi! .. index:: single: optimization; and GHCi - For technical reasons, the bytecode compiler doesn't interact well - with one of the optimisation passes, so we have disabled - optimisation when using the interpreter. This isn't a great loss: - you'll get a much bigger win by compiling the bits of your code that - need to go fast, rather than interpreting them with optimisation - turned on. + Before GHC 9.8, optimizations were considered too unstable to be used with + the bytecode interpreter. + This restriction has been lifted, but is still regarded as experimental and + guarded by :ghc-flag:`-funoptimized-core-for-interpreter`, which is enabled + by default. + In order to use optimizations, run: :: -Modules using unboxed tuples or sums will automatically enable :ghc-flag:`-fobject-code` - - .. index:: - single: unboxed tuples, sums; and GHCi - - The bytecode interpreter doesn't support most uses of unboxed tuples or - sums, so GHCi will automatically compile these modules, and all modules - they depend on, to object code instead of bytecode. - - GHCi checks for the presence of unboxed tuples and sums in a somewhat - conservative fashion: it simply checks to see if a module enables the - :extension:`UnboxedTuples` or :extension:`UnboxedSums` language extensions. - It is not always the case that code which enables :extension:`UnboxedTuples` - or :extension:`UnboxedSums` requires :ghc-flag:`-fobject-code`, so if you - *really* want to compile - :extension:`UnboxedTuples`/:extension:`UnboxedSums`-using code to - bytecode, you can do so explicitly by enabling the :ghc-flag:`-fbyte-code` - flag. If you do this, do note that bytecode interpreter will throw an error - if it encounters unboxed tuple/sum–related code that it cannot handle. - - Incidentally, the previous point, that :ghc-flag:`-O` is - incompatible with GHCi, is because the bytecode compiler can't - deal with unboxed tuples or sums. + ghci -fno-unoptimized-core-for-interpreter -O Concurrent threads don't carry on running when GHCi is waiting for input. This should work, as long as your GHCi was built with the ===================================== libraries/base/GHC/Foreign.hs ===================================== @@ -21,312 +21,22 @@ module GHC.Foreign ( -- * C strings with a configurable encoding CString, CStringLen, - -- conversion of C strings into Haskell strings - -- + -- * Conversion of C strings into Haskell strings peekCString, peekCStringLen, - -- conversion of Haskell strings into C strings - -- + -- * Conversion of Haskell strings into C strings newCString, newCStringLen, + newCStringLen0, - -- conversion of Haskell strings into C strings using temporary storage - -- + -- * Conversion of Haskell strings into C strings using temporary storage withCString, withCStringLen, + withCStringLen0, withCStringsLen, charIsRepresentable, ) where -import Foreign.Marshal.Array -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Storable - -import Data.Word - --- Imports for the locale-encoding version of marshallers - -import Data.Tuple (fst) - -import GHC.Show ( show ) - -import Foreign.Marshal.Alloc -import Foreign.ForeignPtr - -import GHC.Debug -import GHC.List -import GHC.Num -import GHC.Base - -import GHC.IO -import GHC.IO.Exception -import GHC.IO.Buffer -import GHC.IO.Encoding.Types - - -c_DEBUG_DUMP :: Bool -c_DEBUG_DUMP = False - -putDebugMsg :: String -> IO () -putDebugMsg | c_DEBUG_DUMP = debugLn - | otherwise = const (return ()) - - --- | A C string is a reference to an array of C characters terminated by NUL. -type CString = Ptr CChar - --- | A string with explicit length information in bytes instead of a --- terminating NUL (allowing NUL characters in the middle of the string). -type CStringLen = (Ptr CChar, Int) - --- exported functions --- ------------------ - --- | Marshal a NUL terminated C string into a Haskell string. --- -peekCString :: TextEncoding -> CString -> IO String -peekCString enc cp = do - sz <- lengthArray0 nUL cp - peekEncodedCString enc (cp, sz * cCharSize) - --- | Marshal a C string with explicit length into a Haskell string. --- -peekCStringLen :: TextEncoding -> CStringLen -> IO String -peekCStringLen = peekEncodedCString - --- | Marshal a Haskell string into a NUL terminated C string. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCString :: TextEncoding -> String -> IO CString -newCString enc = liftM fst . newEncodedCString enc True - --- | Marshal a Haskell string into a C string (ie, character array) with --- explicit length information. --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCStringLen :: TextEncoding -> String -> IO CStringLen -newCStringLen enc = newEncodedCString enc False - --- | Marshal a Haskell string into a NUL terminated C string using temporary --- storage. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a -withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp - --- | Marshal a Haskell string into a C string (ie, character array) --- in temporary storage, with explicit length information. --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a -withCStringLen enc = withEncodedCString enc False - --- | Marshal a list of Haskell strings into an array of NUL terminated C strings --- using temporary storage. --- --- * the Haskell strings may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringsLen :: TextEncoding - -> [String] - -> (Int -> Ptr CString -> IO a) - -> IO a -withCStringsLen enc strs f = go [] strs - where - go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss - go cs [] = withArrayLen (reverse cs) f - --- | Determines whether a character can be accurately encoded in a --- 'Foreign.C.String.CString'. --- --- Pretty much anyone who uses this function is in a state of sin because --- whether or not a character is encodable will, in general, depend on the --- context in which it occurs. -charIsRepresentable :: TextEncoding -> Char -> IO Bool --- We force enc explicitly because `catch` is lazy in its --- first argument. We would probably like to force c as well, --- but unfortunately worker/wrapper produces very bad code for --- that. --- --- TODO If this function is performance-critical, it would probably --- pay to use a single-character specialization of withCString. That --- would allow worker/wrapper to actually eliminate Char boxes, and --- would also get rid of the completely unnecessary cons allocation. -charIsRepresentable !enc c = - withCString enc [c] - (\cstr -> do str <- peekCString enc cstr - case str of - [ch] | ch == c -> pure True - _ -> pure False) - `catch` - \(_ :: IOException) -> pure False - --- auxiliary definitions --- ---------------------- - --- C's end of string character -nUL :: CChar -nUL = 0 - --- Size of a CChar in bytes -cCharSize :: Int -cCharSize = sizeOf (undefined :: CChar) - - -{-# INLINE peekEncodedCString #-} -peekEncodedCString :: TextEncoding -- ^ Encoding of CString - -> CStringLen - -> IO String -- ^ String in Haskell terms -peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) - = bracket mk_decoder close $ \decoder -> do - let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII - !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) - !to <- newCharBuffer chunk_size WriteBuffer - - let go !iteration !from = do - (why, from', !to') <- encode decoder from to - if isEmptyBuffer from' - then - -- No input remaining: @why@ will be InputUnderflow, but we don't care - withBuffer to' $ peekArray (bufferElems to') - else do - -- Input remaining: what went wrong? - putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) - (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because - InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input - OutputUnderflow -> return (from', to') -- We will have more space next time round - putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') - putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') - to_chars <- withBuffer to'' $ peekArray (bufferElems to'') - fmap (to_chars++) $ go (iteration + 1) from'' - - go (0 :: Int) from0 - -{-# INLINE withEncodedCString #-} -withEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory - -> IO a -withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_sz_bytes = do - putDebugMsg ("withEncodedCString: " ++ show iteration) - allocaBytes to_sz_bytes $ \to_p -> do - -- See Note [Check *before* fill in withEncodedCString] about why - -- this is subtle. - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> go (iteration + 1) (to_sz_bytes * 2) - Just to_buf -> withCStringBuffer to_buf null_terminate act - - -- If the input string is ASCII, this value will ensure we only allocate once - go (0 :: Int) (cCharSize * (sz + 1)) - -withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r -withCStringBuffer to_buf null_terminate act = do - let bytes = bufferElems to_buf - withBuffer to_buf $ \to_ptr -> do - when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 - act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* - -{-# INLINE newEncodedCString #-} -newEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> IO CStringLen -newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_p to_sz_bytes = do - putDebugMsg ("newEncodedCString: " ++ show iteration) - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> do - let to_sz_bytes' = to_sz_bytes * 2 - to_p' <- reallocBytes to_p to_sz_bytes' - go (iteration + 1) to_p' to_sz_bytes' - Just to_buf -> withCStringBuffer to_buf null_terminate return - - -- If the input string is ASCII, this value will ensure we only allocate once - let to_sz_bytes = cCharSize * (sz + 1) - to_p <- mallocBytes to_sz_bytes - go (0 :: Int) to_p to_sz_bytes - - -tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int - -> IO (Maybe (Buffer Word8)) -tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do - !to_fp <- newForeignPtr_ to_p - go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) - where - go !iteration !from !to = do - (why, from', to') <- encode encoder from to - putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') - if isEmptyBuffer from' - then if null_terminate && bufferAvailable to' == 0 - then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer - else return (Just to') - else case why of -- We didn't consume all of the input - InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad - InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid - OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more -{- -Note [Check *before* fill in withEncodedCString] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's very important that the size check and readjustment peformed by tryFillBuffer -happens before the continuation is called. The size check is the part which can -fail, the call to the continuation never fails and so the caller should respond -first to the size check failing and *then* call the continuation. Making this evident -to the compiler avoids historic space leaks. - -In a previous iteration of this code we had a pattern that, somewhat simplified, -looked like this: - -go :: State -> (State -> IO a) -> IO a -go state action = - case tryFillBufferAndCall state action of - Left state' -> go state' action - Right result -> result - -`tryFillBufferAndCall` performed some checks, and then we either called action, -or we modified the state and tried again. -This went wrong because `action` can be a function closure containing a reference to -a lazy data structure. If we call action directly, without retaining any references -to action, that is fine. The data structure is consumed as it is produced and we operate -in constant space. - -However the failure branch `go state' action` *does* capture a reference to action. -This went wrong because the reference to action in the failure branch only becomes -unreachable *after* action returns. This means we keep alive the function closure -for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list -via `action` until the action has fully run. -This went wrong in #20107, where the continuation kept an entire lazy bytestring alive -rather than allowing it to be incrementally consumed and collected. --} - +import GHC.Foreign.Internal ===================================== libraries/base/GHC/Foreign/Internal.hs ===================================== @@ -0,0 +1,357 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Foreign.Internal +-- Copyright : (c) The University of Glasgow, 2008-2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : libraries at haskell.org +-- Stability : internal +-- Portability : non-portable +-- +-- Foreign marshalling support for CStrings with configurable encodings +-- +----------------------------------------------------------------------------- + +module GHC.Foreign.Internal ( + -- * C strings with a configurable encoding + CString, CStringLen, + + -- * Conversion of C strings into Haskell strings + peekCString, + peekCStringLen, + + -- * Conversion of Haskell strings into C strings + newCString, + newCStringLen, + newCStringLen0, + + -- * Conversion of Haskell strings into C strings using temporary storage + withCString, + withCStringLen, + withCStringLen0, + withCStringsLen, + + charIsRepresentable, + ) where + +import Foreign.Marshal.Array +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable + +import Data.Word + +-- Imports for the locale-encoding version of marshallers + +import Data.Tuple (fst) + +import GHC.Show ( show ) + +import Foreign.Marshal.Alloc +import Foreign.ForeignPtr + +import GHC.Debug +import GHC.List +import GHC.Num +import GHC.Base + +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Buffer +import GHC.IO.Encoding.Types + + +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False + +putDebugMsg :: String -> IO () +putDebugMsg | c_DEBUG_DUMP = debugLn + | otherwise = const (return ()) + + +-- | A C string is a reference to an array of C characters terminated by NUL. +type CString = Ptr CChar + +-- | A string with explicit length information in bytes instead of a +-- terminating NUL (allowing NUL characters in the middle of the string). +type CStringLen = (Ptr CChar, Int) + +-- exported functions +-- ------------------ + +-- | Marshal a NUL terminated C string into a Haskell string. +-- +peekCString :: TextEncoding -> CString -> IO String +peekCString enc cp = do + sz <- lengthArray0 nUL cp + peekEncodedCString enc (cp, sz * cCharSize) + +-- | Marshal a C string with explicit length into a Haskell string. +-- +peekCStringLen :: TextEncoding -> CStringLen -> IO String +peekCStringLen = peekEncodedCString + +-- | Marshal a Haskell string into a NUL terminated C string. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCString :: TextEncoding -> String -> IO CString +newCString enc = liftM fst . newEncodedCString enc True + +-- | Marshal a Haskell string into a C string (ie, character array) with +-- explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCStringLen :: TextEncoding -> String -> IO CStringLen +newCStringLen enc = newEncodedCString enc False + +-- | Marshal a Haskell string into a NUL terminated C string using temporary +-- storage. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a +withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp + +-- | Marshal a Haskell string into a C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen enc = withEncodedCString enc False + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- with explicit length information. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +-- @since 4.19.0.0 +newCStringLen0 :: TextEncoding -> String -> IO CStringLen +newCStringLen0 enc = newEncodedCString enc True + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +-- @since 4.19.0.0 +withCStringLen0 :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen0 enc = withEncodedCString enc True + +-- | Marshal a list of Haskell strings into an array of NUL terminated C strings +-- using temporary storage. +-- +-- * the Haskell strings may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringsLen :: TextEncoding + -> [String] + -> (Int -> Ptr CString -> IO a) + -> IO a +withCStringsLen enc strs f = go [] strs + where + go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss + go cs [] = withArrayLen (reverse cs) f + +-- | Determines whether a character can be accurately encoded in a +-- 'Foreign.C.String.CString'. +-- +-- Pretty much anyone who uses this function is in a state of sin because +-- whether or not a character is encodable will, in general, depend on the +-- context in which it occurs. +charIsRepresentable :: TextEncoding -> Char -> IO Bool +-- We force enc explicitly because `catch` is lazy in its +-- first argument. We would probably like to force c as well, +-- but unfortunately worker/wrapper produces very bad code for +-- that. +-- +-- TODO If this function is performance-critical, it would probably +-- pay to use a single-character specialization of withCString. That +-- would allow worker/wrapper to actually eliminate Char boxes, and +-- would also get rid of the completely unnecessary cons allocation. +charIsRepresentable !enc c = + withCString enc [c] + (\cstr -> do str <- peekCString enc cstr + case str of + [ch] | ch == c -> pure True + _ -> pure False) + `catch` + \(_ :: IOException) -> pure False + +-- auxiliary definitions +-- ---------------------- + +-- C's end of string character +nUL :: CChar +nUL = 0 + +-- Size of a CChar in bytes +cCharSize :: Int +cCharSize = sizeOf (undefined :: CChar) + + +{-# INLINE peekEncodedCString #-} +peekEncodedCString :: TextEncoding -- ^ Encoding of CString + -> CStringLen + -> IO String -- ^ String in Haskell terms +peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) + = bracket mk_decoder close $ \decoder -> do + let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII + !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) + !to <- newCharBuffer chunk_size WriteBuffer + + let go !iteration !from = do + (why, from', !to') <- encode decoder from to + if isEmptyBuffer from' + then + -- No input remaining: @why@ will be InputUnderflow, but we don't care + withBuffer to' $ peekArray (bufferElems to') + else do + -- Input remaining: what went wrong? + putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) + (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because + InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input + OutputUnderflow -> return (from', to') -- We will have more space next time round + putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') + putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') + to_chars <- withBuffer to'' $ peekArray (bufferElems to'') + fmap (to_chars++) $ go (iteration + 1) from'' + + go (0 :: Int) from0 + +{-# INLINE withEncodedCString #-} +withEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory + -> IO a +withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_sz_bytes = do + putDebugMsg ("withEncodedCString: " ++ show iteration) + allocaBytes to_sz_bytes $ \to_p -> do + -- See Note [Check *before* fill in withEncodedCString] about why + -- this is subtle. + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> go (iteration + 1) (to_sz_bytes * 2) + Just to_buf -> withCStringBuffer to_buf null_terminate act + + -- If the input string is ASCII, this value will ensure we only allocate once + go (0 :: Int) (cCharSize * (sz + 1)) + +withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r +withCStringBuffer to_buf null_terminate act = do + let bytes = bufferElems to_buf + withBuffer to_buf $ \to_ptr -> do + when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 + act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* + +{-# INLINE newEncodedCString #-} +newEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> IO CStringLen +newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_p to_sz_bytes = do + putDebugMsg ("newEncodedCString: " ++ show iteration) + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> do + let to_sz_bytes' = to_sz_bytes * 2 + to_p' <- reallocBytes to_p to_sz_bytes' + go (iteration + 1) to_p' to_sz_bytes' + Just to_buf -> withCStringBuffer to_buf null_terminate return + + -- If the input string is ASCII, this value will ensure we only allocate once + let to_sz_bytes = cCharSize * (sz + 1) + to_p <- mallocBytes to_sz_bytes + go (0 :: Int) to_p to_sz_bytes + + +tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int + -> IO (Maybe (Buffer Word8)) +tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do + !to_fp <- newForeignPtr_ to_p + go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) + where + go !iteration !from !to = do + (why, from', to') <- encode encoder from to + putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') + if isEmptyBuffer from' + then if null_terminate && bufferAvailable to' == 0 + then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer + else return (Just to') + else case why of -- We didn't consume all of the input + InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad + InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid + OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more +{- +Note [Check *before* fill in withEncodedCString] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's very important that the size check and readjustment peformed by tryFillBuffer +happens before the continuation is called. The size check is the part which can +fail, the call to the continuation never fails and so the caller should respond +first to the size check failing and *then* call the continuation. Making this evident +to the compiler avoids historic space leaks. + +In a previous iteration of this code we had a pattern that, somewhat simplified, +looked like this: + +go :: State -> (State -> IO a) -> IO a +go state action = + case tryFillBufferAndCall state action of + Left state' -> go state' action + Right result -> result + +`tryFillBufferAndCall` performed some checks, and then we either called action, +or we modified the state and tried again. +This went wrong because `action` can be a function closure containing a reference to +a lazy data structure. If we call action directly, without retaining any references +to action, that is fine. The data structure is consumed as it is produced and we operate +in constant space. + +However the failure branch `go state' action` *does* capture a reference to action. +This went wrong because the reference to action in the failure branch only becomes +unreachable *after* action returns. This means we keep alive the function closure +for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list +via `action` until the action has fully run. +This went wrong in #20107, where the continuation kept an entire lazy bytestring alive +rather than allowing it to be incrementally consumed and collected. +-} + ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -34,7 +34,6 @@ import System.Posix.Types import Foreign import Foreign.C --- import Data.Bits import Data.Maybe #if !defined(HTYPE_TCFLAG_T) @@ -51,6 +50,9 @@ import GHC.IO.Device #if !defined(mingw32_HOST_OS) import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC +import GHC.Ptr +#else +import Data.OldList (elem) #endif -- --------------------------------------------------------------------------- @@ -164,13 +166,23 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) + #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +190,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen0 enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen0 enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff ===================================== libraries/base/base.cabal ===================================== @@ -351,6 +351,7 @@ Library GHC.Event.IntVar GHC.Event.PSQ GHC.Event.Unique + GHC.Foreign.Internal -- GHC.IOPort -- TODO: hide again after debug GHC.Unicode.Internal.Bits GHC.Unicode.Internal.Char.DerivedCoreProperties ===================================== libraries/base/tests/T13660.hs ===================================== @@ -0,0 +1,11 @@ +-- | This should print an InvalidArgument error complaining that +-- the file path contains a NUL octet. +module Main where + +import System.IO.Error + +main :: IO () +main = do + catchIOError + (writeFile "hello\x00world" "hello") + print ===================================== libraries/base/tests/T13660.stdout ===================================== Binary files /dev/null and b/libraries/base/tests/T13660.stdout differ ===================================== libraries/base/tests/all.T ===================================== @@ -256,6 +256,7 @@ test('T13191', ['-O']) test('T13525', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) +test('T13660', when(opsys('mingw32'), skip), compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) test('T3474', [collect_stats('max_bytes_used',5), ===================================== testsuite/tests/ghc-api/T10052/T10052.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Using optimization flags with the byte-code interpreter is experimental. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci.debugger/scripts/print007.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Using optimization flags with the byte-code interpreter is experimental. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci/should_fail/T10549.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Using optimization flags with the byte-code interpreter is experimental. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci/should_fail/T10549a.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Using optimization flags with the byte-code interpreter is experimental. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/safeHaskell/ghci/p14.stderr ===================================== @@ -1,6 +1,6 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Using optimization flags with the byte-code interpreter is experimental. Pass -fno-unoptimized-core-for-interpreter to enable this feature. :10:25: error: [GHC-39999] • No instance for ‘Num a’ arising from a use of ‘f’ ===================================== testsuite/tests/th/T8333.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Using optimization flags with the byte-code interpreter is experimental. Pass -fno-unoptimized-core-for-interpreter to enable this feature. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14b690edc8c8883e04a7632a6e73b8aace099497...70c6bca275ee171ae8f5828a59cb810614e88c49 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14b690edc8c8883e04a7632a6e73b8aace099497...70c6bca275ee171ae8f5828a59cb810614e88c49 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 10:12:40 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Thu, 18 May 2023 06:12:40 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix getAmode: Only signed 12bit immediates Message-ID: <6465fa18a8fd9_9760aae86bec2232d@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 0484fa82 by Sven Tennie at 2023-05-18T12:10:35+02:00 Fix getAmode: Only signed 12bit immediates The symptom to find this was a too big immediate in a LW instruction in test arr020: Error: illegal operands `lw t0,4016(t0)' - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -1032,28 +1032,21 @@ truncateReg w w' r = -- The 'Amode' type: Memory addressing modes passed up the tree. data Amode = Amode AddrMode InstrBlock +-- | Provide the value of a `CmmExpr` with an `Amode` +-- +-- N.B. this function should be used to provide operands to load and store +-- instructions with signed 12bit wide immediates (S & I types). For other +-- immediate sizes and formats (e.g. B type uses multiples of 2) this function +-- would need to be adjusted. getAmode :: Platform -> Width -- ^ width of loaded value -> CmmExpr -> NatM Amode -- TODO: Specialize stuff we can destructure here. --- OPTIMIZATION WARNING: Addressing modes. --- Addressing options: --- LDUR/STUR: imm9: -256 - 255 -getAmode platform _ (CmmRegOff reg off) | -256 <= off, off <= 255 - = return $ Amode (AddrRegImm reg' off') nilOL - where reg' = getRegisterReg platform reg - off' = ImmInt off --- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4 -getAmode platform W32 (CmmRegOff reg off) - | 0 <= off, off <= 16380, off `mod` 4 == 0 - = return $ Amode (AddrRegImm reg' off') nilOL - where reg' = getRegisterReg platform reg - off' = ImmInt off --- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8 -getAmode platform W64 (CmmRegOff reg off) - | 0 <= off, off <= 32760, off `mod` 8 == 0 +-- LDR/STR: Immediate can be represented with 12bits +getAmode platform w (CmmRegOff reg off) + | w <= W64, fitsIn12bitImm off = return $ Amode (AddrRegImm reg' off') nilOL where reg' = getRegisterReg platform reg off' = ImmInt off @@ -1063,12 +1056,12 @@ getAmode platform W64 (CmmRegOff reg off) -- E.g. a CmmStoreOff really. This can be translated to `str $expr2, [$expr, #n ] -- for `n` in range. getAmode _platform _ (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) - | -256 <= off, off <= 255 + | fitsIn12bitImm off = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrRegImm reg (ImmInteger off)) code getAmode _platform _ (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) - | -256 <= -off, -off <= 255 + | fitsIn12bitImm (-off) = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrRegImm reg (ImmInteger (-off))) code @@ -1077,6 +1070,12 @@ getAmode _platform _ expr = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrReg reg) code +fitsIn12bitImm :: (Num a, Ord a) => a -> Bool +fitsIn12bitImm off = off >= intMin12bit && off <= intMax12bit + where + intMin12bit = -2048 + intMax12bit = 2047 + -- ----------------------------------------------------------------------------- -- Generating assignments View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0484fa822a5bf4ea53ec2bd0f0fa9704c8ab093f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0484fa822a5bf4ea53ec2bd0f0fa9704c8ab093f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 11:04:31 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Thu, 18 May 2023 07:04:31 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] 2 commits: hadrian: Pass CROSS_EMULATOR to runtests.py Message-ID: <6466063f40871_9760abbb096c229955@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 5545140f by Ben Gamari at 2023-05-18T12:56:34+02:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - ce78097c by Ben Gamari at 2023-05-18T12:56:34+02:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - 4 changed files: - hadrian/src/Settings/Builders/RunTest.hs - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -211,6 +211,7 @@ runTestBuilderArgs = builder Testsuite ? do (testEnv, testMetricsFile) <- expr . liftIO $ (,) <$> lookupEnv "TEST_ENV" <*> lookupEnv "METRICS_FILE" perfBaseline <- expr . liftIO $ lookupEnv "PERF_BASELINE_COMMIT" + targetWrapper <- expr . liftIO $ lookupEnv "CROSS_EMULATOR" threads <- shakeThreads <$> expr getShakeOptions top <- expr $ topDirectory @@ -280,6 +281,7 @@ runTestBuilderArgs = builder Testsuite ? do , case perfBaseline of Just commit | not (null commit) -> arg ("--perf-baseline=" ++ commit) _ -> mempty + , emitWhenSet targetWrapper $ \cmd -> arg ("--target-wrapper=" ++ cmd) , emitWhenSet testEnv $ \env -> arg ("--test-env=" ++ env) , emitWhenSet testMetricsFile $ \file -> arg ("--metrics-file=" ++ file) , getTestArgs -- User-provided arguments from command line. ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") parser.add_argument("--way", action="append", help="just this way") @@ -118,6 +119,7 @@ hasMetricsFile = config.metrics_file is not None config.summary_file = args.summary_file config.no_print_summary = args.no_print_summary config.baseline_commit = args.perf_baseline +config.target_wrapper = args.target_wrapper if args.top: config.top = args.top ===================================== testsuite/driver/testglobals.py ===================================== @@ -175,6 +175,11 @@ class TestConfig: # threads self.threads = 1 + # An optional executable used to wrap target code execution + # When set tests which aren't marked with TestConfig.cross_okay + # are skipped. + self.target_wrapper = None + # tests which should be considered to be broken during this testsuite # run. self.broken_tests = set() # type: Set[TestName] @@ -445,6 +450,12 @@ class TestOptions: # Should we copy the files of symlink the files for the test? self.copy_files = False + # Should the test be run in a cross-compiled tree? + # None: infer from test function + # True: run when --target-wrapper is set + # False: do not run in cross-compiled trees + self.cross_okay = None # type: Optional[bool] + # The extra hadrian dependencies we need for this particular test self.hadrian_deps = set(["test:ghc"]) # type: Set[str] ===================================== testsuite/driver/testlib.py ===================================== @@ -90,6 +90,10 @@ def setLocalTestOpts(opts: TestOptions) -> None: global testopts_local testopts_local.x = opts +def isCross() -> bool: + """ Are we testing a cross-compiler? """ + return config.target_wrapper is not None + def isCompilerStatsTest() -> bool: opts = getTestOpts() return bool(opts.is_compiler_stats_test) @@ -255,7 +259,7 @@ def req_dynamic_hs( name, opts ): opts.expect = 'fail' def req_interp( name, opts ): - if not config.have_interp: + if not config.have_interp or isCross(): opts.expect = 'fail' # JS backend doesn't provide an interpreter yet js_skip(name, opts) @@ -1080,14 +1084,21 @@ def test_common_work(name: TestName, opts, all_ways = [WayName('ghci')] else: all_ways = [] + if isCross(): + opts.cross_okay = False elif func in [makefile_test, run_command]: # makefile tests aren't necessarily runtime or compile-time # specific. Assume we can run them in all ways. See #16042 for what # happened previously. all_ways = config.compile_ways + config.run_ways + if isCross(): + opts.cross_okay = False else: all_ways = [WayName('normal')] + if isCross() and opts.cross_okay is False: + opts.skip = True + # A test itself can request extra ways by setting opts.extra_ways all_ways = list(OrderedDict.fromkeys(all_ways + [way for way in opts.extra_ways if way not in all_ways])) @@ -1813,7 +1824,10 @@ def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: str) -> stats_args = '' # Put extra_run_opts last: extra_run_opts('+RTS foo') should work. - cmd = ' '.join([prog, stats_args, my_rts_flags, extra_run_opts]) + args = [prog, stats_args, my_rts_flags, extra_run_opts] + if config.target_wrapper is not None: + args = [config.target_wrapper] + args + cmd = ' '.join(args) if opts.cmd_wrapper is not None: cmd = opts.cmd_wrapper(cmd) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0484fa822a5bf4ea53ec2bd0f0fa9704c8ab093f...ce78097cd4100df76443b8a68ed192f987aa44fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0484fa822a5bf4ea53ec2bd0f0fa9704c8ab093f...ce78097cd4100df76443b8a68ed192f987aa44fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 11:58:50 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 May 2023 07:58:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/zonk-continuations Message-ID: <646612fa81027_9760abbb09942435c3@gitlab.mail> Matthew Pickering pushed new branch wip/zonk-continuations at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/zonk-continuations You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 12:04:39 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 May 2023 08:04:39 -0400 Subject: [Git][ghc/ghc][wip/zonk-continuations] more Message-ID: <64661457e24c8_9760aae86bec243799@gitlab.mail> Matthew Pickering pushed to branch wip/zonk-continuations at Glasgow Haskell Compiler / GHC Commits: b3365512 by Matthew Pickering at 2023-05-18T13:04:32+01:00 more - - - - - 2 changed files: - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Tc/TyCl.hs Changes: ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -2108,9 +2108,9 @@ subst_tyco_mapper = TyCoMapper { tcm_tyvar = \env tv -> return (lookup_tce_tv env tv) , tcm_covar = \env cv -> return (lookup_tce_cv env cv) , tcm_hole = \_ hole -> pprPanic "subst_co_mapper:hole" (ppr hole) - , tcm_tycobinder = \env tcv _vis -> if isTyVar tcv - then return (subst_tv_bndr env tcv) - else return (subst_cv_bndr env tcv) + , tcm_tycobinder = \env tcv _vis k -> if isTyVar tcv + then Identity (subst_tv_bndr env tcv) >>= \(env, v) -> k env v + else Identity (subst_cv_bndr env tcv) >>= \(env, v) -> k env v , tcm_tycon = \tc -> return tc } subst_ty :: CpeTyCoEnv -> Type -> Identity Type ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -878,8 +878,13 @@ swizzleTcTyConBndrs tc_infos swizzle_tv _ tv = return (mkTyVarTy (swizzle_var tv)) swizzle_cv _ cv = return (mkCoVarCo (swizzle_var cv)) - swizzle_bndr _ tcv _ - = return ((), swizzle_var tcv) + swizzle_bndr :: () + -> TyCoVar + -> ForAllTyFlag + -> (() -> TyCoVar -> Identity r) + -> Identity r + swizzle_bndr _ tcv _ k + = k () (swizzle_var tcv) swizzle_var :: Var -> Var swizzle_var v View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3365512af93eb63f0184399783189b1efbf4bd2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3365512af93eb63f0184399783189b1efbf4bd2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 12:05:31 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 May 2023 08:05:31 -0400 Subject: [Git][ghc/ghc][wip/zonk-continuations] fix Message-ID: <6466148bb3c7d_9760abaf44242439a6@gitlab.mail> Matthew Pickering pushed to branch wip/zonk-continuations at Glasgow Haskell Compiler / GHC Commits: be530e21 by Matthew Pickering at 2023-05-18T13:05:24+01:00 fix - - - - - 1 changed file: - compiler/GHC/CoreToStg/Prep.hs Changes: ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -2109,8 +2109,8 @@ subst_tyco_mapper = TyCoMapper , tcm_covar = \env cv -> return (lookup_tce_cv env cv) , tcm_hole = \_ hole -> pprPanic "subst_co_mapper:hole" (ppr hole) , tcm_tycobinder = \env tcv _vis k -> if isTyVar tcv - then Identity (subst_tv_bndr env tcv) >>= \(env, v) -> k env v - else Identity (subst_cv_bndr env tcv) >>= \(env, v) -> k env v + then uncurry k (subst_tv_bndr env tcv) + else uncurry k (subst_cv_bndr env tcv) , tcm_tycon = \tc -> return tc } subst_ty :: CpeTyCoEnv -> Type -> Identity Type View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be530e21d9cf88c00e25252be69c4460c1114b27 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be530e21d9cf88c00e25252be69c4460c1114b27 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 13:08:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 May 2023 09:08:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: base: Add test for #13660 Message-ID: <6466234887674_9760abaf44242535f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 71a62400 by Ben Gamari at 2023-05-18T09:08:07-04:00 base: Add test for #13660 - - - - - 086cc59d by Ben Gamari at 2023-05-18T09:08:07-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - ef809217 by Ben Gamari at 2023-05-18T09:08:07-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - 0368b069 by Ben Gamari at 2023-05-18T09:08:07-04:00 base: Clean up documentation - - - - - 78968ec9 by Ben Gamari at 2023-05-18T09:08:07-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - be74f934 by Simon Peyton Jones at 2023-05-18T09:08:07-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - 13 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - + libraries/base/tests/T13660.hs - + libraries/base/tests/T13660.stdout - libraries/base/tests/all.T - testsuite/tests/indexed-types/should_compile/T7837.stderr - + testsuite/tests/stranal/should_compile/T23398.hs - + testsuite/tests/stranal/should_compile/T23398.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -16,37 +16,41 @@ where import GHC.Prelude -import GHC.Core.Opt.WorkWrap.Utils import GHC.Types.Demand -- All of it + import GHC.Core -import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Utils.Outputable -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic -import Data.List ( mapAccumL ) import GHC.Core.DataCon -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Predicate( isClassPred ) +import GHC.Core.Predicate( isEqualityClass, isCTupleClass ) import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain +import GHC.Core.Opt.WorkWrap.Utils + import GHC.Builtin.PrimOps import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) + import GHC.Types.Unique.Set import GHC.Types.Unique.MemoFun import GHC.Types.RepType +import GHC.Types.ForeignCall ( isSafeForeignCall ) +import GHC.Types.Id +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Outputable + +import Data.List ( mapAccumL ) {- ************************************************************************ @@ -1499,7 +1503,7 @@ bounds-checking. So we want to give `indexError` a signature like `<1!P(!S,!S)><1!S>b` where the !S (meaning Poly Unboxed C1N) says that the polymorphic arguments -are unboxed (recursively). The wrapper for `indexError` won't /acutally/ +are unboxed (recursively). The wrapper for `indexError` won't /actually/ unbox them (because their polymorphic type doesn't allow that) but when demand-analysing /callers/, we'll behave as if that call needs the args unboxed. @@ -1782,39 +1786,6 @@ applying the strictness demands to the final result of DmdAnal. The result is that we get the strict demand signature we wanted even if we can't float the case on `x` up through the case on `burble`. -Note [Do not unbox class dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never unbox class dictionaries in worker/wrapper. - -1. INLINABLE functions - If we have - f :: Ord a => [a] -> Int -> a - {-# INLINABLE f #-} - and we worker/wrapper f, we'll get a worker with an INLINABLE pragma - (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), - which can still be specialised by the type-class specialiser, something like - fw :: Ord a => [a] -> Int# -> a - - BUT if f is strict in the Ord dictionary, we might unpack it, to get - fw :: (a->a->Bool) -> [a] -> Int# -> a - and the type-class specialiser can't specialise that. An example is #6056. - - Historical note: #14955 describes how I got this fix wrong the first time. - I got aware of the issue in T5075 by the change in boxity of loop between - demand analysis runs. - -2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur - occur without INLINABLE, when we use -fexpose-all-unfoldings and - -fspecialise-aggressively to do vigorous cross-module specialisation. - -3. #18421 found that unboxing a dictionary can also make the worker less likely - to inline; the inlining heuristics seem to prefer to inline a function - applied to a dictionary over a function applied to a bunch of functions. - -TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing -a raft of higher-order functions isn't a huge win anyway -- you really want to -specialise the function. - Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of @@ -1998,22 +1969,13 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take threshold_arity $ - [ (bndr_ty, NotMarkedStrict, get_dmd bndr bndr_ty) - | bndr <- bndrs - , isRuntimeVar bndr, let bndr_ty = idType bndr ] - - get_dmd :: Id -> Type -> Demand - get_dmd bndr bndr_ty - | isClassPred bndr_ty = trimBoxity dmd - -- See Note [Do not unbox class dictionaries] - -- NB: 'ty' has not been normalised, so this will (rightly) - -- catch newtype dictionaries too. - -- NB: even for bottoming functions, don't unbox dictionaries - - | is_bot_fn = unboxDeeplyDmd dmd - -- See Note [Boxity for bottoming functions], case (B) - - | otherwise = dmd + [ (idType bndr, NotMarkedStrict, get_dmd bndr) + | bndr <- bndrs, isRuntimeVar bndr ] + + get_dmd :: Id -> Demand + get_dmd bndr + | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], + | otherwise = dmd -- case (B) where dmd = idDemandInfo bndr @@ -2119,6 +2081,12 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) -- isMarkedStrict: see Note [Unboxing evaluated arguments] in DmdAnal -> DontUnbox + | doNotUnbox ty + -> DontUnbox -- See Note [Do not unbox class dictionaries] + -- NB: 'ty' has not been normalised, so this will (rightly) + -- catch newtype dictionaries too. + -- NB: even for bottoming functions, don't unbox dictionaries + | DefinitelyRecursive <- ae_rec_dc env dc -- See Note [Which types are unboxed?] -- and Note [Demand analysis for recursive data constructors] @@ -2129,6 +2097,76 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) (dataConRepStrictness dc) dmds) + +doNotUnbox :: Type -> Bool +-- Do not unbox class dictionaries, except equality classes and tuples +-- Note [Do not unbox class dictionaries] +doNotUnbox arg_ty + = case tyConAppTyCon_maybe arg_ty of + Just tc | Just cls <- tyConClass_maybe tc + -> not (isEqualityClass cls || isCTupleClass cls) + -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] + + _ -> False + +{- Note [Do not unbox class dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never unbox class dictionaries in worker/wrapper. + +1. INLINABLE functions + If we have + f :: Ord a => [a] -> Int -> a + {-# INLINABLE f #-} + and we worker/wrapper f, we'll get a worker with an INLINABLE pragma + (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), + which can still be specialised by the type-class specialiser, something like + fw :: Ord a => [a] -> Int# -> a + + BUT if f is strict in the Ord dictionary, we might unpack it, to get + fw :: (a->a->Bool) -> [a] -> Int# -> a + and the type-class specialiser can't specialise that. An example is #6056. + + Historical note: #14955 describes how I got this fix wrong the first time. + I got aware of the issue in T5075 by the change in boxity of loop between + demand analysis runs. + +2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur + occur without INLINABLE, when we use -fexpose-all-unfoldings and + -fspecialise-aggressively to do vigorous cross-module specialisation. + +3. #18421 found that unboxing a dictionary can also make the worker less likely + to inline; the inlining heuristics seem to prefer to inline a function + applied to a dictionary over a function applied to a bunch of functions. + +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing +a raft of higher-order functions isn't a huge win anyway -- you really want to +specialise the function. + +Wrinkle (DNB1): we /do/ want to unbox tuple dictionaries (#23398) + f :: (% Eq a, Show a %) => blah + with -fdicts-strict it is great to unbox to + $wf :: Eq a => Show a => blah + (where I have written out the currying explicitly). Now we can specialise + $wf on the Eq or Show dictionary. Nothing is lost. + + And something is gained. It is possible that `f` will look like this: + f = /\a. \d:(% Eq a, Show a %). ... f @a (% sel1 d, sel2 d %)... + where there is a recurive call to `f`, or to another function that takes the + same tuple dictionary, but where the tuple is built from the components of + `d`. The Simplier does not fix this. But if we unpacked the dictionary + we'd get + $wf = /\a. \(d1:Eq a) (d2:Show a). let d = (% d1, d2 %) + in ...f @a (% sel1 d, sel2 d %) + and all the tuple building and taking apart will disappear. + +Wrinkle (DNB2): we /do/ wnat to unbox equality dictionaries, + for (~), (~~), and Coercible (#23398). Their payload is a single unboxed + coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is + to make a copy of the function's RHS with a particular coercion. Unlike + normal class methods, that does not unlock any new optimisation + opportunities in the specialised RHS. +-} + {- ********************************************************************* * * Fixpoints ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqPredClass, isCTupleClass, isEqualityClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -219,11 +219,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -245,6 +240,20 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) +isEqPredClass :: Class -> Bool +-- True of (~) and (~~) +isEqPredClass cls = cls `hasKey` eqTyConKey + || cls `hasKey` heqTyConKey + +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + + {- ********************************************************************* * * Implicit parameters ===================================== libraries/base/GHC/Foreign.hs ===================================== @@ -21,312 +21,22 @@ module GHC.Foreign ( -- * C strings with a configurable encoding CString, CStringLen, - -- conversion of C strings into Haskell strings - -- + -- * Conversion of C strings into Haskell strings peekCString, peekCStringLen, - -- conversion of Haskell strings into C strings - -- + -- * Conversion of Haskell strings into C strings newCString, newCStringLen, + newCStringLen0, - -- conversion of Haskell strings into C strings using temporary storage - -- + -- * Conversion of Haskell strings into C strings using temporary storage withCString, withCStringLen, + withCStringLen0, withCStringsLen, charIsRepresentable, ) where -import Foreign.Marshal.Array -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Storable - -import Data.Word - --- Imports for the locale-encoding version of marshallers - -import Data.Tuple (fst) - -import GHC.Show ( show ) - -import Foreign.Marshal.Alloc -import Foreign.ForeignPtr - -import GHC.Debug -import GHC.List -import GHC.Num -import GHC.Base - -import GHC.IO -import GHC.IO.Exception -import GHC.IO.Buffer -import GHC.IO.Encoding.Types - - -c_DEBUG_DUMP :: Bool -c_DEBUG_DUMP = False - -putDebugMsg :: String -> IO () -putDebugMsg | c_DEBUG_DUMP = debugLn - | otherwise = const (return ()) - - --- | A C string is a reference to an array of C characters terminated by NUL. -type CString = Ptr CChar - --- | A string with explicit length information in bytes instead of a --- terminating NUL (allowing NUL characters in the middle of the string). -type CStringLen = (Ptr CChar, Int) - --- exported functions --- ------------------ - --- | Marshal a NUL terminated C string into a Haskell string. --- -peekCString :: TextEncoding -> CString -> IO String -peekCString enc cp = do - sz <- lengthArray0 nUL cp - peekEncodedCString enc (cp, sz * cCharSize) - --- | Marshal a C string with explicit length into a Haskell string. --- -peekCStringLen :: TextEncoding -> CStringLen -> IO String -peekCStringLen = peekEncodedCString - --- | Marshal a Haskell string into a NUL terminated C string. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCString :: TextEncoding -> String -> IO CString -newCString enc = liftM fst . newEncodedCString enc True - --- | Marshal a Haskell string into a C string (ie, character array) with --- explicit length information. --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCStringLen :: TextEncoding -> String -> IO CStringLen -newCStringLen enc = newEncodedCString enc False - --- | Marshal a Haskell string into a NUL terminated C string using temporary --- storage. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a -withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp - --- | Marshal a Haskell string into a C string (ie, character array) --- in temporary storage, with explicit length information. --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a -withCStringLen enc = withEncodedCString enc False - --- | Marshal a list of Haskell strings into an array of NUL terminated C strings --- using temporary storage. --- --- * the Haskell strings may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringsLen :: TextEncoding - -> [String] - -> (Int -> Ptr CString -> IO a) - -> IO a -withCStringsLen enc strs f = go [] strs - where - go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss - go cs [] = withArrayLen (reverse cs) f - --- | Determines whether a character can be accurately encoded in a --- 'Foreign.C.String.CString'. --- --- Pretty much anyone who uses this function is in a state of sin because --- whether or not a character is encodable will, in general, depend on the --- context in which it occurs. -charIsRepresentable :: TextEncoding -> Char -> IO Bool --- We force enc explicitly because `catch` is lazy in its --- first argument. We would probably like to force c as well, --- but unfortunately worker/wrapper produces very bad code for --- that. --- --- TODO If this function is performance-critical, it would probably --- pay to use a single-character specialization of withCString. That --- would allow worker/wrapper to actually eliminate Char boxes, and --- would also get rid of the completely unnecessary cons allocation. -charIsRepresentable !enc c = - withCString enc [c] - (\cstr -> do str <- peekCString enc cstr - case str of - [ch] | ch == c -> pure True - _ -> pure False) - `catch` - \(_ :: IOException) -> pure False - --- auxiliary definitions --- ---------------------- - --- C's end of string character -nUL :: CChar -nUL = 0 - --- Size of a CChar in bytes -cCharSize :: Int -cCharSize = sizeOf (undefined :: CChar) - - -{-# INLINE peekEncodedCString #-} -peekEncodedCString :: TextEncoding -- ^ Encoding of CString - -> CStringLen - -> IO String -- ^ String in Haskell terms -peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) - = bracket mk_decoder close $ \decoder -> do - let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII - !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) - !to <- newCharBuffer chunk_size WriteBuffer - - let go !iteration !from = do - (why, from', !to') <- encode decoder from to - if isEmptyBuffer from' - then - -- No input remaining: @why@ will be InputUnderflow, but we don't care - withBuffer to' $ peekArray (bufferElems to') - else do - -- Input remaining: what went wrong? - putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) - (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because - InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input - OutputUnderflow -> return (from', to') -- We will have more space next time round - putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') - putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') - to_chars <- withBuffer to'' $ peekArray (bufferElems to'') - fmap (to_chars++) $ go (iteration + 1) from'' - - go (0 :: Int) from0 - -{-# INLINE withEncodedCString #-} -withEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory - -> IO a -withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_sz_bytes = do - putDebugMsg ("withEncodedCString: " ++ show iteration) - allocaBytes to_sz_bytes $ \to_p -> do - -- See Note [Check *before* fill in withEncodedCString] about why - -- this is subtle. - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> go (iteration + 1) (to_sz_bytes * 2) - Just to_buf -> withCStringBuffer to_buf null_terminate act - - -- If the input string is ASCII, this value will ensure we only allocate once - go (0 :: Int) (cCharSize * (sz + 1)) - -withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r -withCStringBuffer to_buf null_terminate act = do - let bytes = bufferElems to_buf - withBuffer to_buf $ \to_ptr -> do - when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 - act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* - -{-# INLINE newEncodedCString #-} -newEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> IO CStringLen -newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_p to_sz_bytes = do - putDebugMsg ("newEncodedCString: " ++ show iteration) - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> do - let to_sz_bytes' = to_sz_bytes * 2 - to_p' <- reallocBytes to_p to_sz_bytes' - go (iteration + 1) to_p' to_sz_bytes' - Just to_buf -> withCStringBuffer to_buf null_terminate return - - -- If the input string is ASCII, this value will ensure we only allocate once - let to_sz_bytes = cCharSize * (sz + 1) - to_p <- mallocBytes to_sz_bytes - go (0 :: Int) to_p to_sz_bytes - - -tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int - -> IO (Maybe (Buffer Word8)) -tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do - !to_fp <- newForeignPtr_ to_p - go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) - where - go !iteration !from !to = do - (why, from', to') <- encode encoder from to - putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') - if isEmptyBuffer from' - then if null_terminate && bufferAvailable to' == 0 - then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer - else return (Just to') - else case why of -- We didn't consume all of the input - InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad - InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid - OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more -{- -Note [Check *before* fill in withEncodedCString] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's very important that the size check and readjustment peformed by tryFillBuffer -happens before the continuation is called. The size check is the part which can -fail, the call to the continuation never fails and so the caller should respond -first to the size check failing and *then* call the continuation. Making this evident -to the compiler avoids historic space leaks. - -In a previous iteration of this code we had a pattern that, somewhat simplified, -looked like this: - -go :: State -> (State -> IO a) -> IO a -go state action = - case tryFillBufferAndCall state action of - Left state' -> go state' action - Right result -> result - -`tryFillBufferAndCall` performed some checks, and then we either called action, -or we modified the state and tried again. -This went wrong because `action` can be a function closure containing a reference to -a lazy data structure. If we call action directly, without retaining any references -to action, that is fine. The data structure is consumed as it is produced and we operate -in constant space. - -However the failure branch `go state' action` *does* capture a reference to action. -This went wrong because the reference to action in the failure branch only becomes -unreachable *after* action returns. This means we keep alive the function closure -for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list -via `action` until the action has fully run. -This went wrong in #20107, where the continuation kept an entire lazy bytestring alive -rather than allowing it to be incrementally consumed and collected. --} - +import GHC.Foreign.Internal ===================================== libraries/base/GHC/Foreign/Internal.hs ===================================== @@ -0,0 +1,357 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Foreign.Internal +-- Copyright : (c) The University of Glasgow, 2008-2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : libraries at haskell.org +-- Stability : internal +-- Portability : non-portable +-- +-- Foreign marshalling support for CStrings with configurable encodings +-- +----------------------------------------------------------------------------- + +module GHC.Foreign.Internal ( + -- * C strings with a configurable encoding + CString, CStringLen, + + -- * Conversion of C strings into Haskell strings + peekCString, + peekCStringLen, + + -- * Conversion of Haskell strings into C strings + newCString, + newCStringLen, + newCStringLen0, + + -- * Conversion of Haskell strings into C strings using temporary storage + withCString, + withCStringLen, + withCStringLen0, + withCStringsLen, + + charIsRepresentable, + ) where + +import Foreign.Marshal.Array +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable + +import Data.Word + +-- Imports for the locale-encoding version of marshallers + +import Data.Tuple (fst) + +import GHC.Show ( show ) + +import Foreign.Marshal.Alloc +import Foreign.ForeignPtr + +import GHC.Debug +import GHC.List +import GHC.Num +import GHC.Base + +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Buffer +import GHC.IO.Encoding.Types + + +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False + +putDebugMsg :: String -> IO () +putDebugMsg | c_DEBUG_DUMP = debugLn + | otherwise = const (return ()) + + +-- | A C string is a reference to an array of C characters terminated by NUL. +type CString = Ptr CChar + +-- | A string with explicit length information in bytes instead of a +-- terminating NUL (allowing NUL characters in the middle of the string). +type CStringLen = (Ptr CChar, Int) + +-- exported functions +-- ------------------ + +-- | Marshal a NUL terminated C string into a Haskell string. +-- +peekCString :: TextEncoding -> CString -> IO String +peekCString enc cp = do + sz <- lengthArray0 nUL cp + peekEncodedCString enc (cp, sz * cCharSize) + +-- | Marshal a C string with explicit length into a Haskell string. +-- +peekCStringLen :: TextEncoding -> CStringLen -> IO String +peekCStringLen = peekEncodedCString + +-- | Marshal a Haskell string into a NUL terminated C string. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCString :: TextEncoding -> String -> IO CString +newCString enc = liftM fst . newEncodedCString enc True + +-- | Marshal a Haskell string into a C string (ie, character array) with +-- explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCStringLen :: TextEncoding -> String -> IO CStringLen +newCStringLen enc = newEncodedCString enc False + +-- | Marshal a Haskell string into a NUL terminated C string using temporary +-- storage. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a +withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp + +-- | Marshal a Haskell string into a C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen enc = withEncodedCString enc False + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- with explicit length information. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +-- @since 4.19.0.0 +newCStringLen0 :: TextEncoding -> String -> IO CStringLen +newCStringLen0 enc = newEncodedCString enc True + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +-- @since 4.19.0.0 +withCStringLen0 :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen0 enc = withEncodedCString enc True + +-- | Marshal a list of Haskell strings into an array of NUL terminated C strings +-- using temporary storage. +-- +-- * the Haskell strings may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringsLen :: TextEncoding + -> [String] + -> (Int -> Ptr CString -> IO a) + -> IO a +withCStringsLen enc strs f = go [] strs + where + go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss + go cs [] = withArrayLen (reverse cs) f + +-- | Determines whether a character can be accurately encoded in a +-- 'Foreign.C.String.CString'. +-- +-- Pretty much anyone who uses this function is in a state of sin because +-- whether or not a character is encodable will, in general, depend on the +-- context in which it occurs. +charIsRepresentable :: TextEncoding -> Char -> IO Bool +-- We force enc explicitly because `catch` is lazy in its +-- first argument. We would probably like to force c as well, +-- but unfortunately worker/wrapper produces very bad code for +-- that. +-- +-- TODO If this function is performance-critical, it would probably +-- pay to use a single-character specialization of withCString. That +-- would allow worker/wrapper to actually eliminate Char boxes, and +-- would also get rid of the completely unnecessary cons allocation. +charIsRepresentable !enc c = + withCString enc [c] + (\cstr -> do str <- peekCString enc cstr + case str of + [ch] | ch == c -> pure True + _ -> pure False) + `catch` + \(_ :: IOException) -> pure False + +-- auxiliary definitions +-- ---------------------- + +-- C's end of string character +nUL :: CChar +nUL = 0 + +-- Size of a CChar in bytes +cCharSize :: Int +cCharSize = sizeOf (undefined :: CChar) + + +{-# INLINE peekEncodedCString #-} +peekEncodedCString :: TextEncoding -- ^ Encoding of CString + -> CStringLen + -> IO String -- ^ String in Haskell terms +peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) + = bracket mk_decoder close $ \decoder -> do + let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII + !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) + !to <- newCharBuffer chunk_size WriteBuffer + + let go !iteration !from = do + (why, from', !to') <- encode decoder from to + if isEmptyBuffer from' + then + -- No input remaining: @why@ will be InputUnderflow, but we don't care + withBuffer to' $ peekArray (bufferElems to') + else do + -- Input remaining: what went wrong? + putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) + (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because + InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input + OutputUnderflow -> return (from', to') -- We will have more space next time round + putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') + putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') + to_chars <- withBuffer to'' $ peekArray (bufferElems to'') + fmap (to_chars++) $ go (iteration + 1) from'' + + go (0 :: Int) from0 + +{-# INLINE withEncodedCString #-} +withEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory + -> IO a +withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_sz_bytes = do + putDebugMsg ("withEncodedCString: " ++ show iteration) + allocaBytes to_sz_bytes $ \to_p -> do + -- See Note [Check *before* fill in withEncodedCString] about why + -- this is subtle. + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> go (iteration + 1) (to_sz_bytes * 2) + Just to_buf -> withCStringBuffer to_buf null_terminate act + + -- If the input string is ASCII, this value will ensure we only allocate once + go (0 :: Int) (cCharSize * (sz + 1)) + +withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r +withCStringBuffer to_buf null_terminate act = do + let bytes = bufferElems to_buf + withBuffer to_buf $ \to_ptr -> do + when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 + act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* + +{-# INLINE newEncodedCString #-} +newEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> IO CStringLen +newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_p to_sz_bytes = do + putDebugMsg ("newEncodedCString: " ++ show iteration) + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> do + let to_sz_bytes' = to_sz_bytes * 2 + to_p' <- reallocBytes to_p to_sz_bytes' + go (iteration + 1) to_p' to_sz_bytes' + Just to_buf -> withCStringBuffer to_buf null_terminate return + + -- If the input string is ASCII, this value will ensure we only allocate once + let to_sz_bytes = cCharSize * (sz + 1) + to_p <- mallocBytes to_sz_bytes + go (0 :: Int) to_p to_sz_bytes + + +tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int + -> IO (Maybe (Buffer Word8)) +tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do + !to_fp <- newForeignPtr_ to_p + go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) + where + go !iteration !from !to = do + (why, from', to') <- encode encoder from to + putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') + if isEmptyBuffer from' + then if null_terminate && bufferAvailable to' == 0 + then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer + else return (Just to') + else case why of -- We didn't consume all of the input + InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad + InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid + OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more +{- +Note [Check *before* fill in withEncodedCString] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's very important that the size check and readjustment peformed by tryFillBuffer +happens before the continuation is called. The size check is the part which can +fail, the call to the continuation never fails and so the caller should respond +first to the size check failing and *then* call the continuation. Making this evident +to the compiler avoids historic space leaks. + +In a previous iteration of this code we had a pattern that, somewhat simplified, +looked like this: + +go :: State -> (State -> IO a) -> IO a +go state action = + case tryFillBufferAndCall state action of + Left state' -> go state' action + Right result -> result + +`tryFillBufferAndCall` performed some checks, and then we either called action, +or we modified the state and tried again. +This went wrong because `action` can be a function closure containing a reference to +a lazy data structure. If we call action directly, without retaining any references +to action, that is fine. The data structure is consumed as it is produced and we operate +in constant space. + +However the failure branch `go state' action` *does* capture a reference to action. +This went wrong because the reference to action in the failure branch only becomes +unreachable *after* action returns. This means we keep alive the function closure +for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list +via `action` until the action has fully run. +This went wrong in #20107, where the continuation kept an entire lazy bytestring alive +rather than allowing it to be incrementally consumed and collected. +-} + ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -34,7 +34,6 @@ import System.Posix.Types import Foreign import Foreign.C --- import Data.Bits import Data.Maybe #if !defined(HTYPE_TCFLAG_T) @@ -51,6 +50,9 @@ import GHC.IO.Device #if !defined(mingw32_HOST_OS) import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC +import GHC.Ptr +#else +import Data.OldList (elem) #endif -- --------------------------------------------------------------------------- @@ -164,13 +166,23 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) + #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +190,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen0 enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen0 enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff ===================================== libraries/base/base.cabal ===================================== @@ -351,6 +351,7 @@ Library GHC.Event.IntVar GHC.Event.PSQ GHC.Event.Unique + GHC.Foreign.Internal -- GHC.IOPort -- TODO: hide again after debug GHC.Unicode.Internal.Bits GHC.Unicode.Internal.Char.DerivedCoreProperties ===================================== libraries/base/tests/T13660.hs ===================================== @@ -0,0 +1,11 @@ +-- | This should print an InvalidArgument error complaining that +-- the file path contains a NUL octet. +module Main where + +import System.IO.Error + +main :: IO () +main = do + catchIOError + (writeFile "hello\x00world" "hello") + print ===================================== libraries/base/tests/T13660.stdout ===================================== Binary files /dev/null and b/libraries/base/tests/T13660.stdout differ ===================================== libraries/base/tests/all.T ===================================== @@ -256,6 +256,7 @@ test('T13191', ['-O']) test('T13525', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) +test('T13660', when(opsys('mingw32'), skip), compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) test('T3474', [collect_stats('max_bytes_used',5), ===================================== testsuite/tests/indexed-types/should_compile/T7837.stderr ===================================== @@ -1,3 +1,4 @@ Rule fired: Class op signum (BUILTIN) Rule fired: Class op abs (BUILTIN) Rule fired: normalize/Double (T7837) +Rule fired: Class op eq_sel (BUILTIN) ===================================== testsuite/tests/stranal/should_compile/T23398.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fdicts-strict #-} +module T23398 where + +type PairDict a = (Eq a, Show a) + +foo :: PairDict a => a -> a -> String +foo x y | x==y = show x + | otherwise = show y + +-- In worker/wrapper we'd like to unbox the pair +-- but not (Eq a) and (Show a) + +bar :: (a ~ b, Show a) => Int -> a -> (b, String) +bar 0 x = (x, show x) +bar n x = bar (n-1) x ===================================== testsuite/tests/stranal/should_compile/T23398.stderr ===================================== @@ -0,0 +1,109 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 76, types: 117, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} +T23398.$wfoo [InlPrag=[2]] + :: forall {a}. (Eq a, Show a) => a -> a -> String +[GblId[StrictWorker([!, !])], + Arity=4, + Str=, + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [30 60 0 0] 120 0}] +T23398.$wfoo + = \ (@a) (ww :: Eq a) (ww1 :: Show a) (eta :: a) (eta1 :: a) -> + case == @a ww eta eta1 of { + False -> show @a ww1 eta1; + True -> show @a ww1 eta + } + +-- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/0} +foo [InlPrag=[2]] :: forall a. PairDict a => a -> a -> String +[GblId, + Arity=3, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + ($d(%,%) [Occ=Once1!] :: PairDict a) + (eta [Occ=Once1] :: a) + (eta1 [Occ=Once1] :: a) -> + case $d(%,%) of { (ww [Occ=Once1], ww1 [Occ=Once1]) -> + T23398.$wfoo @a ww ww1 eta eta1 + }}] +foo + = \ (@a) ($d(%,%) :: PairDict a) (eta :: a) (eta1 :: a) -> + case $d(%,%) of { (ww, ww1) -> T23398.$wfoo @a ww ww1 eta eta1 } + +Rec { +-- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} +T23398.$wbar [InlPrag=[2], Occ=LoopBreaker] + :: forall {a} {b}. + (a GHC.Prim.~# b, Show a) => + GHC.Prim.Int# -> a -> (# b, String #) +[GblId[StrictWorker([~, !])], + Arity=4, + Str=<1L>, + Unf=OtherCon []] +T23398.$wbar + = \ (@a) + (@b) + (ww :: a GHC.Prim.~# b) + ($dShow :: Show a) + (ww1 :: GHC.Prim.Int#) + (eta :: a) -> + case ww1 of ds { + __DEFAULT -> + T23398.$wbar + @a @b @~(ww :: a GHC.Prim.~# b) $dShow (GHC.Prim.-# ds 1#) eta; + 0# -> (# eta `cast` (Sub ww :: a ~R# b), show @a $dShow eta #) + } +end Rec } + +-- RHS size: {terms: 21, types: 32, coercions: 1, joins: 0/0} +bar [InlPrag=[2]] + :: forall a b. (a ~ b, Show a) => Int -> a -> (b, String) +[GblId, + Arity=4, + Str=<1!P(1L)>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (@b) + ($d~ [Occ=Once1!] :: a ~ b) + ($dShow [Occ=Once1] :: Show a) + (eta [Occ=Once1!] :: Int) + (eta1 [Occ=Once1] :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 [Occ=Once1] -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2 [Occ=Once1], ww3 [Occ=Once1] #) -> + (ww2, ww3) + } + } + }}] +bar + = \ (@a) + (@b) + ($d~ :: a ~ b) + ($dShow :: Show a) + (eta :: Int) + (eta1 :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2, ww3 #) -> + (ww2, ww3) + } + } + } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -93,3 +93,4 @@ test('T22039', normal, compile, ['']) test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) # T22997: Just a panic that should not happen test('T22997', normal, compile, ['']) +test('T23398', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70c6bca275ee171ae8f5828a59cb810614e88c49...be74f9346ef73eb4d5156ecb58f0e9e59f369b18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70c6bca275ee171ae8f5828a59cb810614e88c49...be74f9346ef73eb4d5156ecb58f0e9e59f369b18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 15:12:19 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 May 2023 11:12:19 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 21 commits: JS: Implement h$clock_gettime in the JavaScript RTS (#23360) Message-ID: <6466405388883_9760abbb096c2888c2@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 16777d40 by sheaf at 2023-05-18T16:11:11+01:00 Zonking monad transformers - Introduce two zonking monad transformers, ZonkT and ZonkBndrT. ZonkT is a reader monad transformer over ZonkEnv. ZonkBndrT m is the codensity monad over ZonkT m. ZonkBndrT is used for computations that accumulate binders in the ZonkEnv. - Split up the zonking functions relating purely to types into GHC.Tc.Zonk.Type. This should allow us to introduce a slimmed-down zonking monad, which doesn't wrap the full TcM but a much smaller monad. This opens up the possibility of refactoring ErrCtxt to use this smaller zonking monad. - Refactor the remaining zonking functions to work over the monads ZonkTcM = ZonkT TcM and ZonkBndrTcM = ZonkBndrT TcM. - - - - - b6320856 by sheaf at 2023-05-18T16:11:12+01:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 50dcd778 by Matthew Pickering at 2023-05-18T16:11:49+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.TcRef - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.TcIdSigInfo - GHC.Tc.Types.TcBinder - GHC.Tc.Types.TcTyThing - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - d0d94bcd by Matthew Pickering at 2023-05-18T16:11:50+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 064d68e1 by Matthew Pickering at 2023-05-18T16:11:50+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 5f81551d by Matthew Pickering at 2023-05-18T16:11:50+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - ae48ad4c by Matthew Pickering at 2023-05-18T16:11:50+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - c9c61506 by Matthew Pickering at 2023-05-18T16:11:50+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 0e09a616 by Matthew Pickering at 2023-05-18T16:11:50+01:00 Remove unecessary SOURCE import - - - - - 410d6822 by Matthew Pickering at 2023-05-18T16:11:50+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21e645c433f940eacb5cd3a52ab7390d9ebef059...410d682208e32f506ebec66811d8f19286f6d641 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21e645c433f940eacb5cd3a52ab7390d9ebef059...410d682208e32f506ebec66811d8f19286f6d641 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 15:21:34 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 18 May 2023 11:21:34 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] More wibbles Message-ID: <6466427ede1bf_9760aae86bec289231@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: b03cc67f by Simon Peyton Jones at 2023-05-18T16:23:21+01:00 More wibbles - - - - - 6 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -1874,7 +1874,7 @@ The no-crap way is \(y::Int). let j' :: Int -> Bool j' x = e y in b[j'/j] y -where I have written to stress that j's type has +where I have written b[j'/j] to stress that j's type has changed. Note that (of course!) we have to push the application inside the RHS of the join as well as into the body. AND if j has an unfolding we have to push it into there too. AND j might ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -343,7 +343,7 @@ initIPRecTc = setRecTcMaxBound 1 initRecTc {- Note [Local implicit parameters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also Note [Shadowing of Implicit Parameters] in GHC.Tc.Solver.Dict. +See also Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. The function isIPLikePred tells if this predicate, or any of its superclasses, is an implicit parameter. ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -109,7 +109,7 @@ updInertDicts :: DictCt -> TcS () updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev, di_tys = tys }) = do { traceTcS "Adding inert dict" (ppr dict_ct $$ ppr cls <+> ppr tys) - -- See Note [Shadowing of Implicit Parameters] + -- See Note [Shadowing of implicit parameters] ; when (isGiven ev && isIPClass cls) $ updInertCans (updDicts (delIPDict dict_ct)) @@ -187,7 +187,7 @@ solveCallStack ev ev_cs ; setEvBindIfWanted ev IsCoherent ev_tm } -{- Note [Shadowing of Implicit Parameters] +{- Note [Shadowing of implicit parameters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we add a new /given/ implicit parameter to the inert set, it /replaces/ any existing givens for the same implicit parameter. This makes a difference ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -2133,7 +2133,8 @@ solveOneFromTheOther ct_i ct_w | isIPLikePred pred = if lvl_w > lvl_i then KeepWork else KeepInert | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork -- See Note [Replacement vs keeping] part (1) - -- For the isIPLikePred case see Note [Shadowing of Implicit Parameters] + -- For the isIPLikePred case see Note [Shadowing of implicit parameters] + -- in GHC.Tc.Solver.Dict same_level_strategy -- Both Given = case (orig_i, orig_w) of @@ -2162,7 +2163,7 @@ solveOneFromTheOther. - For implicit parameters we want to keep the innermost (deepest) one, so that it overrides the outer one. - See Note [Shadowing of Implicit Parameters] + See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict - For everything else, we want to keep the outermost one. Reason: that makes it more likely that the inner one will turn out to be unused, ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -64,11 +64,12 @@ try_inert_irreds :: InertCans -> IrredCt -> TcS (StopOrContinue ()) try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) | let (matching_irreds, others) = findMatchingIrreds (inert_irreds inerts) ev_w - , ((irred_i, swap) : _rest) <- bagToList matching_irreds + , ((irred_i, swap) : _rest) <- pprTrace "try_inert_irreds" (ppr ev_w $$ ppr matching_irreds) $ + bagToList matching_irreds -- See Note [Multiple matching irreds] , let ev_i = irredCtEvidence irred_i ct_i = CIrredCan irred_i - , not (isInsolubleReason reason && (isWanted ev_i || isWanted ev_w)) + , not (isInsolubleReason reason) || isGiven ev_i || isGiven ev_w -- See Note [Insoluble irreds] = do { traceTcS "iteractIrred" $ vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) @@ -113,6 +114,7 @@ so that we get distinct error messages with -fdefer-type-errors However we do allow an insoluble constraint to be solved from an insoluble Given. This might seem a little odd, but it's very much a corner case, and it helps in tests bkpfail24.run, T15450, GivenForallLoop, T20189, T8392a. +See #23413. -} {- ********************************************************************* ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -207,13 +207,51 @@ import GHC.Data.Graph.Directed * * ********************************************************************* -} +{- Note [The SolverStage monad] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The SolverStage monad allows us to write simple code like this: + + solveEquality :: ... -> SolverStage Void + solveEquality ev eq_rel ty1 ty2 + = do { Pair ty1' ty2' <- zonkEqTypes ev eq_rel ty1 ty2 + ; mb_canon <- canonicaliseEquality ev' eq_rel ty1' ty2' + ; case mb_canon of { + Left irred_ct -> do { tryQCsIrredEqCt irred_ct + ; solveIrred irred_ct } ; + Right eq_ct -> do { tryInertEqs eq_ct + ; tryFunDeps eq_ct + ; tryQCsEqCt eq_ct + ; simpleStage (updInertEqs eq_ct) + ; stopWithStage (eqCtEvidence eq_ct) "Kept inert EqCt" } } } + +in which each sub-stage can elect to + (a) ContinueWith: continue to the next stasge + (b) StartAgain: start again at the beginning of the pipeline + (c) Stop: stop altogether; constraint is solved + +These three possiblities are described by the `StopOrContinue` data type. +The `SolverStage` monad does the plumbing. + +Notes: + +(SM1) Each individual stage pretty quickly drops down into + TcS (StopOrContinue a) + because the monadic plumbing of `SolverStage` is relatively ineffienct, + with that three-way split. + +(SM2) We use `SolverStage Void` to express the idea that ContinueWith is + impossible; we don't need to pattern match on it as a possible outcome:A + see GHC.Tc.Solver.Solve.solveOne. To that end, ContinueWith is strict. +-} + data StopOrContinue a = StartAgain Ct -- Constraint is not solved, but some unifications -- happened, so go back to the beginning of the pipeline | ContinueWith !a -- The constraint was not solved, although it may have -- been rewritten. It is strict so that - -- ContinueWith Void can't happen + -- ContinueWith Void can't happen; see (SM2) in + -- Note [The SolverStage monad] | Stop CtEvidence -- The (rewritten) constraint was solved SDoc -- Tells how it was solved View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b03cc67fd7ea06cd25bd92875e5cdcd4ff2a8505 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b03cc67fd7ea06cd25bd92875e5cdcd4ff2a8505 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 15:31:32 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 18 May 2023 11:31:32 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] Memory usage fixes for Haddock Message-ID: <646644d4cb64_9760ab80d2b02914ba@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 528314da by Finley McIlwaine at 2023-05-18T09:31:11-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Update Haddock submodule - - - - - 4 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - utils/haddock Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -1360,11 +1360,15 @@ mkDocIE (L l_comment hdk_comment) = span = mkSrcSpanPs l_comment mkDocNext :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocNext (L l (HdkCommentNext doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocNext (L l (HdkCommentNext doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocNext _ = Nothing mkDocPrev :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocPrev (L l (HdkCommentPrev doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocPrev (L l (HdkCommentPrev doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocPrev _ = Nothing ===================================== compiler/GHC/Rename/Doc.hs ===================================== @@ -35,6 +35,7 @@ rnHsDoc (WithHsDocIdentifiers s ids) = do gre <- tcg_rdr_env <$> getGblEnv pure (WithHsDocIdentifiers s (rnHsDocIdentifiers gre ids)) + rnHsDocIdentifiers :: GlobalRdrEnv -> [Located RdrName] -> [Located Name] ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 +Subproject commit 04e9d6048bb297de5831651e60d496217525ef62 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/528314da02148ca17e7d188c28d2fbc4fa838948 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/528314da02148ca17e7d188c28d2fbc4fa838948 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 15:32:00 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 18 May 2023 11:32:00 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] Memory usage fixes for Haddock Message-ID: <646644f03050f_9760ab41e654291770@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: eabfb75f by Finley McIlwaine at 2023-05-18T09:31:51-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Update Haddock submodule - - - - - 3 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - utils/haddock Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -1360,11 +1360,15 @@ mkDocIE (L l_comment hdk_comment) = span = mkSrcSpanPs l_comment mkDocNext :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocNext (L l (HdkCommentNext doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocNext (L l (HdkCommentNext doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocNext _ = Nothing mkDocPrev :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocPrev (L l (HdkCommentPrev doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocPrev (L l (HdkCommentPrev doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocPrev _ = Nothing ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 +Subproject commit 04e9d6048bb297de5831651e60d496217525ef62 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eabfb75f4499a8468a9f2dec3d17546272a834f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eabfb75f4499a8468a9f2dec3d17546272a834f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 15:40:55 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 18 May 2023 11:40:55 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 3 commits: Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <6466470756b8c_9760abaf44242995a3@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 72e21440 by Finley McIlwaine at 2023-05-18T09:40:45-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Update Haddock submodule - - - - - 6 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - docs/users_guide/ghci.rst - utils/haddock Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -1360,11 +1360,15 @@ mkDocIE (L l_comment hdk_comment) = span = mkSrcSpanPs l_comment mkDocNext :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocNext (L l (HdkCommentNext doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocNext (L l (HdkCommentNext doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocNext _ = Nothing mkDocPrev :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocPrev (L l (HdkCommentPrev doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocPrev (L l (HdkCommentPrev doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocPrev _ = Nothing ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -53,6 +53,7 @@ import GHC.Data.Bag import Data.Maybe ( isJust ) import qualified Data.Semigroup as S +import GHC.Tc.Utils.Monad (getLclEnvLoc) {- ************************************************************************ @@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] - setLclEnv (ctLocEnv loc) $ - -- This setLclEnv is important: the emitImplicationTcS uses that + setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $ + -- This setSrcSpan is important: the emitImplicationTcS uses that -- TcLclEnv for the implication, and that in turn sets the location -- for the Givens when solving the constraint (#21006) do { let empty_subst = mkEmptySubst $ mkInScopeSet $ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad ( getSolvedDicts, setSolvedDicts, getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, setLclEnv, + getTopEnv, getGblEnv, getLclEnv, setSrcSpan, getTcEvBindsVar, getTcLevel, getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, tcLookupClass, tcLookupId, tcLookupTyCon, @@ -194,6 +194,7 @@ import Data.IORef import Data.List ( mapAccumL ) import Data.Foldable import qualified Data.Semigroup as S +import GHC.Types.SrcLoc #if defined(DEBUG) import GHC.Types.Unique.Set (nonDetEltsUniqSet) @@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv getLclEnv :: TcS TcLclEnv getLclEnv = wrapTcS $ TcM.getLclEnv -setLclEnv :: TcLclEnv -> TcS a -> TcS a -setLclEnv env = wrap2TcS (TcM.setLclEnv env) +setSrcSpan :: RealSrcSpan -> TcS a -> TcS a +setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) tcLookupClass :: Name -> TcS Class tcLookupClass c = wrapTcS $ TcM.tcLookupClass c ===================================== docs/users_guide/ghci.rst ===================================== @@ -3546,41 +3546,19 @@ The interpreter can't load modules with foreign export declarations! Unfortunately not. We haven't implemented it yet. Please compile any offending modules by hand before loading them into GHCi. -:ghc-flag:`-O` doesn't work with GHCi! +:ghc-flag:`-O` is ineffective in GHCi! .. index:: single: optimization; and GHCi - For technical reasons, the bytecode compiler doesn't interact well - with one of the optimisation passes, so we have disabled - optimisation when using the interpreter. This isn't a great loss: - you'll get a much bigger win by compiling the bits of your code that - need to go fast, rather than interpreting them with optimisation - turned on. + Before GHC 9.8, optimizations were considered too unstable to be used with + the bytecode interpreter. + This restriction has been lifted, but is still regarded as experimental and + guarded by :ghc-flag:`-funoptimized-core-for-interpreter`, which is enabled + by default. + In order to use optimizations, run: :: -Modules using unboxed tuples or sums will automatically enable :ghc-flag:`-fobject-code` - - .. index:: - single: unboxed tuples, sums; and GHCi - - The bytecode interpreter doesn't support most uses of unboxed tuples or - sums, so GHCi will automatically compile these modules, and all modules - they depend on, to object code instead of bytecode. - - GHCi checks for the presence of unboxed tuples and sums in a somewhat - conservative fashion: it simply checks to see if a module enables the - :extension:`UnboxedTuples` or :extension:`UnboxedSums` language extensions. - It is not always the case that code which enables :extension:`UnboxedTuples` - or :extension:`UnboxedSums` requires :ghc-flag:`-fobject-code`, so if you - *really* want to compile - :extension:`UnboxedTuples`/:extension:`UnboxedSums`-using code to - bytecode, you can do so explicitly by enabling the :ghc-flag:`-fbyte-code` - flag. If you do this, do note that bytecode interpreter will throw an error - if it encounters unboxed tuple/sum–related code that it cannot handle. - - Incidentally, the previous point, that :ghc-flag:`-O` is - incompatible with GHCi, is because the bytecode compiler can't - deal with unboxed tuples or sums. + ghci -fno-unoptimized-core-for-interpreter -O Concurrent threads don't carry on running when GHCi is waiting for input. This should work, as long as your GHCi was built with the ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 +Subproject commit 04e9d6048bb297de5831651e60d496217525ef62 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eabfb75f4499a8468a9f2dec3d17546272a834f6...72e21440778d5316380e4f40950935865bf4921c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eabfb75f4499a8468a9f2dec3d17546272a834f6...72e21440778d5316380e4f40950935865bf4921c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 15:48:49 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 18 May 2023 11:48:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bad-note Message-ID: <646648e1d565b_9760ab41e65430457c@gitlab.mail> Matthew Pickering pushed new branch wip/bad-note at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bad-note You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 16:09:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 May 2023 12:09:03 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: base: Add test for #13660 Message-ID: <64664d9f4e6ce_9760ab41e6543134da@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 169ebb4a by Ben Gamari at 2023-05-18T12:08:30-04:00 base: Add test for #13660 - - - - - 4c2a6184 by Ben Gamari at 2023-05-18T12:08:30-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 9f28fe3d by Ben Gamari at 2023-05-18T12:08:30-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - 500d7d60 by Ben Gamari at 2023-05-18T12:08:30-04:00 base: Clean up documentation - - - - - 844813cd by Ben Gamari at 2023-05-18T12:08:30-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - adf35f33 by Simon Peyton Jones at 2023-05-18T12:08:31-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - 9f1d4a5c by Greg Steuck at 2023-05-18T12:08:34-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - f135b052 by Torsten Schmits at 2023-05-18T12:08:46-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 48e9aa20 by Matthew Pickering at 2023-05-18T12:08:47-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 22 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Names.hs - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - + libraries/base/tests/T13660.hs - + libraries/base/tests/T13660.stdout - libraries/base/tests/all.T - m4/fp_ld_supports_response_files.m4 - testsuite/tests/ghc-api/T10052/T10052.stderr - testsuite/tests/ghci.debugger/scripts/print007.stderr - testsuite/tests/ghci/should_fail/T10549.stderr - testsuite/tests/ghci/should_fail/T10549a.stderr - testsuite/tests/indexed-types/should_compile/T7837.stderr - testsuite/tests/safeHaskell/ghci/p14.stderr - + testsuite/tests/stranal/should_compile/T23398.hs - + testsuite/tests/stranal/should_compile/T23398.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/th/T8333.stderr Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -16,37 +16,41 @@ where import GHC.Prelude -import GHC.Core.Opt.WorkWrap.Utils import GHC.Types.Demand -- All of it + import GHC.Core -import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Utils.Outputable -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic -import Data.List ( mapAccumL ) import GHC.Core.DataCon -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Predicate( isClassPred ) +import GHC.Core.Predicate( isEqualityClass, isCTupleClass ) import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain +import GHC.Core.Opt.WorkWrap.Utils + import GHC.Builtin.PrimOps import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) + import GHC.Types.Unique.Set import GHC.Types.Unique.MemoFun import GHC.Types.RepType +import GHC.Types.ForeignCall ( isSafeForeignCall ) +import GHC.Types.Id +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Outputable + +import Data.List ( mapAccumL ) {- ************************************************************************ @@ -1499,7 +1503,7 @@ bounds-checking. So we want to give `indexError` a signature like `<1!P(!S,!S)><1!S>b` where the !S (meaning Poly Unboxed C1N) says that the polymorphic arguments -are unboxed (recursively). The wrapper for `indexError` won't /acutally/ +are unboxed (recursively). The wrapper for `indexError` won't /actually/ unbox them (because their polymorphic type doesn't allow that) but when demand-analysing /callers/, we'll behave as if that call needs the args unboxed. @@ -1782,39 +1786,6 @@ applying the strictness demands to the final result of DmdAnal. The result is that we get the strict demand signature we wanted even if we can't float the case on `x` up through the case on `burble`. -Note [Do not unbox class dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never unbox class dictionaries in worker/wrapper. - -1. INLINABLE functions - If we have - f :: Ord a => [a] -> Int -> a - {-# INLINABLE f #-} - and we worker/wrapper f, we'll get a worker with an INLINABLE pragma - (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), - which can still be specialised by the type-class specialiser, something like - fw :: Ord a => [a] -> Int# -> a - - BUT if f is strict in the Ord dictionary, we might unpack it, to get - fw :: (a->a->Bool) -> [a] -> Int# -> a - and the type-class specialiser can't specialise that. An example is #6056. - - Historical note: #14955 describes how I got this fix wrong the first time. - I got aware of the issue in T5075 by the change in boxity of loop between - demand analysis runs. - -2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur - occur without INLINABLE, when we use -fexpose-all-unfoldings and - -fspecialise-aggressively to do vigorous cross-module specialisation. - -3. #18421 found that unboxing a dictionary can also make the worker less likely - to inline; the inlining heuristics seem to prefer to inline a function - applied to a dictionary over a function applied to a bunch of functions. - -TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing -a raft of higher-order functions isn't a huge win anyway -- you really want to -specialise the function. - Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of @@ -1998,22 +1969,13 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take threshold_arity $ - [ (bndr_ty, NotMarkedStrict, get_dmd bndr bndr_ty) - | bndr <- bndrs - , isRuntimeVar bndr, let bndr_ty = idType bndr ] - - get_dmd :: Id -> Type -> Demand - get_dmd bndr bndr_ty - | isClassPred bndr_ty = trimBoxity dmd - -- See Note [Do not unbox class dictionaries] - -- NB: 'ty' has not been normalised, so this will (rightly) - -- catch newtype dictionaries too. - -- NB: even for bottoming functions, don't unbox dictionaries - - | is_bot_fn = unboxDeeplyDmd dmd - -- See Note [Boxity for bottoming functions], case (B) - - | otherwise = dmd + [ (idType bndr, NotMarkedStrict, get_dmd bndr) + | bndr <- bndrs, isRuntimeVar bndr ] + + get_dmd :: Id -> Demand + get_dmd bndr + | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], + | otherwise = dmd -- case (B) where dmd = idDemandInfo bndr @@ -2119,6 +2081,12 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) -- isMarkedStrict: see Note [Unboxing evaluated arguments] in DmdAnal -> DontUnbox + | doNotUnbox ty + -> DontUnbox -- See Note [Do not unbox class dictionaries] + -- NB: 'ty' has not been normalised, so this will (rightly) + -- catch newtype dictionaries too. + -- NB: even for bottoming functions, don't unbox dictionaries + | DefinitelyRecursive <- ae_rec_dc env dc -- See Note [Which types are unboxed?] -- and Note [Demand analysis for recursive data constructors] @@ -2129,6 +2097,76 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) (dataConRepStrictness dc) dmds) + +doNotUnbox :: Type -> Bool +-- Do not unbox class dictionaries, except equality classes and tuples +-- Note [Do not unbox class dictionaries] +doNotUnbox arg_ty + = case tyConAppTyCon_maybe arg_ty of + Just tc | Just cls <- tyConClass_maybe tc + -> not (isEqualityClass cls || isCTupleClass cls) + -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] + + _ -> False + +{- Note [Do not unbox class dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never unbox class dictionaries in worker/wrapper. + +1. INLINABLE functions + If we have + f :: Ord a => [a] -> Int -> a + {-# INLINABLE f #-} + and we worker/wrapper f, we'll get a worker with an INLINABLE pragma + (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), + which can still be specialised by the type-class specialiser, something like + fw :: Ord a => [a] -> Int# -> a + + BUT if f is strict in the Ord dictionary, we might unpack it, to get + fw :: (a->a->Bool) -> [a] -> Int# -> a + and the type-class specialiser can't specialise that. An example is #6056. + + Historical note: #14955 describes how I got this fix wrong the first time. + I got aware of the issue in T5075 by the change in boxity of loop between + demand analysis runs. + +2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur + occur without INLINABLE, when we use -fexpose-all-unfoldings and + -fspecialise-aggressively to do vigorous cross-module specialisation. + +3. #18421 found that unboxing a dictionary can also make the worker less likely + to inline; the inlining heuristics seem to prefer to inline a function + applied to a dictionary over a function applied to a bunch of functions. + +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing +a raft of higher-order functions isn't a huge win anyway -- you really want to +specialise the function. + +Wrinkle (DNB1): we /do/ want to unbox tuple dictionaries (#23398) + f :: (% Eq a, Show a %) => blah + with -fdicts-strict it is great to unbox to + $wf :: Eq a => Show a => blah + (where I have written out the currying explicitly). Now we can specialise + $wf on the Eq or Show dictionary. Nothing is lost. + + And something is gained. It is possible that `f` will look like this: + f = /\a. \d:(% Eq a, Show a %). ... f @a (% sel1 d, sel2 d %)... + where there is a recurive call to `f`, or to another function that takes the + same tuple dictionary, but where the tuple is built from the components of + `d`. The Simplier does not fix this. But if we unpacked the dictionary + we'd get + $wf = /\a. \(d1:Eq a) (d2:Show a). let d = (% d1, d2 %) + in ...f @a (% sel1 d, sel2 d %) + and all the tuple building and taking apart will disappear. + +Wrinkle (DNB2): we /do/ wnat to unbox equality dictionaries, + for (~), (~~), and Coercible (#23398). Their payload is a single unboxed + coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is + to make a copy of the function's RHS with a particular coercion. Unlike + normal class methods, that does not unlock any new optimisation + opportunities in the specialised RHS. +-} + {- ********************************************************************* * * Fixpoints ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqPredClass, isCTupleClass, isEqualityClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -219,11 +219,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -245,6 +240,20 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) +isEqPredClass :: Class -> Bool +-- True of (~) and (~~) +isEqPredClass cls = cls `hasKey` eqTyConKey + || cls `hasKey` heqTyConKey + +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + + {- ********************************************************************* * * Implicit parameters ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3658,9 +3658,10 @@ makeDynFlagsConsistent dflags , gopt Opt_UnoptimizedCoreForInterpreter dflags , let (dflags', changed) = updOptLevelChanged 0 dflags , changed - = loop dflags' ("Optimization flags are incompatible with the " ++ - backendDescription (backend dflags) ++ - "; optimization flags ignored.") + = loop dflags' $ + "Ignoring optimization flags since they are experimental for the " ++ + backendDescription (backend dflags) ++ + ". Pass -fno-unoptimized-core-for-interpreter to enable this feature." | LinkInMemory <- ghcLink dflags , not (gopt Opt_ExternalInterpreter dflags) ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -12,8 +12,6 @@ Extracting imported and top-level names in scope {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -ddump-to-file -ddump-simpl #-} - module GHC.Rename.Names ( rnImports, getLocalNonValBinders, newRecordFieldLabel, extendGlobalRdrEnvRn, ===================================== libraries/base/GHC/Foreign.hs ===================================== @@ -21,312 +21,22 @@ module GHC.Foreign ( -- * C strings with a configurable encoding CString, CStringLen, - -- conversion of C strings into Haskell strings - -- + -- * Conversion of C strings into Haskell strings peekCString, peekCStringLen, - -- conversion of Haskell strings into C strings - -- + -- * Conversion of Haskell strings into C strings newCString, newCStringLen, + newCStringLen0, - -- conversion of Haskell strings into C strings using temporary storage - -- + -- * Conversion of Haskell strings into C strings using temporary storage withCString, withCStringLen, + withCStringLen0, withCStringsLen, charIsRepresentable, ) where -import Foreign.Marshal.Array -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Storable - -import Data.Word - --- Imports for the locale-encoding version of marshallers - -import Data.Tuple (fst) - -import GHC.Show ( show ) - -import Foreign.Marshal.Alloc -import Foreign.ForeignPtr - -import GHC.Debug -import GHC.List -import GHC.Num -import GHC.Base - -import GHC.IO -import GHC.IO.Exception -import GHC.IO.Buffer -import GHC.IO.Encoding.Types - - -c_DEBUG_DUMP :: Bool -c_DEBUG_DUMP = False - -putDebugMsg :: String -> IO () -putDebugMsg | c_DEBUG_DUMP = debugLn - | otherwise = const (return ()) - - --- | A C string is a reference to an array of C characters terminated by NUL. -type CString = Ptr CChar - --- | A string with explicit length information in bytes instead of a --- terminating NUL (allowing NUL characters in the middle of the string). -type CStringLen = (Ptr CChar, Int) - --- exported functions --- ------------------ - --- | Marshal a NUL terminated C string into a Haskell string. --- -peekCString :: TextEncoding -> CString -> IO String -peekCString enc cp = do - sz <- lengthArray0 nUL cp - peekEncodedCString enc (cp, sz * cCharSize) - --- | Marshal a C string with explicit length into a Haskell string. --- -peekCStringLen :: TextEncoding -> CStringLen -> IO String -peekCStringLen = peekEncodedCString - --- | Marshal a Haskell string into a NUL terminated C string. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCString :: TextEncoding -> String -> IO CString -newCString enc = liftM fst . newEncodedCString enc True - --- | Marshal a Haskell string into a C string (ie, character array) with --- explicit length information. --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCStringLen :: TextEncoding -> String -> IO CStringLen -newCStringLen enc = newEncodedCString enc False - --- | Marshal a Haskell string into a NUL terminated C string using temporary --- storage. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a -withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp - --- | Marshal a Haskell string into a C string (ie, character array) --- in temporary storage, with explicit length information. --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a -withCStringLen enc = withEncodedCString enc False - --- | Marshal a list of Haskell strings into an array of NUL terminated C strings --- using temporary storage. --- --- * the Haskell strings may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringsLen :: TextEncoding - -> [String] - -> (Int -> Ptr CString -> IO a) - -> IO a -withCStringsLen enc strs f = go [] strs - where - go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss - go cs [] = withArrayLen (reverse cs) f - --- | Determines whether a character can be accurately encoded in a --- 'Foreign.C.String.CString'. --- --- Pretty much anyone who uses this function is in a state of sin because --- whether or not a character is encodable will, in general, depend on the --- context in which it occurs. -charIsRepresentable :: TextEncoding -> Char -> IO Bool --- We force enc explicitly because `catch` is lazy in its --- first argument. We would probably like to force c as well, --- but unfortunately worker/wrapper produces very bad code for --- that. --- --- TODO If this function is performance-critical, it would probably --- pay to use a single-character specialization of withCString. That --- would allow worker/wrapper to actually eliminate Char boxes, and --- would also get rid of the completely unnecessary cons allocation. -charIsRepresentable !enc c = - withCString enc [c] - (\cstr -> do str <- peekCString enc cstr - case str of - [ch] | ch == c -> pure True - _ -> pure False) - `catch` - \(_ :: IOException) -> pure False - --- auxiliary definitions --- ---------------------- - --- C's end of string character -nUL :: CChar -nUL = 0 - --- Size of a CChar in bytes -cCharSize :: Int -cCharSize = sizeOf (undefined :: CChar) - - -{-# INLINE peekEncodedCString #-} -peekEncodedCString :: TextEncoding -- ^ Encoding of CString - -> CStringLen - -> IO String -- ^ String in Haskell terms -peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) - = bracket mk_decoder close $ \decoder -> do - let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII - !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) - !to <- newCharBuffer chunk_size WriteBuffer - - let go !iteration !from = do - (why, from', !to') <- encode decoder from to - if isEmptyBuffer from' - then - -- No input remaining: @why@ will be InputUnderflow, but we don't care - withBuffer to' $ peekArray (bufferElems to') - else do - -- Input remaining: what went wrong? - putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) - (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because - InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input - OutputUnderflow -> return (from', to') -- We will have more space next time round - putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') - putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') - to_chars <- withBuffer to'' $ peekArray (bufferElems to'') - fmap (to_chars++) $ go (iteration + 1) from'' - - go (0 :: Int) from0 - -{-# INLINE withEncodedCString #-} -withEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory - -> IO a -withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_sz_bytes = do - putDebugMsg ("withEncodedCString: " ++ show iteration) - allocaBytes to_sz_bytes $ \to_p -> do - -- See Note [Check *before* fill in withEncodedCString] about why - -- this is subtle. - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> go (iteration + 1) (to_sz_bytes * 2) - Just to_buf -> withCStringBuffer to_buf null_terminate act - - -- If the input string is ASCII, this value will ensure we only allocate once - go (0 :: Int) (cCharSize * (sz + 1)) - -withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r -withCStringBuffer to_buf null_terminate act = do - let bytes = bufferElems to_buf - withBuffer to_buf $ \to_ptr -> do - when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 - act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* - -{-# INLINE newEncodedCString #-} -newEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> IO CStringLen -newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_p to_sz_bytes = do - putDebugMsg ("newEncodedCString: " ++ show iteration) - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> do - let to_sz_bytes' = to_sz_bytes * 2 - to_p' <- reallocBytes to_p to_sz_bytes' - go (iteration + 1) to_p' to_sz_bytes' - Just to_buf -> withCStringBuffer to_buf null_terminate return - - -- If the input string is ASCII, this value will ensure we only allocate once - let to_sz_bytes = cCharSize * (sz + 1) - to_p <- mallocBytes to_sz_bytes - go (0 :: Int) to_p to_sz_bytes - - -tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int - -> IO (Maybe (Buffer Word8)) -tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do - !to_fp <- newForeignPtr_ to_p - go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) - where - go !iteration !from !to = do - (why, from', to') <- encode encoder from to - putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') - if isEmptyBuffer from' - then if null_terminate && bufferAvailable to' == 0 - then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer - else return (Just to') - else case why of -- We didn't consume all of the input - InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad - InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid - OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more -{- -Note [Check *before* fill in withEncodedCString] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's very important that the size check and readjustment peformed by tryFillBuffer -happens before the continuation is called. The size check is the part which can -fail, the call to the continuation never fails and so the caller should respond -first to the size check failing and *then* call the continuation. Making this evident -to the compiler avoids historic space leaks. - -In a previous iteration of this code we had a pattern that, somewhat simplified, -looked like this: - -go :: State -> (State -> IO a) -> IO a -go state action = - case tryFillBufferAndCall state action of - Left state' -> go state' action - Right result -> result - -`tryFillBufferAndCall` performed some checks, and then we either called action, -or we modified the state and tried again. -This went wrong because `action` can be a function closure containing a reference to -a lazy data structure. If we call action directly, without retaining any references -to action, that is fine. The data structure is consumed as it is produced and we operate -in constant space. - -However the failure branch `go state' action` *does* capture a reference to action. -This went wrong because the reference to action in the failure branch only becomes -unreachable *after* action returns. This means we keep alive the function closure -for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list -via `action` until the action has fully run. -This went wrong in #20107, where the continuation kept an entire lazy bytestring alive -rather than allowing it to be incrementally consumed and collected. --} - +import GHC.Foreign.Internal ===================================== libraries/base/GHC/Foreign/Internal.hs ===================================== @@ -0,0 +1,357 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Foreign.Internal +-- Copyright : (c) The University of Glasgow, 2008-2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : libraries at haskell.org +-- Stability : internal +-- Portability : non-portable +-- +-- Foreign marshalling support for CStrings with configurable encodings +-- +----------------------------------------------------------------------------- + +module GHC.Foreign.Internal ( + -- * C strings with a configurable encoding + CString, CStringLen, + + -- * Conversion of C strings into Haskell strings + peekCString, + peekCStringLen, + + -- * Conversion of Haskell strings into C strings + newCString, + newCStringLen, + newCStringLen0, + + -- * Conversion of Haskell strings into C strings using temporary storage + withCString, + withCStringLen, + withCStringLen0, + withCStringsLen, + + charIsRepresentable, + ) where + +import Foreign.Marshal.Array +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable + +import Data.Word + +-- Imports for the locale-encoding version of marshallers + +import Data.Tuple (fst) + +import GHC.Show ( show ) + +import Foreign.Marshal.Alloc +import Foreign.ForeignPtr + +import GHC.Debug +import GHC.List +import GHC.Num +import GHC.Base + +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Buffer +import GHC.IO.Encoding.Types + + +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False + +putDebugMsg :: String -> IO () +putDebugMsg | c_DEBUG_DUMP = debugLn + | otherwise = const (return ()) + + +-- | A C string is a reference to an array of C characters terminated by NUL. +type CString = Ptr CChar + +-- | A string with explicit length information in bytes instead of a +-- terminating NUL (allowing NUL characters in the middle of the string). +type CStringLen = (Ptr CChar, Int) + +-- exported functions +-- ------------------ + +-- | Marshal a NUL terminated C string into a Haskell string. +-- +peekCString :: TextEncoding -> CString -> IO String +peekCString enc cp = do + sz <- lengthArray0 nUL cp + peekEncodedCString enc (cp, sz * cCharSize) + +-- | Marshal a C string with explicit length into a Haskell string. +-- +peekCStringLen :: TextEncoding -> CStringLen -> IO String +peekCStringLen = peekEncodedCString + +-- | Marshal a Haskell string into a NUL terminated C string. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCString :: TextEncoding -> String -> IO CString +newCString enc = liftM fst . newEncodedCString enc True + +-- | Marshal a Haskell string into a C string (ie, character array) with +-- explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCStringLen :: TextEncoding -> String -> IO CStringLen +newCStringLen enc = newEncodedCString enc False + +-- | Marshal a Haskell string into a NUL terminated C string using temporary +-- storage. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a +withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp + +-- | Marshal a Haskell string into a C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen enc = withEncodedCString enc False + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- with explicit length information. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +-- @since 4.19.0.0 +newCStringLen0 :: TextEncoding -> String -> IO CStringLen +newCStringLen0 enc = newEncodedCString enc True + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +-- @since 4.19.0.0 +withCStringLen0 :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen0 enc = withEncodedCString enc True + +-- | Marshal a list of Haskell strings into an array of NUL terminated C strings +-- using temporary storage. +-- +-- * the Haskell strings may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringsLen :: TextEncoding + -> [String] + -> (Int -> Ptr CString -> IO a) + -> IO a +withCStringsLen enc strs f = go [] strs + where + go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss + go cs [] = withArrayLen (reverse cs) f + +-- | Determines whether a character can be accurately encoded in a +-- 'Foreign.C.String.CString'. +-- +-- Pretty much anyone who uses this function is in a state of sin because +-- whether or not a character is encodable will, in general, depend on the +-- context in which it occurs. +charIsRepresentable :: TextEncoding -> Char -> IO Bool +-- We force enc explicitly because `catch` is lazy in its +-- first argument. We would probably like to force c as well, +-- but unfortunately worker/wrapper produces very bad code for +-- that. +-- +-- TODO If this function is performance-critical, it would probably +-- pay to use a single-character specialization of withCString. That +-- would allow worker/wrapper to actually eliminate Char boxes, and +-- would also get rid of the completely unnecessary cons allocation. +charIsRepresentable !enc c = + withCString enc [c] + (\cstr -> do str <- peekCString enc cstr + case str of + [ch] | ch == c -> pure True + _ -> pure False) + `catch` + \(_ :: IOException) -> pure False + +-- auxiliary definitions +-- ---------------------- + +-- C's end of string character +nUL :: CChar +nUL = 0 + +-- Size of a CChar in bytes +cCharSize :: Int +cCharSize = sizeOf (undefined :: CChar) + + +{-# INLINE peekEncodedCString #-} +peekEncodedCString :: TextEncoding -- ^ Encoding of CString + -> CStringLen + -> IO String -- ^ String in Haskell terms +peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) + = bracket mk_decoder close $ \decoder -> do + let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII + !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) + !to <- newCharBuffer chunk_size WriteBuffer + + let go !iteration !from = do + (why, from', !to') <- encode decoder from to + if isEmptyBuffer from' + then + -- No input remaining: @why@ will be InputUnderflow, but we don't care + withBuffer to' $ peekArray (bufferElems to') + else do + -- Input remaining: what went wrong? + putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) + (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because + InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input + OutputUnderflow -> return (from', to') -- We will have more space next time round + putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') + putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') + to_chars <- withBuffer to'' $ peekArray (bufferElems to'') + fmap (to_chars++) $ go (iteration + 1) from'' + + go (0 :: Int) from0 + +{-# INLINE withEncodedCString #-} +withEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory + -> IO a +withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_sz_bytes = do + putDebugMsg ("withEncodedCString: " ++ show iteration) + allocaBytes to_sz_bytes $ \to_p -> do + -- See Note [Check *before* fill in withEncodedCString] about why + -- this is subtle. + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> go (iteration + 1) (to_sz_bytes * 2) + Just to_buf -> withCStringBuffer to_buf null_terminate act + + -- If the input string is ASCII, this value will ensure we only allocate once + go (0 :: Int) (cCharSize * (sz + 1)) + +withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r +withCStringBuffer to_buf null_terminate act = do + let bytes = bufferElems to_buf + withBuffer to_buf $ \to_ptr -> do + when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 + act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* + +{-# INLINE newEncodedCString #-} +newEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> IO CStringLen +newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_p to_sz_bytes = do + putDebugMsg ("newEncodedCString: " ++ show iteration) + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> do + let to_sz_bytes' = to_sz_bytes * 2 + to_p' <- reallocBytes to_p to_sz_bytes' + go (iteration + 1) to_p' to_sz_bytes' + Just to_buf -> withCStringBuffer to_buf null_terminate return + + -- If the input string is ASCII, this value will ensure we only allocate once + let to_sz_bytes = cCharSize * (sz + 1) + to_p <- mallocBytes to_sz_bytes + go (0 :: Int) to_p to_sz_bytes + + +tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int + -> IO (Maybe (Buffer Word8)) +tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do + !to_fp <- newForeignPtr_ to_p + go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) + where + go !iteration !from !to = do + (why, from', to') <- encode encoder from to + putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') + if isEmptyBuffer from' + then if null_terminate && bufferAvailable to' == 0 + then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer + else return (Just to') + else case why of -- We didn't consume all of the input + InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad + InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid + OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more +{- +Note [Check *before* fill in withEncodedCString] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's very important that the size check and readjustment peformed by tryFillBuffer +happens before the continuation is called. The size check is the part which can +fail, the call to the continuation never fails and so the caller should respond +first to the size check failing and *then* call the continuation. Making this evident +to the compiler avoids historic space leaks. + +In a previous iteration of this code we had a pattern that, somewhat simplified, +looked like this: + +go :: State -> (State -> IO a) -> IO a +go state action = + case tryFillBufferAndCall state action of + Left state' -> go state' action + Right result -> result + +`tryFillBufferAndCall` performed some checks, and then we either called action, +or we modified the state and tried again. +This went wrong because `action` can be a function closure containing a reference to +a lazy data structure. If we call action directly, without retaining any references +to action, that is fine. The data structure is consumed as it is produced and we operate +in constant space. + +However the failure branch `go state' action` *does* capture a reference to action. +This went wrong because the reference to action in the failure branch only becomes +unreachable *after* action returns. This means we keep alive the function closure +for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list +via `action` until the action has fully run. +This went wrong in #20107, where the continuation kept an entire lazy bytestring alive +rather than allowing it to be incrementally consumed and collected. +-} + ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -34,7 +34,6 @@ import System.Posix.Types import Foreign import Foreign.C --- import Data.Bits import Data.Maybe #if !defined(HTYPE_TCFLAG_T) @@ -51,6 +50,9 @@ import GHC.IO.Device #if !defined(mingw32_HOST_OS) import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC +import GHC.Ptr +#else +import Data.OldList (elem) #endif -- --------------------------------------------------------------------------- @@ -164,13 +166,23 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) + #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +190,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen0 enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen0 enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff ===================================== libraries/base/base.cabal ===================================== @@ -351,6 +351,7 @@ Library GHC.Event.IntVar GHC.Event.PSQ GHC.Event.Unique + GHC.Foreign.Internal -- GHC.IOPort -- TODO: hide again after debug GHC.Unicode.Internal.Bits GHC.Unicode.Internal.Char.DerivedCoreProperties ===================================== libraries/base/tests/T13660.hs ===================================== @@ -0,0 +1,11 @@ +-- | This should print an InvalidArgument error complaining that +-- the file path contains a NUL octet. +module Main where + +import System.IO.Error + +main :: IO () +main = do + catchIOError + (writeFile "hello\x00world" "hello") + print ===================================== libraries/base/tests/T13660.stdout ===================================== Binary files /dev/null and b/libraries/base/tests/T13660.stdout differ ===================================== libraries/base/tests/all.T ===================================== @@ -256,6 +256,7 @@ test('T13191', ['-O']) test('T13525', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) +test('T13660', when(opsys('mingw32'), skip), compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) test('T3474', [collect_stats('max_bytes_used',5), ===================================== m4/fp_ld_supports_response_files.m4 ===================================== @@ -5,7 +5,7 @@ AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ AC_MSG_CHECKING([whether $LD supports response files]) echo 'int main(void) {return 0;}' > conftest.c "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf '%q\n' -o conftest conftest.o > args.txt + printf "-o\nconftest\nconftest.o\n" > args.txt if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 then LdSupportsResponseFiles=YES ===================================== testsuite/tests/ghc-api/T10052/T10052.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci.debugger/scripts/print007.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci/should_fail/T10549.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci/should_fail/T10549a.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/indexed-types/should_compile/T7837.stderr ===================================== @@ -1,3 +1,4 @@ Rule fired: Class op signum (BUILTIN) Rule fired: Class op abs (BUILTIN) Rule fired: normalize/Double (T7837) +Rule fired: Class op eq_sel (BUILTIN) ===================================== testsuite/tests/safeHaskell/ghci/p14.stderr ===================================== @@ -1,6 +1,6 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. :10:25: error: [GHC-39999] • No instance for ‘Num a’ arising from a use of ‘f’ ===================================== testsuite/tests/stranal/should_compile/T23398.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fdicts-strict #-} +module T23398 where + +type PairDict a = (Eq a, Show a) + +foo :: PairDict a => a -> a -> String +foo x y | x==y = show x + | otherwise = show y + +-- In worker/wrapper we'd like to unbox the pair +-- but not (Eq a) and (Show a) + +bar :: (a ~ b, Show a) => Int -> a -> (b, String) +bar 0 x = (x, show x) +bar n x = bar (n-1) x ===================================== testsuite/tests/stranal/should_compile/T23398.stderr ===================================== @@ -0,0 +1,109 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 76, types: 117, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} +T23398.$wfoo [InlPrag=[2]] + :: forall {a}. (Eq a, Show a) => a -> a -> String +[GblId[StrictWorker([!, !])], + Arity=4, + Str=, + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [30 60 0 0] 120 0}] +T23398.$wfoo + = \ (@a) (ww :: Eq a) (ww1 :: Show a) (eta :: a) (eta1 :: a) -> + case == @a ww eta eta1 of { + False -> show @a ww1 eta1; + True -> show @a ww1 eta + } + +-- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/0} +foo [InlPrag=[2]] :: forall a. PairDict a => a -> a -> String +[GblId, + Arity=3, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + ($d(%,%) [Occ=Once1!] :: PairDict a) + (eta [Occ=Once1] :: a) + (eta1 [Occ=Once1] :: a) -> + case $d(%,%) of { (ww [Occ=Once1], ww1 [Occ=Once1]) -> + T23398.$wfoo @a ww ww1 eta eta1 + }}] +foo + = \ (@a) ($d(%,%) :: PairDict a) (eta :: a) (eta1 :: a) -> + case $d(%,%) of { (ww, ww1) -> T23398.$wfoo @a ww ww1 eta eta1 } + +Rec { +-- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} +T23398.$wbar [InlPrag=[2], Occ=LoopBreaker] + :: forall {a} {b}. + (a GHC.Prim.~# b, Show a) => + GHC.Prim.Int# -> a -> (# b, String #) +[GblId[StrictWorker([~, !])], + Arity=4, + Str=<1L>, + Unf=OtherCon []] +T23398.$wbar + = \ (@a) + (@b) + (ww :: a GHC.Prim.~# b) + ($dShow :: Show a) + (ww1 :: GHC.Prim.Int#) + (eta :: a) -> + case ww1 of ds { + __DEFAULT -> + T23398.$wbar + @a @b @~(ww :: a GHC.Prim.~# b) $dShow (GHC.Prim.-# ds 1#) eta; + 0# -> (# eta `cast` (Sub ww :: a ~R# b), show @a $dShow eta #) + } +end Rec } + +-- RHS size: {terms: 21, types: 32, coercions: 1, joins: 0/0} +bar [InlPrag=[2]] + :: forall a b. (a ~ b, Show a) => Int -> a -> (b, String) +[GblId, + Arity=4, + Str=<1!P(1L)>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (@b) + ($d~ [Occ=Once1!] :: a ~ b) + ($dShow [Occ=Once1] :: Show a) + (eta [Occ=Once1!] :: Int) + (eta1 [Occ=Once1] :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 [Occ=Once1] -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2 [Occ=Once1], ww3 [Occ=Once1] #) -> + (ww2, ww3) + } + } + }}] +bar + = \ (@a) + (@b) + ($d~ :: a ~ b) + ($dShow :: Show a) + (eta :: Int) + (eta1 :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2, ww3 #) -> + (ww2, ww3) + } + } + } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -93,3 +93,4 @@ test('T22039', normal, compile, ['']) test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) # T22997: Just a panic that should not happen test('T22997', normal, compile, ['']) +test('T23398', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds']) ===================================== testsuite/tests/th/T8333.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be74f9346ef73eb4d5156ecb58f0e9e59f369b18...48e9aa20863d612a341ebf8076865765611a71d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be74f9346ef73eb4d5156ecb58f0e9e59f369b18...48e9aa20863d612a341ebf8076865765611a71d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 16:46:03 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 18 May 2023 12:46:03 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Documentation changes only Message-ID: <6466564bcd618_9760ab24e1443370ce@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 84258bdc by Simon Peyton Jones at 2023-05-18T17:47:47+01:00 Documentation changes only - - - - - 2 changed files: - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Solver/Dict.hs Changes: ===================================== compiler/GHC/Tc/Errors/Hole.hs ===================================== @@ -989,7 +989,7 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $ -> do { traceTc "}" empty ; return (True, wrap) } - | checkInsoluble wanted + | checkInsoluble wanted -- See Note [Fast path for tcCheckHoleFit] -> return (False, wrap) | otherwise @@ -1001,7 +1001,7 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $ -- Note [Checking hole fits] ; let wrapInImpls cts = foldl (flip (setWCAndBinds fresh_binds)) cts th_implics final_wc = wrapInImpls $ addSimples wanted $ - mapBag mkNonCanonical cloned_relevants + mapBag mkNonCanonical cloned_relevants -- We add the cloned relevants to the wanteds generated -- by the call to tcSubType_NC, for details, see -- Note [Relevant constraints]. There's no need to clone @@ -1022,7 +1022,26 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $ setWCAndBinds binds imp wc = mkImplicWC $ unitBag $ imp { ic_wanted = wc , ic_binds = binds } +{- Note [Fast path for tcCheckHoleFit] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In `tcCheckHoleFit` we compare (with `tcSubTypeSigma`) the type of the hole +with the type of zillions of in-scope functions, to see which would "fit". +Most of these checks fail! They generate obviously-insoluble constraints. +For these very-common cases we don't want to crank up the full constraint +solver. It's much more efficient to do a quick-and-dirty check for insolubility. + +Now, `tcSubTypeSigma` uses the on-the-fly unifier in GHC.Tc.Utils.Unify, +it has already done the dirt-simple unification. So our quick-and-dirty +check can simply look for constraints like (Int ~ Bool). We don't need +to worry about (Maybe Int ~ Maybe Bool). + +The quick-and-dirty check is in `checkInsoluble`. It can make a big +difference: For test hard_hole_fits, compile-time allocation goes down by 37%! +-} + + checkInsoluble :: WantedConstraints -> Bool +-- See Note [Fast path for tcCheckHoleFit] checkInsoluble (WC { wc_simple = simples }) = any is_insol simples where @@ -1031,6 +1050,8 @@ checkInsoluble (WC { wc_simple = simples }) _ -> False definitelyNotEqual :: Role -> TcType -> TcType -> Bool +-- See Note [Fast path for tcCheckHoleFit] +-- Specifically, does not need to recurse under type constructors definitelyNotEqual r t1 t2 = go t1 t2 where @@ -1048,4 +1069,4 @@ definitelyNotEqual r t1 t2 go_tc tc1 (TyConApp tc2 _) | isGenerativeTyCon tc2 r = tc1 /= tc2 go_tc _ (FunTy {}) = True go_tc _ (ForAllTy {}) = True - go_tc _ _ = False \ No newline at end of file + go_tc _ _ = False ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -298,6 +298,87 @@ I can think of two ways to fix this: * * ****************************************************************************** -} +{- Note [Solving equality classes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (~), which behaves as if it was defined like this: + class a ~# b => a ~ b + instance a ~# b => a ~ b +There are two more similar "equality classes" like this. The full list is + * (~) eqTyCon + * (~~) heqTyCon + * Coercible coercibleTyCon +(See Note [The equality types story] in GHC.Builtin.Types.Prim.) + +(EQC1) For Givens, when expanding the superclasses of a equality class, + we can /replace/ the constraint with its superclasses (which, remember, are + equally powerful) rather than /adding/ them. This can make a huge difference. + Consider T17836, which has a constraint like + forall b,c. a ~ (b,c) => + forall d,e. c ~ (d,e) => + ...etc... + If we just /add/ the superclasses of [G] g1:a ~ (b,c), we'll put + [G] g1:(a~(b,c)) in the inert set and emit [G] g2:a ~# (b,c). That will + kick out g1, and it'll be re-inserted as [G] g1':(b,c)~(b,c) which does + no good to anyone. When the implication is deeply nested, this has + quadratic cost, and no benefit. Just replace! + + (This can have a /big/ effect: test T17836 involves deeply-nested GADT + pattern matching. Its compile-time allocation decreased by 40% when + I added the "replace" rather than "add" semantics.) + +(EQC2) Faced with [W] t1 ~ t2, it's always OK to reduce it to [W] t1 ~# t2, + without worrying about Note [Instance and Given overlap]. Why? Because + if we had [G] s1 ~ s2, then we'd get the superclass [G] s1 ~# s2, and + so the reduction of the [W] constraint does not risk losing any solutions. + + On the other hand, it can be fatal to /fail/ to reduce such equalities + on the grounds of Note [Instance and Given overlap], because many good + things flow from [W] t1 ~# t2. + +Conclusion: we have a special solver pipeline for equality-class constraints, +`solveEqualityDict`. It aggressively decomposes the boxed equality constraint +into an unboxed coercion, both for Givens and Wanteds, and /replaces/ the +boxed equality constraint with the unboxed one, so that the inert set never +contains the boxed one. + +Note [Solving tuple constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +I tried treating tuple constraints, such as (% Eq a, Show a %), rather like +equality-class constraints (see Note [Solving equality classes]). That is, by +eagerly decomposing tuple-constraints into their component (Eq a) and (Show a). + +But discarding the tuple Given (which "replacing" does) means that +we may have to reconstruct it for a recursive call, and the optimiser isn't +quite clever enough to figure that out: see #10359 and its test case; and #23398. +This is less pressing for equality classes because they have to be unpacked +strictly, so CSE-ing away the reconstruction works fine. + + +(NC2) Because of this replacement, we don't need do the fancy footwork + of Note [Solving superclass constraints], so the computation of `sc_loc` + in `mk_strict_superclasses` can be simpler. + + For tuple predicates, this matters, because their size can be large, + and we don't want to add a big class to the size of the dictionaries + in the chain. When we get down to a base predicate, we'll include + its size. See #10335 + +And less obviously to: + +* Tuple classes. For reasons described in GHC.Tc.Solver.Types + Note [Shadowing of implicit parameters], we may have a constraint + [W] (?x::Int, C a) + with an exactly-matching Given constraint. We must decompose this + tuple and solve the components separately, otherwise we won't solve + it at all! It is perfectly safe to decompose it, because again the + superclasses invert the instance; e.g. + class (c1, c2) => (% c1, c2 %) + instance (c1, c2) => (% c1, c2 %) + Example in #14218 + +Examples: T5853, T10432, T5315, T9222, T2627b, T3028b +-} + solveEqualityDict :: CtEvidence -> Class -> [Type] -> SolverStage Void -- Precondition: (isEqualityClass cls) True, so cls is (~), (~~), or Coercible solveEqualityDict ev cls tys View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84258bdcc5ca417b58aaeb8dc2058b42e3ca0e65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84258bdcc5ca417b58aaeb8dc2058b42e3ca0e65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 17:39:15 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Thu, 18 May 2023 13:39:15 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] 3 commits: Add OR and ORI instructions Message-ID: <646662c3d1da6_9760ab41e654343186@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 4f22557e by Sven Tennie at 2023-05-18T18:07:30+02:00 Add OR and ORI instructions ORR doesn't exist on RISCV. OR with register load is used when the immediate is too big for ORI (i.e. >12bits.) - - - - - b877aa85 by Sven Tennie at 2023-05-18T18:09:52+02:00 Refine TODO comment: Stack frame header size is 2 * 8 byte The stack frame header should contain two registers: ra and previous fp - - - - - c8c7bce6 by Sven Tennie at 2023-05-18T19:36:56+02:00 Fix MOV with immediate There are three cases: - Fits in a 12bit immediate slot -> ADDI - Fits in 32bit -> %hi / %lo piecewise loading - Else: Let the assembler solve this issue for now, LI - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -762,8 +762,8 @@ getRegister' config plat expr where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> - return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) + CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | fitsIn12bitImm n -> + return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORI (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg @@ -932,7 +932,7 @@ getRegister' config plat expr -- Bitwise operations MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) - MO_Or w -> bitOp w (\d x y -> unitOL $ ORR d x y) + MO_Or w -> bitOp w (\d x y -> unitOL $ OR d x y) MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y) MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) @@ -1070,12 +1070,6 @@ getAmode _platform _ expr = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrReg reg) code -fitsIn12bitImm :: (Num a, Ord a) => a -> Bool -fitsIn12bitImm off = off >= intMin12bit && off <= intMax12bit - where - intMin12bit = -2048 - intMax12bit = 2047 - -- ----------------------------------------------------------------------------- -- Generating assignments ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -32,7 +32,7 @@ import Data.Maybe (fromMaybe) import GHC.Stack --- | TODO: verify this! +-- | TODO: Should be `2 * spillSlotSize = 16` stackFrameHeaderSize :: Platform -> Int stackFrameHeaderSize _ = 64 @@ -102,6 +102,7 @@ regUsageOfInstr platform instr = case instr of UXTH dst src -> usage (regOp src, regOp dst) -- 3. Logical and Move Instructions ------------------------------------------ AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + OR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) ASR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BIC dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BICS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -112,7 +113,8 @@ regUsageOfInstr platform instr = case instr of MOV dst src -> usage (regOp src, regOp dst) MOVK dst src -> usage (regOp src, regOp dst) MVN dst src -> usage (regOp src, regOp dst) - ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- ORI's third operand is always an immediate + ORI dst src1 _ -> usage (regOp src1, regOp dst) ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) TST src1 src2 -> usage (regOp src1 ++ regOp src2, []) -- 4. Branch Instructions ---------------------------------------------------- @@ -241,6 +243,7 @@ patchRegsOfInstr instr env = case instr of -- 3. Logical and Move Instructions ---------------------------------------- AND o1 o2 o3 -> AND (patchOp o1) (patchOp o2) (patchOp o3) + OR o1 o2 o3 -> OR (patchOp o1) (patchOp o2) (patchOp o3) -- ANDS o1 o2 o3 -> ANDS (patchOp o1) (patchOp o2) (patchOp o3) ASR o1 o2 o3 -> ASR (patchOp o1) (patchOp o2) (patchOp o3) BIC o1 o2 o3 -> BIC (patchOp o1) (patchOp o2) (patchOp o3) @@ -252,7 +255,8 @@ patchRegsOfInstr instr env = case instr of MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2) MVN o1 o2 -> MVN (patchOp o1) (patchOp o2) - ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3) + -- o3 cannot be a register for ORI (always an immediate) + ORI o1 o2 o3 -> ORI (patchOp o1) (patchOp o2) (patchOp o3) ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3) TST o1 o2 -> TST (patchOp o1) (patchOp o2) @@ -647,7 +651,7 @@ data Instr -- | MOVZ Operand Operand | MVN Operand Operand -- rd = ~rn | ORN Operand Operand Operand -- rd = rn | ~op2 - | ORR Operand Operand Operand -- rd = rn | op2 + | ORI Operand Operand Operand -- rd = rn | op2 | ROR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits | TST Operand Operand -- rn & op2 -- Load and stores. @@ -700,6 +704,7 @@ instrCon i = PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME" POP_STACK_FRAME{} -> "POP_STACK_FRAME" ADD{} -> "ADD" + OR{} -> "OR" -- CMN{} -> "CMN" -- CMP{} -> "CMP" MSUB{} -> "MSUB" @@ -727,7 +732,7 @@ instrCon i = MOVK{} -> "MOVK" MVN{} -> "MVN" ORN{} -> "ORN" - ORR{} -> "ORR" + ORI{} -> "ORI" ROR{} -> "ROR" TST{} -> "TST" STR{} -> "STR" @@ -892,3 +897,12 @@ opRegSExt W32 r = OpRegExt W32 r ESXTW 0 opRegSExt W16 r = OpRegExt W16 r ESXTH 0 opRegSExt W8 r = OpRegExt W8 r ESXTB 0 opRegSExt w _r = pprPanic "opRegSExt" (ppr w) + +fitsIn12bitImm :: (Num a, Ord a) => a -> Bool +fitsIn12bitImm off = off >= intMin12bit && off <= intMax12bit + where + intMin12bit = -2048 + intMax12bit = 2047 + +fitsIn32bits :: (Num a, Ord a, Bits a) => a -> Bool +fitsIn32bits i = (-1 `shiftL` 31) <= i && i <= (1 `shiftL` 31 -1) ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -493,6 +493,7 @@ pprInstr platform instr = case instr of -- 3. Logical and Move Instructions ------------------------------------------ AND o1 o2 o3 -> op3 (text "\tand") o1 o2 o3 + OR o1 o2 o3 -> op3 (text "\tor") o1 o2 o3 -- ANDS o1 o2 o3 -> op3 (text "\tands") o1 o2 o3 ASR o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3 BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3 @@ -505,18 +506,21 @@ pprInstr platform instr = case instr of | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2 | isImmOp o2 , (OpImm (ImmInteger i)) <- o2 - , (-1 `shiftL` 11) <= i - , i <= (1 `shiftL` 11 - 1) -> lines_ [ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2 ] + , fitsIn12bitImm i + -> lines_ [ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2 ] | isImmOp o2 , (OpImm (ImmInteger i)) <- o2 - , (-1 `shiftL` 31) <= i - , i <= (1 `shiftL` 31 -1) -> lines_ [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")" + , fitsIn32bits i + -> lines_ [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")" , text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%lo(" <> pprOp platform o2 <> text ")" ] + | isImmOp o2 + -- Surrender! Let the assembler figure out the right expressions with pseudo-op LI. + -> lines_ [ text "\tli" <+> pprOp platform o1 <> comma <+> pprOp platform o2 ] | otherwise -> op3 (text "\taddi") o1 o2 (OpImm (ImmInt 0)) MOVK o1 o2 -> op2 (text "\tmovk") o1 o2 MVN o1 o2 -> op2 (text "\tmvn") o1 o2 ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 - ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3 + ORI o1 o2 o3 -> op3 (text "\tori") o1 o2 o3 ROR o1 o2 o3 -> op3 (text "\tror") o1 o2 o3 TST o1 o2 -> op2 (text "\ttst") o1 o2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce78097cd4100df76443b8a68ed192f987aa44fe...c8c7bce64d94afd5cf57f7e8f7eae3d1d664eb3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce78097cd4100df76443b8a68ed192f987aa44fe...c8c7bce64d94afd5cf57f7e8f7eae3d1d664eb3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 19:19:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 May 2023 15:19:20 -0400 Subject: [Git][ghc/ghc][master] 5 commits: base: Add test for #13660 Message-ID: <64667a38b34ed_9760ab41e6543536a4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7 changed files: - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - + libraries/base/tests/T13660.hs - + libraries/base/tests/T13660.stdout - libraries/base/tests/all.T Changes: ===================================== libraries/base/GHC/Foreign.hs ===================================== @@ -21,312 +21,22 @@ module GHC.Foreign ( -- * C strings with a configurable encoding CString, CStringLen, - -- conversion of C strings into Haskell strings - -- + -- * Conversion of C strings into Haskell strings peekCString, peekCStringLen, - -- conversion of Haskell strings into C strings - -- + -- * Conversion of Haskell strings into C strings newCString, newCStringLen, + newCStringLen0, - -- conversion of Haskell strings into C strings using temporary storage - -- + -- * Conversion of Haskell strings into C strings using temporary storage withCString, withCStringLen, + withCStringLen0, withCStringsLen, charIsRepresentable, ) where -import Foreign.Marshal.Array -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Storable - -import Data.Word - --- Imports for the locale-encoding version of marshallers - -import Data.Tuple (fst) - -import GHC.Show ( show ) - -import Foreign.Marshal.Alloc -import Foreign.ForeignPtr - -import GHC.Debug -import GHC.List -import GHC.Num -import GHC.Base - -import GHC.IO -import GHC.IO.Exception -import GHC.IO.Buffer -import GHC.IO.Encoding.Types - - -c_DEBUG_DUMP :: Bool -c_DEBUG_DUMP = False - -putDebugMsg :: String -> IO () -putDebugMsg | c_DEBUG_DUMP = debugLn - | otherwise = const (return ()) - - --- | A C string is a reference to an array of C characters terminated by NUL. -type CString = Ptr CChar - --- | A string with explicit length information in bytes instead of a --- terminating NUL (allowing NUL characters in the middle of the string). -type CStringLen = (Ptr CChar, Int) - --- exported functions --- ------------------ - --- | Marshal a NUL terminated C string into a Haskell string. --- -peekCString :: TextEncoding -> CString -> IO String -peekCString enc cp = do - sz <- lengthArray0 nUL cp - peekEncodedCString enc (cp, sz * cCharSize) - --- | Marshal a C string with explicit length into a Haskell string. --- -peekCStringLen :: TextEncoding -> CStringLen -> IO String -peekCStringLen = peekEncodedCString - --- | Marshal a Haskell string into a NUL terminated C string. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCString :: TextEncoding -> String -> IO CString -newCString enc = liftM fst . newEncodedCString enc True - --- | Marshal a Haskell string into a C string (ie, character array) with --- explicit length information. --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCStringLen :: TextEncoding -> String -> IO CStringLen -newCStringLen enc = newEncodedCString enc False - --- | Marshal a Haskell string into a NUL terminated C string using temporary --- storage. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a -withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp - --- | Marshal a Haskell string into a C string (ie, character array) --- in temporary storage, with explicit length information. --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a -withCStringLen enc = withEncodedCString enc False - --- | Marshal a list of Haskell strings into an array of NUL terminated C strings --- using temporary storage. --- --- * the Haskell strings may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringsLen :: TextEncoding - -> [String] - -> (Int -> Ptr CString -> IO a) - -> IO a -withCStringsLen enc strs f = go [] strs - where - go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss - go cs [] = withArrayLen (reverse cs) f - --- | Determines whether a character can be accurately encoded in a --- 'Foreign.C.String.CString'. --- --- Pretty much anyone who uses this function is in a state of sin because --- whether or not a character is encodable will, in general, depend on the --- context in which it occurs. -charIsRepresentable :: TextEncoding -> Char -> IO Bool --- We force enc explicitly because `catch` is lazy in its --- first argument. We would probably like to force c as well, --- but unfortunately worker/wrapper produces very bad code for --- that. --- --- TODO If this function is performance-critical, it would probably --- pay to use a single-character specialization of withCString. That --- would allow worker/wrapper to actually eliminate Char boxes, and --- would also get rid of the completely unnecessary cons allocation. -charIsRepresentable !enc c = - withCString enc [c] - (\cstr -> do str <- peekCString enc cstr - case str of - [ch] | ch == c -> pure True - _ -> pure False) - `catch` - \(_ :: IOException) -> pure False - --- auxiliary definitions --- ---------------------- - --- C's end of string character -nUL :: CChar -nUL = 0 - --- Size of a CChar in bytes -cCharSize :: Int -cCharSize = sizeOf (undefined :: CChar) - - -{-# INLINE peekEncodedCString #-} -peekEncodedCString :: TextEncoding -- ^ Encoding of CString - -> CStringLen - -> IO String -- ^ String in Haskell terms -peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) - = bracket mk_decoder close $ \decoder -> do - let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII - !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) - !to <- newCharBuffer chunk_size WriteBuffer - - let go !iteration !from = do - (why, from', !to') <- encode decoder from to - if isEmptyBuffer from' - then - -- No input remaining: @why@ will be InputUnderflow, but we don't care - withBuffer to' $ peekArray (bufferElems to') - else do - -- Input remaining: what went wrong? - putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) - (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because - InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input - OutputUnderflow -> return (from', to') -- We will have more space next time round - putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') - putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') - to_chars <- withBuffer to'' $ peekArray (bufferElems to'') - fmap (to_chars++) $ go (iteration + 1) from'' - - go (0 :: Int) from0 - -{-# INLINE withEncodedCString #-} -withEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory - -> IO a -withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_sz_bytes = do - putDebugMsg ("withEncodedCString: " ++ show iteration) - allocaBytes to_sz_bytes $ \to_p -> do - -- See Note [Check *before* fill in withEncodedCString] about why - -- this is subtle. - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> go (iteration + 1) (to_sz_bytes * 2) - Just to_buf -> withCStringBuffer to_buf null_terminate act - - -- If the input string is ASCII, this value will ensure we only allocate once - go (0 :: Int) (cCharSize * (sz + 1)) - -withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r -withCStringBuffer to_buf null_terminate act = do - let bytes = bufferElems to_buf - withBuffer to_buf $ \to_ptr -> do - when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 - act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* - -{-# INLINE newEncodedCString #-} -newEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> IO CStringLen -newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_p to_sz_bytes = do - putDebugMsg ("newEncodedCString: " ++ show iteration) - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> do - let to_sz_bytes' = to_sz_bytes * 2 - to_p' <- reallocBytes to_p to_sz_bytes' - go (iteration + 1) to_p' to_sz_bytes' - Just to_buf -> withCStringBuffer to_buf null_terminate return - - -- If the input string is ASCII, this value will ensure we only allocate once - let to_sz_bytes = cCharSize * (sz + 1) - to_p <- mallocBytes to_sz_bytes - go (0 :: Int) to_p to_sz_bytes - - -tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int - -> IO (Maybe (Buffer Word8)) -tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do - !to_fp <- newForeignPtr_ to_p - go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) - where - go !iteration !from !to = do - (why, from', to') <- encode encoder from to - putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') - if isEmptyBuffer from' - then if null_terminate && bufferAvailable to' == 0 - then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer - else return (Just to') - else case why of -- We didn't consume all of the input - InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad - InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid - OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more -{- -Note [Check *before* fill in withEncodedCString] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's very important that the size check and readjustment peformed by tryFillBuffer -happens before the continuation is called. The size check is the part which can -fail, the call to the continuation never fails and so the caller should respond -first to the size check failing and *then* call the continuation. Making this evident -to the compiler avoids historic space leaks. - -In a previous iteration of this code we had a pattern that, somewhat simplified, -looked like this: - -go :: State -> (State -> IO a) -> IO a -go state action = - case tryFillBufferAndCall state action of - Left state' -> go state' action - Right result -> result - -`tryFillBufferAndCall` performed some checks, and then we either called action, -or we modified the state and tried again. -This went wrong because `action` can be a function closure containing a reference to -a lazy data structure. If we call action directly, without retaining any references -to action, that is fine. The data structure is consumed as it is produced and we operate -in constant space. - -However the failure branch `go state' action` *does* capture a reference to action. -This went wrong because the reference to action in the failure branch only becomes -unreachable *after* action returns. This means we keep alive the function closure -for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list -via `action` until the action has fully run. -This went wrong in #20107, where the continuation kept an entire lazy bytestring alive -rather than allowing it to be incrementally consumed and collected. --} - +import GHC.Foreign.Internal ===================================== libraries/base/GHC/Foreign/Internal.hs ===================================== @@ -0,0 +1,357 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Foreign.Internal +-- Copyright : (c) The University of Glasgow, 2008-2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : libraries at haskell.org +-- Stability : internal +-- Portability : non-portable +-- +-- Foreign marshalling support for CStrings with configurable encodings +-- +----------------------------------------------------------------------------- + +module GHC.Foreign.Internal ( + -- * C strings with a configurable encoding + CString, CStringLen, + + -- * Conversion of C strings into Haskell strings + peekCString, + peekCStringLen, + + -- * Conversion of Haskell strings into C strings + newCString, + newCStringLen, + newCStringLen0, + + -- * Conversion of Haskell strings into C strings using temporary storage + withCString, + withCStringLen, + withCStringLen0, + withCStringsLen, + + charIsRepresentable, + ) where + +import Foreign.Marshal.Array +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable + +import Data.Word + +-- Imports for the locale-encoding version of marshallers + +import Data.Tuple (fst) + +import GHC.Show ( show ) + +import Foreign.Marshal.Alloc +import Foreign.ForeignPtr + +import GHC.Debug +import GHC.List +import GHC.Num +import GHC.Base + +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Buffer +import GHC.IO.Encoding.Types + + +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False + +putDebugMsg :: String -> IO () +putDebugMsg | c_DEBUG_DUMP = debugLn + | otherwise = const (return ()) + + +-- | A C string is a reference to an array of C characters terminated by NUL. +type CString = Ptr CChar + +-- | A string with explicit length information in bytes instead of a +-- terminating NUL (allowing NUL characters in the middle of the string). +type CStringLen = (Ptr CChar, Int) + +-- exported functions +-- ------------------ + +-- | Marshal a NUL terminated C string into a Haskell string. +-- +peekCString :: TextEncoding -> CString -> IO String +peekCString enc cp = do + sz <- lengthArray0 nUL cp + peekEncodedCString enc (cp, sz * cCharSize) + +-- | Marshal a C string with explicit length into a Haskell string. +-- +peekCStringLen :: TextEncoding -> CStringLen -> IO String +peekCStringLen = peekEncodedCString + +-- | Marshal a Haskell string into a NUL terminated C string. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCString :: TextEncoding -> String -> IO CString +newCString enc = liftM fst . newEncodedCString enc True + +-- | Marshal a Haskell string into a C string (ie, character array) with +-- explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCStringLen :: TextEncoding -> String -> IO CStringLen +newCStringLen enc = newEncodedCString enc False + +-- | Marshal a Haskell string into a NUL terminated C string using temporary +-- storage. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a +withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp + +-- | Marshal a Haskell string into a C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen enc = withEncodedCString enc False + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- with explicit length information. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +-- @since 4.19.0.0 +newCStringLen0 :: TextEncoding -> String -> IO CStringLen +newCStringLen0 enc = newEncodedCString enc True + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +-- @since 4.19.0.0 +withCStringLen0 :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen0 enc = withEncodedCString enc True + +-- | Marshal a list of Haskell strings into an array of NUL terminated C strings +-- using temporary storage. +-- +-- * the Haskell strings may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringsLen :: TextEncoding + -> [String] + -> (Int -> Ptr CString -> IO a) + -> IO a +withCStringsLen enc strs f = go [] strs + where + go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss + go cs [] = withArrayLen (reverse cs) f + +-- | Determines whether a character can be accurately encoded in a +-- 'Foreign.C.String.CString'. +-- +-- Pretty much anyone who uses this function is in a state of sin because +-- whether or not a character is encodable will, in general, depend on the +-- context in which it occurs. +charIsRepresentable :: TextEncoding -> Char -> IO Bool +-- We force enc explicitly because `catch` is lazy in its +-- first argument. We would probably like to force c as well, +-- but unfortunately worker/wrapper produces very bad code for +-- that. +-- +-- TODO If this function is performance-critical, it would probably +-- pay to use a single-character specialization of withCString. That +-- would allow worker/wrapper to actually eliminate Char boxes, and +-- would also get rid of the completely unnecessary cons allocation. +charIsRepresentable !enc c = + withCString enc [c] + (\cstr -> do str <- peekCString enc cstr + case str of + [ch] | ch == c -> pure True + _ -> pure False) + `catch` + \(_ :: IOException) -> pure False + +-- auxiliary definitions +-- ---------------------- + +-- C's end of string character +nUL :: CChar +nUL = 0 + +-- Size of a CChar in bytes +cCharSize :: Int +cCharSize = sizeOf (undefined :: CChar) + + +{-# INLINE peekEncodedCString #-} +peekEncodedCString :: TextEncoding -- ^ Encoding of CString + -> CStringLen + -> IO String -- ^ String in Haskell terms +peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) + = bracket mk_decoder close $ \decoder -> do + let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII + !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) + !to <- newCharBuffer chunk_size WriteBuffer + + let go !iteration !from = do + (why, from', !to') <- encode decoder from to + if isEmptyBuffer from' + then + -- No input remaining: @why@ will be InputUnderflow, but we don't care + withBuffer to' $ peekArray (bufferElems to') + else do + -- Input remaining: what went wrong? + putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) + (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because + InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input + OutputUnderflow -> return (from', to') -- We will have more space next time round + putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') + putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') + to_chars <- withBuffer to'' $ peekArray (bufferElems to'') + fmap (to_chars++) $ go (iteration + 1) from'' + + go (0 :: Int) from0 + +{-# INLINE withEncodedCString #-} +withEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory + -> IO a +withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_sz_bytes = do + putDebugMsg ("withEncodedCString: " ++ show iteration) + allocaBytes to_sz_bytes $ \to_p -> do + -- See Note [Check *before* fill in withEncodedCString] about why + -- this is subtle. + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> go (iteration + 1) (to_sz_bytes * 2) + Just to_buf -> withCStringBuffer to_buf null_terminate act + + -- If the input string is ASCII, this value will ensure we only allocate once + go (0 :: Int) (cCharSize * (sz + 1)) + +withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r +withCStringBuffer to_buf null_terminate act = do + let bytes = bufferElems to_buf + withBuffer to_buf $ \to_ptr -> do + when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 + act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* + +{-# INLINE newEncodedCString #-} +newEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> IO CStringLen +newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_p to_sz_bytes = do + putDebugMsg ("newEncodedCString: " ++ show iteration) + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> do + let to_sz_bytes' = to_sz_bytes * 2 + to_p' <- reallocBytes to_p to_sz_bytes' + go (iteration + 1) to_p' to_sz_bytes' + Just to_buf -> withCStringBuffer to_buf null_terminate return + + -- If the input string is ASCII, this value will ensure we only allocate once + let to_sz_bytes = cCharSize * (sz + 1) + to_p <- mallocBytes to_sz_bytes + go (0 :: Int) to_p to_sz_bytes + + +tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int + -> IO (Maybe (Buffer Word8)) +tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do + !to_fp <- newForeignPtr_ to_p + go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) + where + go !iteration !from !to = do + (why, from', to') <- encode encoder from to + putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') + if isEmptyBuffer from' + then if null_terminate && bufferAvailable to' == 0 + then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer + else return (Just to') + else case why of -- We didn't consume all of the input + InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad + InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid + OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more +{- +Note [Check *before* fill in withEncodedCString] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's very important that the size check and readjustment peformed by tryFillBuffer +happens before the continuation is called. The size check is the part which can +fail, the call to the continuation never fails and so the caller should respond +first to the size check failing and *then* call the continuation. Making this evident +to the compiler avoids historic space leaks. + +In a previous iteration of this code we had a pattern that, somewhat simplified, +looked like this: + +go :: State -> (State -> IO a) -> IO a +go state action = + case tryFillBufferAndCall state action of + Left state' -> go state' action + Right result -> result + +`tryFillBufferAndCall` performed some checks, and then we either called action, +or we modified the state and tried again. +This went wrong because `action` can be a function closure containing a reference to +a lazy data structure. If we call action directly, without retaining any references +to action, that is fine. The data structure is consumed as it is produced and we operate +in constant space. + +However the failure branch `go state' action` *does* capture a reference to action. +This went wrong because the reference to action in the failure branch only becomes +unreachable *after* action returns. This means we keep alive the function closure +for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list +via `action` until the action has fully run. +This went wrong in #20107, where the continuation kept an entire lazy bytestring alive +rather than allowing it to be incrementally consumed and collected. +-} + ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -34,7 +34,6 @@ import System.Posix.Types import Foreign import Foreign.C --- import Data.Bits import Data.Maybe #if !defined(HTYPE_TCFLAG_T) @@ -51,6 +50,9 @@ import GHC.IO.Device #if !defined(mingw32_HOST_OS) import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC +import GHC.Ptr +#else +import Data.OldList (elem) #endif -- --------------------------------------------------------------------------- @@ -164,13 +166,23 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) + #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +190,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen0 enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen0 enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff ===================================== libraries/base/base.cabal ===================================== @@ -351,6 +351,7 @@ Library GHC.Event.IntVar GHC.Event.PSQ GHC.Event.Unique + GHC.Foreign.Internal -- GHC.IOPort -- TODO: hide again after debug GHC.Unicode.Internal.Bits GHC.Unicode.Internal.Char.DerivedCoreProperties ===================================== libraries/base/tests/T13660.hs ===================================== @@ -0,0 +1,11 @@ +-- | This should print an InvalidArgument error complaining that +-- the file path contains a NUL octet. +module Main where + +import System.IO.Error + +main :: IO () +main = do + catchIOError + (writeFile "hello\x00world" "hello") + print ===================================== libraries/base/tests/T13660.stdout ===================================== Binary files /dev/null and b/libraries/base/tests/T13660.stdout differ ===================================== libraries/base/tests/all.T ===================================== @@ -256,6 +256,7 @@ test('T13191', ['-O']) test('T13525', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) +test('T13660', when(opsys('mingw32'), skip), compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) test('T3474', [collect_stats('max_bytes_used',5), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/385edb65878d9963ea0406887649f7312c188c57...b98d99cc1642e3bba7968e7c9993098538d9491d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/385edb65878d9963ea0406887649f7312c188c57...b98d99cc1642e3bba7968e7c9993098538d9491d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 19:19:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 May 2023 15:19:48 -0400 Subject: [Git][ghc/ghc][master] Allow the demand analyser to unpack tuple and equality dictionaries Message-ID: <64667a544d06f_9760ab616c403575cc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - 6 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - testsuite/tests/indexed-types/should_compile/T7837.stderr - + testsuite/tests/stranal/should_compile/T23398.hs - + testsuite/tests/stranal/should_compile/T23398.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -16,37 +16,41 @@ where import GHC.Prelude -import GHC.Core.Opt.WorkWrap.Utils import GHC.Types.Demand -- All of it + import GHC.Core -import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Utils.Outputable -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic -import Data.List ( mapAccumL ) import GHC.Core.DataCon -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Predicate( isClassPred ) +import GHC.Core.Predicate( isEqualityClass, isCTupleClass ) import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain +import GHC.Core.Opt.WorkWrap.Utils + import GHC.Builtin.PrimOps import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) + import GHC.Types.Unique.Set import GHC.Types.Unique.MemoFun import GHC.Types.RepType +import GHC.Types.ForeignCall ( isSafeForeignCall ) +import GHC.Types.Id +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Outputable + +import Data.List ( mapAccumL ) {- ************************************************************************ @@ -1499,7 +1503,7 @@ bounds-checking. So we want to give `indexError` a signature like `<1!P(!S,!S)><1!S>b` where the !S (meaning Poly Unboxed C1N) says that the polymorphic arguments -are unboxed (recursively). The wrapper for `indexError` won't /acutally/ +are unboxed (recursively). The wrapper for `indexError` won't /actually/ unbox them (because their polymorphic type doesn't allow that) but when demand-analysing /callers/, we'll behave as if that call needs the args unboxed. @@ -1782,39 +1786,6 @@ applying the strictness demands to the final result of DmdAnal. The result is that we get the strict demand signature we wanted even if we can't float the case on `x` up through the case on `burble`. -Note [Do not unbox class dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never unbox class dictionaries in worker/wrapper. - -1. INLINABLE functions - If we have - f :: Ord a => [a] -> Int -> a - {-# INLINABLE f #-} - and we worker/wrapper f, we'll get a worker with an INLINABLE pragma - (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), - which can still be specialised by the type-class specialiser, something like - fw :: Ord a => [a] -> Int# -> a - - BUT if f is strict in the Ord dictionary, we might unpack it, to get - fw :: (a->a->Bool) -> [a] -> Int# -> a - and the type-class specialiser can't specialise that. An example is #6056. - - Historical note: #14955 describes how I got this fix wrong the first time. - I got aware of the issue in T5075 by the change in boxity of loop between - demand analysis runs. - -2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur - occur without INLINABLE, when we use -fexpose-all-unfoldings and - -fspecialise-aggressively to do vigorous cross-module specialisation. - -3. #18421 found that unboxing a dictionary can also make the worker less likely - to inline; the inlining heuristics seem to prefer to inline a function - applied to a dictionary over a function applied to a bunch of functions. - -TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing -a raft of higher-order functions isn't a huge win anyway -- you really want to -specialise the function. - Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of @@ -1998,22 +1969,13 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take threshold_arity $ - [ (bndr_ty, NotMarkedStrict, get_dmd bndr bndr_ty) - | bndr <- bndrs - , isRuntimeVar bndr, let bndr_ty = idType bndr ] - - get_dmd :: Id -> Type -> Demand - get_dmd bndr bndr_ty - | isClassPred bndr_ty = trimBoxity dmd - -- See Note [Do not unbox class dictionaries] - -- NB: 'ty' has not been normalised, so this will (rightly) - -- catch newtype dictionaries too. - -- NB: even for bottoming functions, don't unbox dictionaries - - | is_bot_fn = unboxDeeplyDmd dmd - -- See Note [Boxity for bottoming functions], case (B) - - | otherwise = dmd + [ (idType bndr, NotMarkedStrict, get_dmd bndr) + | bndr <- bndrs, isRuntimeVar bndr ] + + get_dmd :: Id -> Demand + get_dmd bndr + | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], + | otherwise = dmd -- case (B) where dmd = idDemandInfo bndr @@ -2119,6 +2081,12 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) -- isMarkedStrict: see Note [Unboxing evaluated arguments] in DmdAnal -> DontUnbox + | doNotUnbox ty + -> DontUnbox -- See Note [Do not unbox class dictionaries] + -- NB: 'ty' has not been normalised, so this will (rightly) + -- catch newtype dictionaries too. + -- NB: even for bottoming functions, don't unbox dictionaries + | DefinitelyRecursive <- ae_rec_dc env dc -- See Note [Which types are unboxed?] -- and Note [Demand analysis for recursive data constructors] @@ -2129,6 +2097,76 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) (dataConRepStrictness dc) dmds) + +doNotUnbox :: Type -> Bool +-- Do not unbox class dictionaries, except equality classes and tuples +-- Note [Do not unbox class dictionaries] +doNotUnbox arg_ty + = case tyConAppTyCon_maybe arg_ty of + Just tc | Just cls <- tyConClass_maybe tc + -> not (isEqualityClass cls || isCTupleClass cls) + -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] + + _ -> False + +{- Note [Do not unbox class dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never unbox class dictionaries in worker/wrapper. + +1. INLINABLE functions + If we have + f :: Ord a => [a] -> Int -> a + {-# INLINABLE f #-} + and we worker/wrapper f, we'll get a worker with an INLINABLE pragma + (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), + which can still be specialised by the type-class specialiser, something like + fw :: Ord a => [a] -> Int# -> a + + BUT if f is strict in the Ord dictionary, we might unpack it, to get + fw :: (a->a->Bool) -> [a] -> Int# -> a + and the type-class specialiser can't specialise that. An example is #6056. + + Historical note: #14955 describes how I got this fix wrong the first time. + I got aware of the issue in T5075 by the change in boxity of loop between + demand analysis runs. + +2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur + occur without INLINABLE, when we use -fexpose-all-unfoldings and + -fspecialise-aggressively to do vigorous cross-module specialisation. + +3. #18421 found that unboxing a dictionary can also make the worker less likely + to inline; the inlining heuristics seem to prefer to inline a function + applied to a dictionary over a function applied to a bunch of functions. + +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing +a raft of higher-order functions isn't a huge win anyway -- you really want to +specialise the function. + +Wrinkle (DNB1): we /do/ want to unbox tuple dictionaries (#23398) + f :: (% Eq a, Show a %) => blah + with -fdicts-strict it is great to unbox to + $wf :: Eq a => Show a => blah + (where I have written out the currying explicitly). Now we can specialise + $wf on the Eq or Show dictionary. Nothing is lost. + + And something is gained. It is possible that `f` will look like this: + f = /\a. \d:(% Eq a, Show a %). ... f @a (% sel1 d, sel2 d %)... + where there is a recurive call to `f`, or to another function that takes the + same tuple dictionary, but where the tuple is built from the components of + `d`. The Simplier does not fix this. But if we unpacked the dictionary + we'd get + $wf = /\a. \(d1:Eq a) (d2:Show a). let d = (% d1, d2 %) + in ...f @a (% sel1 d, sel2 d %) + and all the tuple building and taking apart will disappear. + +Wrinkle (DNB2): we /do/ wnat to unbox equality dictionaries, + for (~), (~~), and Coercible (#23398). Their payload is a single unboxed + coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is + to make a copy of the function's RHS with a particular coercion. Unlike + normal class methods, that does not unlock any new optimisation + opportunities in the specialised RHS. +-} + {- ********************************************************************* * * Fixpoints ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqPredClass, isCTupleClass, isEqualityClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -219,11 +219,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -245,6 +240,20 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) +isEqPredClass :: Class -> Bool +-- True of (~) and (~~) +isEqPredClass cls = cls `hasKey` eqTyConKey + || cls `hasKey` heqTyConKey + +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + + {- ********************************************************************* * * Implicit parameters ===================================== testsuite/tests/indexed-types/should_compile/T7837.stderr ===================================== @@ -1,3 +1,4 @@ Rule fired: Class op signum (BUILTIN) Rule fired: Class op abs (BUILTIN) Rule fired: normalize/Double (T7837) +Rule fired: Class op eq_sel (BUILTIN) ===================================== testsuite/tests/stranal/should_compile/T23398.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fdicts-strict #-} +module T23398 where + +type PairDict a = (Eq a, Show a) + +foo :: PairDict a => a -> a -> String +foo x y | x==y = show x + | otherwise = show y + +-- In worker/wrapper we'd like to unbox the pair +-- but not (Eq a) and (Show a) + +bar :: (a ~ b, Show a) => Int -> a -> (b, String) +bar 0 x = (x, show x) +bar n x = bar (n-1) x ===================================== testsuite/tests/stranal/should_compile/T23398.stderr ===================================== @@ -0,0 +1,109 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 76, types: 117, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} +T23398.$wfoo [InlPrag=[2]] + :: forall {a}. (Eq a, Show a) => a -> a -> String +[GblId[StrictWorker([!, !])], + Arity=4, + Str=, + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [30 60 0 0] 120 0}] +T23398.$wfoo + = \ (@a) (ww :: Eq a) (ww1 :: Show a) (eta :: a) (eta1 :: a) -> + case == @a ww eta eta1 of { + False -> show @a ww1 eta1; + True -> show @a ww1 eta + } + +-- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/0} +foo [InlPrag=[2]] :: forall a. PairDict a => a -> a -> String +[GblId, + Arity=3, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + ($d(%,%) [Occ=Once1!] :: PairDict a) + (eta [Occ=Once1] :: a) + (eta1 [Occ=Once1] :: a) -> + case $d(%,%) of { (ww [Occ=Once1], ww1 [Occ=Once1]) -> + T23398.$wfoo @a ww ww1 eta eta1 + }}] +foo + = \ (@a) ($d(%,%) :: PairDict a) (eta :: a) (eta1 :: a) -> + case $d(%,%) of { (ww, ww1) -> T23398.$wfoo @a ww ww1 eta eta1 } + +Rec { +-- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} +T23398.$wbar [InlPrag=[2], Occ=LoopBreaker] + :: forall {a} {b}. + (a GHC.Prim.~# b, Show a) => + GHC.Prim.Int# -> a -> (# b, String #) +[GblId[StrictWorker([~, !])], + Arity=4, + Str=<1L>, + Unf=OtherCon []] +T23398.$wbar + = \ (@a) + (@b) + (ww :: a GHC.Prim.~# b) + ($dShow :: Show a) + (ww1 :: GHC.Prim.Int#) + (eta :: a) -> + case ww1 of ds { + __DEFAULT -> + T23398.$wbar + @a @b @~(ww :: a GHC.Prim.~# b) $dShow (GHC.Prim.-# ds 1#) eta; + 0# -> (# eta `cast` (Sub ww :: a ~R# b), show @a $dShow eta #) + } +end Rec } + +-- RHS size: {terms: 21, types: 32, coercions: 1, joins: 0/0} +bar [InlPrag=[2]] + :: forall a b. (a ~ b, Show a) => Int -> a -> (b, String) +[GblId, + Arity=4, + Str=<1!P(1L)>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (@b) + ($d~ [Occ=Once1!] :: a ~ b) + ($dShow [Occ=Once1] :: Show a) + (eta [Occ=Once1!] :: Int) + (eta1 [Occ=Once1] :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 [Occ=Once1] -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2 [Occ=Once1], ww3 [Occ=Once1] #) -> + (ww2, ww3) + } + } + }}] +bar + = \ (@a) + (@b) + ($d~ :: a ~ b) + ($dShow :: Show a) + (eta :: Int) + (eta1 :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2, ww3 #) -> + (ww2, ww3) + } + } + } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -93,3 +93,4 @@ test('T22039', normal, compile, ['']) test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) # T22997: Just a panic that should not happen test('T22997', normal, compile, ['']) +test('T23398', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ae45459baaa175b73437b90af5abfa1c214d6fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ae45459baaa175b73437b90af5abfa1c214d6fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 19:20:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 May 2023 15:20:26 -0400 Subject: [Git][ghc/ghc][master] Use a simpler and more portable construct in ld.ldd check Message-ID: <64667a7a77e00_9760ab80d2b03610ca@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - 1 changed file: - m4/fp_ld_supports_response_files.m4 Changes: ===================================== m4/fp_ld_supports_response_files.m4 ===================================== @@ -5,7 +5,7 @@ AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ AC_MSG_CHECKING([whether $LD supports response files]) echo 'int main(void) {return 0;}' > conftest.c "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf '%q\n' -o conftest conftest.o > args.txt + printf "-o\nconftest\nconftest.o\n" > args.txt if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 then LdSupportsResponseFiles=YES View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b53a908674bbcddf35545f63701d4f902202eb69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b53a908674bbcddf35545f63701d4f902202eb69 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 19:21:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 May 2023 15:21:10 -0400 Subject: [Git][ghc/ghc][master] Update the warning about interpreter optimizations Message-ID: <64667aa665cb3_9760a1f92ba5c3648e3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 7 changed files: - compiler/GHC/Driver/Session.hs - testsuite/tests/ghc-api/T10052/T10052.stderr - testsuite/tests/ghci.debugger/scripts/print007.stderr - testsuite/tests/ghci/should_fail/T10549.stderr - testsuite/tests/ghci/should_fail/T10549a.stderr - testsuite/tests/safeHaskell/ghci/p14.stderr - testsuite/tests/th/T8333.stderr Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3658,9 +3658,10 @@ makeDynFlagsConsistent dflags , gopt Opt_UnoptimizedCoreForInterpreter dflags , let (dflags', changed) = updOptLevelChanged 0 dflags , changed - = loop dflags' ("Optimization flags are incompatible with the " ++ - backendDescription (backend dflags) ++ - "; optimization flags ignored.") + = loop dflags' $ + "Ignoring optimization flags since they are experimental for the " ++ + backendDescription (backend dflags) ++ + ". Pass -fno-unoptimized-core-for-interpreter to enable this feature." | LinkInMemory <- ghcLink dflags , not (gopt Opt_ExternalInterpreter dflags) ===================================== testsuite/tests/ghc-api/T10052/T10052.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci.debugger/scripts/print007.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci/should_fail/T10549.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci/should_fail/T10549a.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/safeHaskell/ghci/p14.stderr ===================================== @@ -1,6 +1,6 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. :10:25: error: [GHC-39999] • No instance for ‘Num a’ arising from a use of ‘f’ ===================================== testsuite/tests/th/T8333.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd5710afaf6b8f3139a3fb0f6ab8d1be50312b58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd5710afaf6b8f3139a3fb0f6ab8d1be50312b58 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 19:21:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 18 May 2023 15:21:41 -0400 Subject: [Git][ghc/ghc][master] Remove stray dump flags in GHC.Rename.Names Message-ID: <64667ac534655_9760a1fe64d84368256@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 1 changed file: - compiler/GHC/Rename/Names.hs Changes: ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -12,8 +12,6 @@ Extracting imported and top-level names in scope {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -ddump-to-file -ddump-simpl #-} - module GHC.Rename.Names ( rnImports, getLocalNonValBinders, newRecordFieldLabel, extendGlobalRdrEnvRn, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f6dd9996f9118206b26a2c61f7caacb202e89f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f6dd9996f9118206b26a2c61f7caacb202e89f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 20:00:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 May 2023 16:00:48 -0400 Subject: [Git][ghc/ghc][wip/backports-9.6] 7 commits: Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever Message-ID: <646683f0cfb25_9760a20707a18377160@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: 48da24c9 by Simon Peyton Jones at 2023-05-18T16:00:10-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] (cherry picked from commit 902f0730b4c50f39b7767a346be324c98bf7a8a6) - - - - - 74b8e5bd by Alexis King at 2023-05-18T16:00:10-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 (cherry picked from commit d85ed900b271109185251cb0494d51048a4cf213) - - - - - 4949111f by Alexis King at 2023-05-18T16:00:10-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. (cherry picked from commit 59aa4676a49b4f9d09c1cd3cc3b47c3c54b6ed80) - - - - - 27086298 by Krzysztof Gogolewski at 2023-05-18T16:00:10-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. (cherry picked from commit d683b2e5b91a39a2bf16796f5800f605a0281004) - - - - - 5bd85c7d by Ben Gamari at 2023-05-18T16:00:10-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. (cherry picked from commit c6cf9433e3d41e239265eaeff0fd02e6b45d5427) - - - - - 7607986e by sheaf at 2023-05-18T16:00:10-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 (cherry picked from commit c176ad1835ccfe55e2bde875b4a35e9d226ff657) - - - - - eaadcaa7 by Ryan Scott at 2023-05-18T16:00:10-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. (cherry picked from commit e8b72ff6e4aee1f889a9168df57bb1b00168fd21) - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Type.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Types/Id/Make.hs - hadrian/bindist/Makefile - hadrian/src/Settings/Builders/SplitSections.hs - rts/Disassembler.c - rts/Interpreter.c - rts/Printer.c - rts/StgMiscClosures.cmm - rts/include/rts/Bytecodes.h - rts/include/stg/MiscClosures.h - + testsuite/tests/deriving/should_compile/T23329.hs - + testsuite/tests/deriving/should_compile/T23329_M.hs - testsuite/tests/deriving/should_compile/all.T - + testsuite/tests/ghci/should_run/T22958a.hs - + testsuite/tests/ghci/should_run/T22958a.stdout - + testsuite/tests/ghci/should_run/T22958b.hs - + testsuite/tests/ghci/should_run/T22958b.stdout - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/simplCore/should_compile/T23307.hs - + testsuite/tests/simplCore/should_compile/T23307.stderr - + testsuite/tests/simplCore/should_compile/T23307a.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/572b711a0d994361a06c0595dbe0698f16100481...eaadcaa7ca2b7bb1d4d214339092dd9e6df12a96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/572b711a0d994361a06c0595dbe0698f16100481...eaadcaa7ca2b7bb1d4d214339092dd9e6df12a96 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 20:02:23 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 18 May 2023 16:02:23 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 10 commits: base: Add test for #13660 Message-ID: <6466844fb10bd_9760a200dba7c37769@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - dbf8b2b1 by Finley McIlwaine at 2023-05-18T20:02:12+00:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Update Haddock submodule - - - - - 25 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Names.hs - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - + libraries/base/tests/T13660.hs - + libraries/base/tests/T13660.stdout - libraries/base/tests/all.T - m4/fp_ld_supports_response_files.m4 - testsuite/tests/ghc-api/T10052/T10052.stderr - testsuite/tests/ghci.debugger/scripts/print007.stderr - testsuite/tests/ghci/should_fail/T10549.stderr - testsuite/tests/ghci/should_fail/T10549a.stderr - testsuite/tests/indexed-types/should_compile/T7837.stderr - testsuite/tests/safeHaskell/ghci/p14.stderr - + testsuite/tests/stranal/should_compile/T23398.hs - + testsuite/tests/stranal/should_compile/T23398.stderr - testsuite/tests/stranal/should_compile/all.T - testsuite/tests/th/T8333.stderr - utils/haddock Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -16,37 +16,41 @@ where import GHC.Prelude -import GHC.Core.Opt.WorkWrap.Utils import GHC.Types.Demand -- All of it + import GHC.Core -import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Utils.Outputable -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic -import Data.List ( mapAccumL ) import GHC.Core.DataCon -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Predicate( isClassPred ) +import GHC.Core.Predicate( isEqualityClass, isCTupleClass ) import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.FamInstEnv import GHC.Core.Opt.Arity ( typeArity ) -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain +import GHC.Core.Opt.WorkWrap.Utils + import GHC.Builtin.PrimOps import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) + import GHC.Types.Unique.Set import GHC.Types.Unique.MemoFun import GHC.Types.RepType +import GHC.Types.ForeignCall ( isSafeForeignCall ) +import GHC.Types.Id +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Outputable + +import Data.List ( mapAccumL ) {- ************************************************************************ @@ -1499,7 +1503,7 @@ bounds-checking. So we want to give `indexError` a signature like `<1!P(!S,!S)><1!S>b` where the !S (meaning Poly Unboxed C1N) says that the polymorphic arguments -are unboxed (recursively). The wrapper for `indexError` won't /acutally/ +are unboxed (recursively). The wrapper for `indexError` won't /actually/ unbox them (because their polymorphic type doesn't allow that) but when demand-analysing /callers/, we'll behave as if that call needs the args unboxed. @@ -1782,39 +1786,6 @@ applying the strictness demands to the final result of DmdAnal. The result is that we get the strict demand signature we wanted even if we can't float the case on `x` up through the case on `burble`. -Note [Do not unbox class dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never unbox class dictionaries in worker/wrapper. - -1. INLINABLE functions - If we have - f :: Ord a => [a] -> Int -> a - {-# INLINABLE f #-} - and we worker/wrapper f, we'll get a worker with an INLINABLE pragma - (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), - which can still be specialised by the type-class specialiser, something like - fw :: Ord a => [a] -> Int# -> a - - BUT if f is strict in the Ord dictionary, we might unpack it, to get - fw :: (a->a->Bool) -> [a] -> Int# -> a - and the type-class specialiser can't specialise that. An example is #6056. - - Historical note: #14955 describes how I got this fix wrong the first time. - I got aware of the issue in T5075 by the change in boxity of loop between - demand analysis runs. - -2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur - occur without INLINABLE, when we use -fexpose-all-unfoldings and - -fspecialise-aggressively to do vigorous cross-module specialisation. - -3. #18421 found that unboxing a dictionary can also make the worker less likely - to inline; the inlining heuristics seem to prefer to inline a function - applied to a dictionary over a function applied to a bunch of functions. - -TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing -a raft of higher-order functions isn't a huge win anyway -- you really want to -specialise the function. - Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of @@ -1998,22 +1969,13 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take threshold_arity $ - [ (bndr_ty, NotMarkedStrict, get_dmd bndr bndr_ty) - | bndr <- bndrs - , isRuntimeVar bndr, let bndr_ty = idType bndr ] - - get_dmd :: Id -> Type -> Demand - get_dmd bndr bndr_ty - | isClassPred bndr_ty = trimBoxity dmd - -- See Note [Do not unbox class dictionaries] - -- NB: 'ty' has not been normalised, so this will (rightly) - -- catch newtype dictionaries too. - -- NB: even for bottoming functions, don't unbox dictionaries - - | is_bot_fn = unboxDeeplyDmd dmd - -- See Note [Boxity for bottoming functions], case (B) - - | otherwise = dmd + [ (idType bndr, NotMarkedStrict, get_dmd bndr) + | bndr <- bndrs, isRuntimeVar bndr ] + + get_dmd :: Id -> Demand + get_dmd bndr + | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], + | otherwise = dmd -- case (B) where dmd = idDemandInfo bndr @@ -2119,6 +2081,12 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) -- isMarkedStrict: see Note [Unboxing evaluated arguments] in DmdAnal -> DontUnbox + | doNotUnbox ty + -> DontUnbox -- See Note [Do not unbox class dictionaries] + -- NB: 'ty' has not been normalised, so this will (rightly) + -- catch newtype dictionaries too. + -- NB: even for bottoming functions, don't unbox dictionaries + | DefinitelyRecursive <- ae_rec_dc env dc -- See Note [Which types are unboxed?] -- and Note [Demand analysis for recursive data constructors] @@ -2129,6 +2097,76 @@ wantToUnboxArg env ty str_mark dmd@(n :* _) (dataConRepStrictness dc) dmds) + +doNotUnbox :: Type -> Bool +-- Do not unbox class dictionaries, except equality classes and tuples +-- Note [Do not unbox class dictionaries] +doNotUnbox arg_ty + = case tyConAppTyCon_maybe arg_ty of + Just tc | Just cls <- tyConClass_maybe tc + -> not (isEqualityClass cls || isCTupleClass cls) + -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] + + _ -> False + +{- Note [Do not unbox class dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never unbox class dictionaries in worker/wrapper. + +1. INLINABLE functions + If we have + f :: Ord a => [a] -> Int -> a + {-# INLINABLE f #-} + and we worker/wrapper f, we'll get a worker with an INLINABLE pragma + (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), + which can still be specialised by the type-class specialiser, something like + fw :: Ord a => [a] -> Int# -> a + + BUT if f is strict in the Ord dictionary, we might unpack it, to get + fw :: (a->a->Bool) -> [a] -> Int# -> a + and the type-class specialiser can't specialise that. An example is #6056. + + Historical note: #14955 describes how I got this fix wrong the first time. + I got aware of the issue in T5075 by the change in boxity of loop between + demand analysis runs. + +2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur + occur without INLINABLE, when we use -fexpose-all-unfoldings and + -fspecialise-aggressively to do vigorous cross-module specialisation. + +3. #18421 found that unboxing a dictionary can also make the worker less likely + to inline; the inlining heuristics seem to prefer to inline a function + applied to a dictionary over a function applied to a bunch of functions. + +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing +a raft of higher-order functions isn't a huge win anyway -- you really want to +specialise the function. + +Wrinkle (DNB1): we /do/ want to unbox tuple dictionaries (#23398) + f :: (% Eq a, Show a %) => blah + with -fdicts-strict it is great to unbox to + $wf :: Eq a => Show a => blah + (where I have written out the currying explicitly). Now we can specialise + $wf on the Eq or Show dictionary. Nothing is lost. + + And something is gained. It is possible that `f` will look like this: + f = /\a. \d:(% Eq a, Show a %). ... f @a (% sel1 d, sel2 d %)... + where there is a recurive call to `f`, or to another function that takes the + same tuple dictionary, but where the tuple is built from the components of + `d`. The Simplier does not fix this. But if we unpacked the dictionary + we'd get + $wf = /\a. \(d1:Eq a) (d2:Show a). let d = (% d1, d2 %) + in ...f @a (% sel1 d, sel2 d %) + and all the tuple building and taking apart will disappear. + +Wrinkle (DNB2): we /do/ wnat to unbox equality dictionaries, + for (~), (~~), and Coercible (#23398). Their payload is a single unboxed + coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is + to make a copy of the function's RHS with a particular coercion. Unlike + normal class methods, that does not unlock any new optimisation + opportunities in the specialised RHS. +-} + {- ********************************************************************* * * Fixpoints ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Predicate ( -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqPredClass, isCTupleClass, + isClassPred, isEqPredClass, isCTupleClass, isEqualityClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, @@ -219,11 +219,6 @@ isEvVarType :: Type -> Bool -- See Note [Evidence for quantified constraints] isEvVarType ty = isCoVarType ty || isPredTy ty -isEqPredClass :: Class -> Bool --- True of (~) and (~~) -isEqPredClass cls = cls `hasKey` eqTyConKey - || cls `hasKey` heqTyConKey - isClassPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tc -> isClassTyCon tc @@ -245,6 +240,20 @@ isEqPrimPred ty = isCoVarType ty isCTupleClass :: Class -> Bool isCTupleClass cls = isTupleTyCon (classTyCon cls) +isEqPredClass :: Class -> Bool +-- True of (~) and (~~) +isEqPredClass cls = cls `hasKey` eqTyConKey + || cls `hasKey` heqTyConKey + +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + + {- ********************************************************************* * * Implicit parameters ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3658,9 +3658,10 @@ makeDynFlagsConsistent dflags , gopt Opt_UnoptimizedCoreForInterpreter dflags , let (dflags', changed) = updOptLevelChanged 0 dflags , changed - = loop dflags' ("Optimization flags are incompatible with the " ++ - backendDescription (backend dflags) ++ - "; optimization flags ignored.") + = loop dflags' $ + "Ignoring optimization flags since they are experimental for the " ++ + backendDescription (backend dflags) ++ + ". Pass -fno-unoptimized-core-for-interpreter to enable this feature." | LinkInMemory <- ghcLink dflags , not (gopt Opt_ExternalInterpreter dflags) ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -1360,11 +1360,15 @@ mkDocIE (L l_comment hdk_comment) = span = mkSrcSpanPs l_comment mkDocNext :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocNext (L l (HdkCommentNext doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocNext (L l (HdkCommentNext doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocNext _ = Nothing mkDocPrev :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocPrev (L l (HdkCommentPrev doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocPrev (L l (HdkCommentPrev doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocPrev _ = Nothing ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -12,8 +12,6 @@ Extracting imported and top-level names in scope {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -ddump-to-file -ddump-simpl #-} - module GHC.Rename.Names ( rnImports, getLocalNonValBinders, newRecordFieldLabel, extendGlobalRdrEnvRn, ===================================== libraries/base/GHC/Foreign.hs ===================================== @@ -21,312 +21,22 @@ module GHC.Foreign ( -- * C strings with a configurable encoding CString, CStringLen, - -- conversion of C strings into Haskell strings - -- + -- * Conversion of C strings into Haskell strings peekCString, peekCStringLen, - -- conversion of Haskell strings into C strings - -- + -- * Conversion of Haskell strings into C strings newCString, newCStringLen, + newCStringLen0, - -- conversion of Haskell strings into C strings using temporary storage - -- + -- * Conversion of Haskell strings into C strings using temporary storage withCString, withCStringLen, + withCStringLen0, withCStringsLen, charIsRepresentable, ) where -import Foreign.Marshal.Array -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Storable - -import Data.Word - --- Imports for the locale-encoding version of marshallers - -import Data.Tuple (fst) - -import GHC.Show ( show ) - -import Foreign.Marshal.Alloc -import Foreign.ForeignPtr - -import GHC.Debug -import GHC.List -import GHC.Num -import GHC.Base - -import GHC.IO -import GHC.IO.Exception -import GHC.IO.Buffer -import GHC.IO.Encoding.Types - - -c_DEBUG_DUMP :: Bool -c_DEBUG_DUMP = False - -putDebugMsg :: String -> IO () -putDebugMsg | c_DEBUG_DUMP = debugLn - | otherwise = const (return ()) - - --- | A C string is a reference to an array of C characters terminated by NUL. -type CString = Ptr CChar - --- | A string with explicit length information in bytes instead of a --- terminating NUL (allowing NUL characters in the middle of the string). -type CStringLen = (Ptr CChar, Int) - --- exported functions --- ------------------ - --- | Marshal a NUL terminated C string into a Haskell string. --- -peekCString :: TextEncoding -> CString -> IO String -peekCString enc cp = do - sz <- lengthArray0 nUL cp - peekEncodedCString enc (cp, sz * cCharSize) - --- | Marshal a C string with explicit length into a Haskell string. --- -peekCStringLen :: TextEncoding -> CStringLen -> IO String -peekCStringLen = peekEncodedCString - --- | Marshal a Haskell string into a NUL terminated C string. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCString :: TextEncoding -> String -> IO CString -newCString enc = liftM fst . newEncodedCString enc True - --- | Marshal a Haskell string into a C string (ie, character array) with --- explicit length information. --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCStringLen :: TextEncoding -> String -> IO CStringLen -newCStringLen enc = newEncodedCString enc False - --- | Marshal a Haskell string into a NUL terminated C string using temporary --- storage. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a -withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp - --- | Marshal a Haskell string into a C string (ie, character array) --- in temporary storage, with explicit length information. --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a -withCStringLen enc = withEncodedCString enc False - --- | Marshal a list of Haskell strings into an array of NUL terminated C strings --- using temporary storage. --- --- * the Haskell strings may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringsLen :: TextEncoding - -> [String] - -> (Int -> Ptr CString -> IO a) - -> IO a -withCStringsLen enc strs f = go [] strs - where - go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss - go cs [] = withArrayLen (reverse cs) f - --- | Determines whether a character can be accurately encoded in a --- 'Foreign.C.String.CString'. --- --- Pretty much anyone who uses this function is in a state of sin because --- whether or not a character is encodable will, in general, depend on the --- context in which it occurs. -charIsRepresentable :: TextEncoding -> Char -> IO Bool --- We force enc explicitly because `catch` is lazy in its --- first argument. We would probably like to force c as well, --- but unfortunately worker/wrapper produces very bad code for --- that. --- --- TODO If this function is performance-critical, it would probably --- pay to use a single-character specialization of withCString. That --- would allow worker/wrapper to actually eliminate Char boxes, and --- would also get rid of the completely unnecessary cons allocation. -charIsRepresentable !enc c = - withCString enc [c] - (\cstr -> do str <- peekCString enc cstr - case str of - [ch] | ch == c -> pure True - _ -> pure False) - `catch` - \(_ :: IOException) -> pure False - --- auxiliary definitions --- ---------------------- - --- C's end of string character -nUL :: CChar -nUL = 0 - --- Size of a CChar in bytes -cCharSize :: Int -cCharSize = sizeOf (undefined :: CChar) - - -{-# INLINE peekEncodedCString #-} -peekEncodedCString :: TextEncoding -- ^ Encoding of CString - -> CStringLen - -> IO String -- ^ String in Haskell terms -peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) - = bracket mk_decoder close $ \decoder -> do - let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII - !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) - !to <- newCharBuffer chunk_size WriteBuffer - - let go !iteration !from = do - (why, from', !to') <- encode decoder from to - if isEmptyBuffer from' - then - -- No input remaining: @why@ will be InputUnderflow, but we don't care - withBuffer to' $ peekArray (bufferElems to') - else do - -- Input remaining: what went wrong? - putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) - (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because - InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input - OutputUnderflow -> return (from', to') -- We will have more space next time round - putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') - putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') - to_chars <- withBuffer to'' $ peekArray (bufferElems to'') - fmap (to_chars++) $ go (iteration + 1) from'' - - go (0 :: Int) from0 - -{-# INLINE withEncodedCString #-} -withEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory - -> IO a -withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_sz_bytes = do - putDebugMsg ("withEncodedCString: " ++ show iteration) - allocaBytes to_sz_bytes $ \to_p -> do - -- See Note [Check *before* fill in withEncodedCString] about why - -- this is subtle. - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> go (iteration + 1) (to_sz_bytes * 2) - Just to_buf -> withCStringBuffer to_buf null_terminate act - - -- If the input string is ASCII, this value will ensure we only allocate once - go (0 :: Int) (cCharSize * (sz + 1)) - -withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r -withCStringBuffer to_buf null_terminate act = do - let bytes = bufferElems to_buf - withBuffer to_buf $ \to_ptr -> do - when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 - act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* - -{-# INLINE newEncodedCString #-} -newEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> IO CStringLen -newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_p to_sz_bytes = do - putDebugMsg ("newEncodedCString: " ++ show iteration) - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> do - let to_sz_bytes' = to_sz_bytes * 2 - to_p' <- reallocBytes to_p to_sz_bytes' - go (iteration + 1) to_p' to_sz_bytes' - Just to_buf -> withCStringBuffer to_buf null_terminate return - - -- If the input string is ASCII, this value will ensure we only allocate once - let to_sz_bytes = cCharSize * (sz + 1) - to_p <- mallocBytes to_sz_bytes - go (0 :: Int) to_p to_sz_bytes - - -tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int - -> IO (Maybe (Buffer Word8)) -tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do - !to_fp <- newForeignPtr_ to_p - go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) - where - go !iteration !from !to = do - (why, from', to') <- encode encoder from to - putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') - if isEmptyBuffer from' - then if null_terminate && bufferAvailable to' == 0 - then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer - else return (Just to') - else case why of -- We didn't consume all of the input - InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad - InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid - OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more -{- -Note [Check *before* fill in withEncodedCString] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's very important that the size check and readjustment peformed by tryFillBuffer -happens before the continuation is called. The size check is the part which can -fail, the call to the continuation never fails and so the caller should respond -first to the size check failing and *then* call the continuation. Making this evident -to the compiler avoids historic space leaks. - -In a previous iteration of this code we had a pattern that, somewhat simplified, -looked like this: - -go :: State -> (State -> IO a) -> IO a -go state action = - case tryFillBufferAndCall state action of - Left state' -> go state' action - Right result -> result - -`tryFillBufferAndCall` performed some checks, and then we either called action, -or we modified the state and tried again. -This went wrong because `action` can be a function closure containing a reference to -a lazy data structure. If we call action directly, without retaining any references -to action, that is fine. The data structure is consumed as it is produced and we operate -in constant space. - -However the failure branch `go state' action` *does* capture a reference to action. -This went wrong because the reference to action in the failure branch only becomes -unreachable *after* action returns. This means we keep alive the function closure -for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list -via `action` until the action has fully run. -This went wrong in #20107, where the continuation kept an entire lazy bytestring alive -rather than allowing it to be incrementally consumed and collected. --} - +import GHC.Foreign.Internal ===================================== libraries/base/GHC/Foreign/Internal.hs ===================================== @@ -0,0 +1,357 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Foreign.Internal +-- Copyright : (c) The University of Glasgow, 2008-2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : libraries at haskell.org +-- Stability : internal +-- Portability : non-portable +-- +-- Foreign marshalling support for CStrings with configurable encodings +-- +----------------------------------------------------------------------------- + +module GHC.Foreign.Internal ( + -- * C strings with a configurable encoding + CString, CStringLen, + + -- * Conversion of C strings into Haskell strings + peekCString, + peekCStringLen, + + -- * Conversion of Haskell strings into C strings + newCString, + newCStringLen, + newCStringLen0, + + -- * Conversion of Haskell strings into C strings using temporary storage + withCString, + withCStringLen, + withCStringLen0, + withCStringsLen, + + charIsRepresentable, + ) where + +import Foreign.Marshal.Array +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable + +import Data.Word + +-- Imports for the locale-encoding version of marshallers + +import Data.Tuple (fst) + +import GHC.Show ( show ) + +import Foreign.Marshal.Alloc +import Foreign.ForeignPtr + +import GHC.Debug +import GHC.List +import GHC.Num +import GHC.Base + +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Buffer +import GHC.IO.Encoding.Types + + +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False + +putDebugMsg :: String -> IO () +putDebugMsg | c_DEBUG_DUMP = debugLn + | otherwise = const (return ()) + + +-- | A C string is a reference to an array of C characters terminated by NUL. +type CString = Ptr CChar + +-- | A string with explicit length information in bytes instead of a +-- terminating NUL (allowing NUL characters in the middle of the string). +type CStringLen = (Ptr CChar, Int) + +-- exported functions +-- ------------------ + +-- | Marshal a NUL terminated C string into a Haskell string. +-- +peekCString :: TextEncoding -> CString -> IO String +peekCString enc cp = do + sz <- lengthArray0 nUL cp + peekEncodedCString enc (cp, sz * cCharSize) + +-- | Marshal a C string with explicit length into a Haskell string. +-- +peekCStringLen :: TextEncoding -> CStringLen -> IO String +peekCStringLen = peekEncodedCString + +-- | Marshal a Haskell string into a NUL terminated C string. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCString :: TextEncoding -> String -> IO CString +newCString enc = liftM fst . newEncodedCString enc True + +-- | Marshal a Haskell string into a C string (ie, character array) with +-- explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCStringLen :: TextEncoding -> String -> IO CStringLen +newCStringLen enc = newEncodedCString enc False + +-- | Marshal a Haskell string into a NUL terminated C string using temporary +-- storage. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a +withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp + +-- | Marshal a Haskell string into a C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen enc = withEncodedCString enc False + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- with explicit length information. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +-- @since 4.19.0.0 +newCStringLen0 :: TextEncoding -> String -> IO CStringLen +newCStringLen0 enc = newEncodedCString enc True + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +-- @since 4.19.0.0 +withCStringLen0 :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen0 enc = withEncodedCString enc True + +-- | Marshal a list of Haskell strings into an array of NUL terminated C strings +-- using temporary storage. +-- +-- * the Haskell strings may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringsLen :: TextEncoding + -> [String] + -> (Int -> Ptr CString -> IO a) + -> IO a +withCStringsLen enc strs f = go [] strs + where + go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss + go cs [] = withArrayLen (reverse cs) f + +-- | Determines whether a character can be accurately encoded in a +-- 'Foreign.C.String.CString'. +-- +-- Pretty much anyone who uses this function is in a state of sin because +-- whether or not a character is encodable will, in general, depend on the +-- context in which it occurs. +charIsRepresentable :: TextEncoding -> Char -> IO Bool +-- We force enc explicitly because `catch` is lazy in its +-- first argument. We would probably like to force c as well, +-- but unfortunately worker/wrapper produces very bad code for +-- that. +-- +-- TODO If this function is performance-critical, it would probably +-- pay to use a single-character specialization of withCString. That +-- would allow worker/wrapper to actually eliminate Char boxes, and +-- would also get rid of the completely unnecessary cons allocation. +charIsRepresentable !enc c = + withCString enc [c] + (\cstr -> do str <- peekCString enc cstr + case str of + [ch] | ch == c -> pure True + _ -> pure False) + `catch` + \(_ :: IOException) -> pure False + +-- auxiliary definitions +-- ---------------------- + +-- C's end of string character +nUL :: CChar +nUL = 0 + +-- Size of a CChar in bytes +cCharSize :: Int +cCharSize = sizeOf (undefined :: CChar) + + +{-# INLINE peekEncodedCString #-} +peekEncodedCString :: TextEncoding -- ^ Encoding of CString + -> CStringLen + -> IO String -- ^ String in Haskell terms +peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) + = bracket mk_decoder close $ \decoder -> do + let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII + !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) + !to <- newCharBuffer chunk_size WriteBuffer + + let go !iteration !from = do + (why, from', !to') <- encode decoder from to + if isEmptyBuffer from' + then + -- No input remaining: @why@ will be InputUnderflow, but we don't care + withBuffer to' $ peekArray (bufferElems to') + else do + -- Input remaining: what went wrong? + putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) + (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because + InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input + OutputUnderflow -> return (from', to') -- We will have more space next time round + putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') + putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') + to_chars <- withBuffer to'' $ peekArray (bufferElems to'') + fmap (to_chars++) $ go (iteration + 1) from'' + + go (0 :: Int) from0 + +{-# INLINE withEncodedCString #-} +withEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory + -> IO a +withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_sz_bytes = do + putDebugMsg ("withEncodedCString: " ++ show iteration) + allocaBytes to_sz_bytes $ \to_p -> do + -- See Note [Check *before* fill in withEncodedCString] about why + -- this is subtle. + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> go (iteration + 1) (to_sz_bytes * 2) + Just to_buf -> withCStringBuffer to_buf null_terminate act + + -- If the input string is ASCII, this value will ensure we only allocate once + go (0 :: Int) (cCharSize * (sz + 1)) + +withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r +withCStringBuffer to_buf null_terminate act = do + let bytes = bufferElems to_buf + withBuffer to_buf $ \to_ptr -> do + when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 + act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* + +{-# INLINE newEncodedCString #-} +newEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> IO CStringLen +newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_p to_sz_bytes = do + putDebugMsg ("newEncodedCString: " ++ show iteration) + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> do + let to_sz_bytes' = to_sz_bytes * 2 + to_p' <- reallocBytes to_p to_sz_bytes' + go (iteration + 1) to_p' to_sz_bytes' + Just to_buf -> withCStringBuffer to_buf null_terminate return + + -- If the input string is ASCII, this value will ensure we only allocate once + let to_sz_bytes = cCharSize * (sz + 1) + to_p <- mallocBytes to_sz_bytes + go (0 :: Int) to_p to_sz_bytes + + +tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int + -> IO (Maybe (Buffer Word8)) +tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do + !to_fp <- newForeignPtr_ to_p + go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) + where + go !iteration !from !to = do + (why, from', to') <- encode encoder from to + putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') + if isEmptyBuffer from' + then if null_terminate && bufferAvailable to' == 0 + then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer + else return (Just to') + else case why of -- We didn't consume all of the input + InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad + InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid + OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more +{- +Note [Check *before* fill in withEncodedCString] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's very important that the size check and readjustment peformed by tryFillBuffer +happens before the continuation is called. The size check is the part which can +fail, the call to the continuation never fails and so the caller should respond +first to the size check failing and *then* call the continuation. Making this evident +to the compiler avoids historic space leaks. + +In a previous iteration of this code we had a pattern that, somewhat simplified, +looked like this: + +go :: State -> (State -> IO a) -> IO a +go state action = + case tryFillBufferAndCall state action of + Left state' -> go state' action + Right result -> result + +`tryFillBufferAndCall` performed some checks, and then we either called action, +or we modified the state and tried again. +This went wrong because `action` can be a function closure containing a reference to +a lazy data structure. If we call action directly, without retaining any references +to action, that is fine. The data structure is consumed as it is produced and we operate +in constant space. + +However the failure branch `go state' action` *does* capture a reference to action. +This went wrong because the reference to action in the failure branch only becomes +unreachable *after* action returns. This means we keep alive the function closure +for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list +via `action` until the action has fully run. +This went wrong in #20107, where the continuation kept an entire lazy bytestring alive +rather than allowing it to be incrementally consumed and collected. +-} + ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -34,7 +34,6 @@ import System.Posix.Types import Foreign import Foreign.C --- import Data.Bits import Data.Maybe #if !defined(HTYPE_TCFLAG_T) @@ -51,6 +50,9 @@ import GHC.IO.Device #if !defined(mingw32_HOST_OS) import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding) import qualified GHC.Foreign as GHC +import GHC.Ptr +#else +import Data.OldList (elem) #endif -- --------------------------------------------------------------------------- @@ -164,13 +166,23 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) + #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +190,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen0 enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen0 enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff ===================================== libraries/base/base.cabal ===================================== @@ -351,6 +351,7 @@ Library GHC.Event.IntVar GHC.Event.PSQ GHC.Event.Unique + GHC.Foreign.Internal -- GHC.IOPort -- TODO: hide again after debug GHC.Unicode.Internal.Bits GHC.Unicode.Internal.Char.DerivedCoreProperties ===================================== libraries/base/tests/T13660.hs ===================================== @@ -0,0 +1,11 @@ +-- | This should print an InvalidArgument error complaining that +-- the file path contains a NUL octet. +module Main where + +import System.IO.Error + +main :: IO () +main = do + catchIOError + (writeFile "hello\x00world" "hello") + print ===================================== libraries/base/tests/T13660.stdout ===================================== Binary files /dev/null and b/libraries/base/tests/T13660.stdout differ ===================================== libraries/base/tests/all.T ===================================== @@ -256,6 +256,7 @@ test('T13191', ['-O']) test('T13525', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) +test('T13660', when(opsys('mingw32'), skip), compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) test('T3474', [collect_stats('max_bytes_used',5), ===================================== m4/fp_ld_supports_response_files.m4 ===================================== @@ -5,7 +5,7 @@ AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ AC_MSG_CHECKING([whether $LD supports response files]) echo 'int main(void) {return 0;}' > conftest.c "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf '%q\n' -o conftest conftest.o > args.txt + printf "-o\nconftest\nconftest.o\n" > args.txt if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 then LdSupportsResponseFiles=YES ===================================== testsuite/tests/ghc-api/T10052/T10052.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci.debugger/scripts/print007.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci/should_fail/T10549.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/ghci/should_fail/T10549a.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== testsuite/tests/indexed-types/should_compile/T7837.stderr ===================================== @@ -1,3 +1,4 @@ Rule fired: Class op signum (BUILTIN) Rule fired: Class op abs (BUILTIN) Rule fired: normalize/Double (T7837) +Rule fired: Class op eq_sel (BUILTIN) ===================================== testsuite/tests/safeHaskell/ghci/p14.stderr ===================================== @@ -1,6 +1,6 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. :10:25: error: [GHC-39999] • No instance for ‘Num a’ arising from a use of ‘f’ ===================================== testsuite/tests/stranal/should_compile/T23398.hs ===================================== @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fdicts-strict #-} +module T23398 where + +type PairDict a = (Eq a, Show a) + +foo :: PairDict a => a -> a -> String +foo x y | x==y = show x + | otherwise = show y + +-- In worker/wrapper we'd like to unbox the pair +-- but not (Eq a) and (Show a) + +bar :: (a ~ b, Show a) => Int -> a -> (b, String) +bar 0 x = (x, show x) +bar n x = bar (n-1) x ===================================== testsuite/tests/stranal/should_compile/T23398.stderr ===================================== @@ -0,0 +1,109 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 76, types: 117, coercions: 4, joins: 0/0} + +-- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} +T23398.$wfoo [InlPrag=[2]] + :: forall {a}. (Eq a, Show a) => a -> a -> String +[GblId[StrictWorker([!, !])], + Arity=4, + Str=, + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [30 60 0 0] 120 0}] +T23398.$wfoo + = \ (@a) (ww :: Eq a) (ww1 :: Show a) (eta :: a) (eta1 :: a) -> + case == @a ww eta eta1 of { + False -> show @a ww1 eta1; + True -> show @a ww1 eta + } + +-- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/0} +foo [InlPrag=[2]] :: forall a. PairDict a => a -> a -> String +[GblId, + Arity=3, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + ($d(%,%) [Occ=Once1!] :: PairDict a) + (eta [Occ=Once1] :: a) + (eta1 [Occ=Once1] :: a) -> + case $d(%,%) of { (ww [Occ=Once1], ww1 [Occ=Once1]) -> + T23398.$wfoo @a ww ww1 eta eta1 + }}] +foo + = \ (@a) ($d(%,%) :: PairDict a) (eta :: a) (eta1 :: a) -> + case $d(%,%) of { (ww, ww1) -> T23398.$wfoo @a ww ww1 eta eta1 } + +Rec { +-- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} +T23398.$wbar [InlPrag=[2], Occ=LoopBreaker] + :: forall {a} {b}. + (a GHC.Prim.~# b, Show a) => + GHC.Prim.Int# -> a -> (# b, String #) +[GblId[StrictWorker([~, !])], + Arity=4, + Str=<1L>, + Unf=OtherCon []] +T23398.$wbar + = \ (@a) + (@b) + (ww :: a GHC.Prim.~# b) + ($dShow :: Show a) + (ww1 :: GHC.Prim.Int#) + (eta :: a) -> + case ww1 of ds { + __DEFAULT -> + T23398.$wbar + @a @b @~(ww :: a GHC.Prim.~# b) $dShow (GHC.Prim.-# ds 1#) eta; + 0# -> (# eta `cast` (Sub ww :: a ~R# b), show @a $dShow eta #) + } +end Rec } + +-- RHS size: {terms: 21, types: 32, coercions: 1, joins: 0/0} +bar [InlPrag=[2]] + :: forall a b. (a ~ b, Show a) => Int -> a -> (b, String) +[GblId, + Arity=4, + Str=<1!P(1L)>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (@b) + ($d~ [Occ=Once1!] :: a ~ b) + ($dShow [Occ=Once1] :: Show a) + (eta [Occ=Once1!] :: Int) + (eta1 [Occ=Once1] :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 [Occ=Once1] -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2 [Occ=Once1], ww3 [Occ=Once1] #) -> + (ww2, ww3) + } + } + }}] +bar + = \ (@a) + (@b) + ($d~ :: a ~ b) + ($dShow :: Show a) + (eta :: Int) + (eta1 :: a) -> + case $d~ of { GHC.Types.Eq# ww -> + case eta of { GHC.Types.I# ww1 -> + case T23398.$wbar @a @b @~(ww :: a GHC.Prim.~# b) $dShow ww1 eta1 + of + { (# ww2, ww3 #) -> + (ww2, ww3) + } + } + } + + + ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -93,3 +93,4 @@ test('T22039', normal, compile, ['']) test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) # T22997: Just a panic that should not happen test('T22997', normal, compile, ['']) +test('T23398', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds']) ===================================== testsuite/tests/th/T8333.stderr ===================================== @@ -1,3 +1,3 @@ when making flags consistent: warning: - Optimization flags are incompatible with the byte-code interpreter; optimization flags ignored. + Ignoring optimization flags since they are experimental for the byte-code interpreter. Pass -fno-unoptimized-core-for-interpreter to enable this feature. ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 +Subproject commit 04e9d6048bb297de5831651e60d496217525ef62 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72e21440778d5316380e4f40950935865bf4921c...dbf8b2b15d2d62622f30fce7ff564f03eb0d78a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72e21440778d5316380e4f40950935865bf4921c...dbf8b2b15d2d62622f30fce7ff564f03eb0d78a6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 20:22:09 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Thu, 18 May 2023 16:22:09 -0400 Subject: [Git][ghc/ghc][wip/warns-to-drivermessages] 12 commits: Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <646688f1a852c_9760a1fe64d8437788b@gitlab.mail> Oleg Grenrus pushed to branch wip/warns-to-drivermessages at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 31612ecd by Oleg Grenrus at 2023-05-18T23:22:01+03:00 Make Warn = Located DriverMessage Resolves #23261 This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - ghc/Main.hs - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - + libraries/base/tests/T13660.hs - + libraries/base/tests/T13660.stdout - libraries/base/tests/all.T - m4/fp_ld_supports_response_files.m4 - testsuite/tests/backpack/should_compile/bkp09.stderr - testsuite/tests/backpack/should_compile/bkp15.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b04bce3a94e3b191a5c43414b7f76d144f0d1f6...31612ecd7bb74e321500d55191cf4364672ee9d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b04bce3a94e3b191a5c43414b7f76d144f0d1f6...31612ecd7bb74e321500d55191cf4364672ee9d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 20:39:31 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 18 May 2023 16:39:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.6-gc Message-ID: <64668d031e1d1_9760a20c0356c3797c8@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.6-gc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.6-gc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 22:44:49 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 18 May 2023 18:44:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23019 Message-ID: <6466aa6155e3c_9760a23dde3843922a9@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23019 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23019 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 18 22:45:13 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 18 May 2023 18:45:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23109 Message-ID: <6466aa799c7bb_9760a23de496439243c@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23109 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23109 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 08:26:20 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 19 May 2023 04:26:20 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Add DIV and REM Message-ID: <646732ac7df0b_9760a23de05a8450856@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 4e60ab12 by Sven Tennie at 2023-05-19T10:24:07+02:00 Add DIV and REM REM calculates the remainder and replaces the more complex logic copied from AARCH64. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -881,22 +881,14 @@ getRegister' config plat expr -- Signed multiply/divide MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y) MO_S_MulMayOflo w -> do_mul_may_oflo w x y - MO_S_Quot w -> intOp True w (\d x y -> unitOL $ SDIV d x y) - - -- No native rem instruction. So we'll compute the following - -- Rd <- Rx / Ry | 2 <- 7 / 3 -- SDIV Rd Rx Ry - -- Rd' <- Rx - Rd * Ry | 1 <- 7 - 2 * 3 -- MSUB Rd' Rd Ry Rx - -- | '---|----------------|---' | - -- | '----------------|-------' - -- '--------------------------' + MO_S_Quot w -> intOp True w (\d x y -> unitOL $ DIV d x y) + -- Note the swap in Rx and Ry. - MO_S_Rem w -> withTempIntReg w $ \t -> - intOp True w (\d x y -> toOL [ SDIV t x y, MSUB d t y x ]) + MO_S_Rem w -> intOp True w (\d x y -> unitOL $ REM d x y) -- Unsigned multiply/divide MO_U_Quot w -> intOp False w (\d x y -> unitOL $ UDIV d x y) - MO_U_Rem w -> withTempIntReg w $ \t -> - intOp False w (\d x y -> toOL [ UDIV t x y, MSUB d t y x ]) + MO_U_Rem w -> intOp False w (\d x y -> unitOL $ REM d x y) -- Signed comparisons -- see Note [CSET] MO_S_Ge w -> intOp True w (\d x y -> toOL [ CSET d x y SGE ]) @@ -914,7 +906,7 @@ getRegister' config plat expr MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y) MO_F_Sub w -> floatOp w (\d x y -> unitOL $ SUB d x y) MO_F_Mul w -> floatOp w (\d x y -> unitOL $ MUL d x y) - MO_F_Quot w -> floatOp w (\d x y -> unitOL $ SDIV d x y) + MO_F_Quot w -> floatOp w (\d x y -> unitOL $ DIV d x y) -- Floating point comparison MO_F_Eq w -> floatCond w (\d x y -> toOL [ CSET d x y EQ ]) ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -82,12 +82,12 @@ regUsageOfInstr platform instr = case instr of ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- CMN l r -> usage (regOp l ++ regOp r, []) -- CMP l r -> usage (regOp l ++ regOp r, []) - MSUB dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) MUL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) NEG dst src -> usage (regOp src, regOp dst) SMULH dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) SMULL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - SDIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + DIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + REM dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) SUB dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) UDIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -222,12 +222,12 @@ patchRegsOfInstr instr env = case instr of ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) -- CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) -- CMP o1 o2 -> CMP (patchOp o1) (patchOp o2) - MSUB o1 o2 o3 o4 -> MSUB (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) MUL o1 o2 o3 -> MUL (patchOp o1) (patchOp o2) (patchOp o3) NEG o1 o2 -> NEG (patchOp o1) (patchOp o2) SMULH o1 o2 o3 -> SMULH (patchOp o1) (patchOp o2) (patchOp o3) SMULL o1 o2 o3 -> SMULL (patchOp o1) (patchOp o2) (patchOp o3) - SDIV o1 o2 o3 -> SDIV (patchOp o1) (patchOp o2) (patchOp o3) + DIV o1 o2 o3 -> DIV (patchOp o1) (patchOp o2) (patchOp o3) + REM o1 o2 o3 -> REM (patchOp o1) (patchOp o2) (patchOp o3) SUB o1 o2 o3 -> SUB (patchOp o1) (patchOp o2) (patchOp o3) UDIV o1 o2 o3 -> UDIV (patchOp o1) (patchOp o2) (patchOp o3) @@ -607,7 +607,6 @@ data Instr -- | CMN Operand Operand -- rd + op2 -- | CMP Operand Operand -- rd - op2 - | MSUB Operand Operand Operand Operand -- rd = ra - rn × rm | MUL Operand Operand Operand -- rd = rn × rm @@ -616,7 +615,8 @@ data Instr -- NOT = XOR -1, x | NEG Operand Operand -- rd = -op2 - | SDIV Operand Operand Operand -- rd = rn ÷ rm + | DIV Operand Operand Operand -- rd = rn ÷ rm + | REM Operand Operand Operand -- rd = rn % rm | SMULH Operand Operand Operand | SMULL Operand Operand Operand @@ -707,10 +707,10 @@ instrCon i = OR{} -> "OR" -- CMN{} -> "CMN" -- CMP{} -> "CMP" - MSUB{} -> "MSUB" MUL{} -> "MUL" NEG{} -> "NEG" - SDIV{} -> "SDIV" + DIV{} -> "DIV" + REM{} -> "REM" SMULH{} -> "SMULH" SMULL{} -> "SMULL" SUB{} -> "SUB" ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -461,7 +461,6 @@ pprInstr platform instr = case instr of -- CMP o1 o2 -- | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2 -- | otherwise -> op2 (text "\tcmp") o1 o2 - MSUB o1 o2 o3 o4 -> op4 (text "\tmsub") o1 o2 o3 o4 MUL o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul") o1 o2 o3 | otherwise -> op3 (text "\tmul") o1 o2 o3 @@ -470,9 +469,13 @@ pprInstr platform instr = case instr of NEG o1 o2 | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfneg") o1 o2 | otherwise -> op2 (text "\tneg") o1 o2 - SDIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 + DIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 + -- TODO: This must (likely) be refined regarding width -> op3 (text "\tfdiv") o1 o2 o3 - SDIV o1 o2 o3 -> op3 (text "\tsdiv") o1 o2 o3 + DIV o1 o2 o3 -> op3 (text "\tdiv") o1 o2 o3 + REM o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 + -> panic $ "pprInstr - REM not implemented for floats (yet)" + REM o1 o2 o3 -> op3 (text "\trem") o1 o2 o3 SUB o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub") o1 o2 o3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e60ab12f1125af5f1c97efd916c12a5ff1be7f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e60ab12f1125af5f1c97efd916c12a5ff1be7f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 08:49:46 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Fri, 19 May 2023 04:49:46 -0400 Subject: [Git][ghc/ghc][wip/warns-to-drivermessages] Apply 3 suggestion(s) to 3 file(s) Message-ID: <6467382a18bb5_9760a23ddf3604629a3@gitlab.mail> Oleg Grenrus pushed to branch wip/warns-to-drivermessages at Glasgow Haskell Compiler / GHC Commits: 48b5c933 by Matthew Pickering at 2023-05-19T08:49:41+00:00 Apply 3 suggestion(s) to 3 file(s) - - - - - 3 changed files: - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Driver/CmdLine.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Driver.CmdLine Err(..), Warn, warnsToMessages, - EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM, + EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM ) where import GHC.Prelude ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -373,6 +373,7 @@ data DriverMessage where DriverInterfaceError :: !IfaceMessage -> DriverMessage + -- TODO: Add structure messages rather than a String DriverInconsistentDynFlags :: String -> DriverMessage DriverSafeHaskellIgnoredExtension :: !LangExt.Extension -> DriverMessage ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -805,7 +805,6 @@ processCmdLineP activeFlags s0 args = getCmdLineP :: CmdLineP s a -> StateT s m a getCmdLineP (CmdLineP k) = k - -- | Parses the dynamically set flags for GHC. This is the most general form of -- the dynamic flag parser that the other methods simply wrap. It allows -- saying which flags are valid flags and indicating if we are parsing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48b5c9338f28e6cc34a85c636ee81863a9e6134d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48b5c9338f28e6cc34a85c636ee81863a9e6134d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 08:52:45 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Fri, 19 May 2023 04:52:45 -0400 Subject: [Git][ghc/ghc][wip/warns-to-drivermessages] Make Warn = Located DriverMessage Message-ID: <646738dd5d820_9760a20c0351c473659@gitlab.mail> Oleg Grenrus pushed to branch wip/warns-to-drivermessages at Glasgow Haskell Compiler / GHC Commits: 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Types/Error/Codes.hs - ghc/GHCi/UI.hs - ghc/Main.hs - testsuite/tests/backpack/should_compile/bkp09.stderr - testsuite/tests/backpack/should_compile/bkp15.stderr - testsuite/tests/deSugar/should_compile/ds041.stderr - testsuite/tests/deriving/should_compile/T20501.stderr - testsuite/tests/deriving/should_compile/T4325.stderr - testsuite/tests/deriving/should_compile/T4966.stderr - testsuite/tests/deriving/should_compile/drv-foldable-traversable1.stderr - testsuite/tests/deriving/should_compile/drv-functor1.stderr - testsuite/tests/deriving/should_fail/drvfail-functor2.stderr - testsuite/tests/driver/T11429a.stderr - testsuite/tests/driver/T11429c.stderr - testsuite/tests/driver/T12056b.stderr - testsuite/tests/driver/T12056c.stderr - testsuite/tests/driver/T20436/T20436.stderr - testsuite/tests/driver/T21682.stderr - testsuite/tests/driver/T2464.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bca0486232b5f0cf6f5a396b16d52e5db55fb9a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bca0486232b5f0cf6f5a396b16d52e5db55fb9a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 09:18:32 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 19 May 2023 05:18:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/core-docs Message-ID: <64673ee8a987c_9760a23ddf3604825a5@gitlab.mail> Sebastian Graf pushed new branch wip/core-docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/core-docs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 09:43:26 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 19 May 2023 05:43:26 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix: LDRB -> LB, LDRH -> LH Message-ID: <646744be4dcab_9760a23de05a848603a@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: c3508989 by Sven Tennie at 2023-05-19T11:41:17+02:00 Fix: LDRB -> LB, LDRH -> LH A simple translation of these instructions from ARM to RISCV. Add panic-ing pattern matches to fetch the outstanding STR and LDR cases. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -592,7 +592,7 @@ data Instr -- 2. Memory Load/Store Instructions --------------------------------------- -- Unlike arm, we don't have register shorthands for size. - -- We do hover have {L,S}{B,H,W,D}[U] instructions for Load/Store, Byte, Half, Word, Double, (Unsigned). + -- We do however have {L,S}{B,H,W,D}[U] instructions for Load/Store, Byte, Half, Word, Double, (Unsigned). -- Reusing the arm logic with the _format_ specifier will hopefully work. | STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr | LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr @@ -906,3 +906,4 @@ fitsIn12bitImm off = off >= intMin12bit && off <= intMax12bit fitsIn32bits :: (Num a, Ord a, Bits a) => a -> Bool fitsIn32bits i = (-1 `shiftL` 31) <= i && i <= (1 `shiftL` 31 -1) + ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -596,6 +596,8 @@ pprInstr platform instr = case instr of STR II16 o1 o2 -> op2 (text "\tsh") o1 o2 STR II32 o1 o2 -> op2 (text "\tsw") o1 o2 STR II64 o1 o2 -> op2 (text "\tsd") o1 o2 + STR f o1 o2 -> pprPanic "RV64.pprInstr - STR not implemented for ... " + (text "STR" <+> (text.show) f <+> pprOp platform o1 <+> pprOp platform o2) LDR _f o1 (OpImm (ImmIndex lbl off)) -> lines_ [ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl @@ -613,15 +615,17 @@ pprInstr platform instr = case instr of -- op_add o1 (text "%pcrel_lo(" <> pprAsmLabel platform lbl <> text ")") line $ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl - LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tldrb") o1 o2 - LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tldrh") o1 o2 + LDR _f o1@(OpReg W8 reg) o2 | isIntRealReg reg -> + op2 (text "\tlb") o1 o2 + LDR _f o1@(OpReg W16 reg) o2 | isIntRealReg reg -> + op2 (text "\tlh") o1 o2 LDR II8 o1 o2 -> op2 (text "\tlb") o1 o2 LDR II16 o1 o2 -> op2 (text "\tlh") o1 o2 LDR II32 o1 o2 -> op2 (text "\tlw") o1 o2 LDR II64 o1 o2 -> op2 (text "\tld") o1 o2 + LDR f o1 o2 -> pprPanic "RV64.pprInstr - LDR not implemented for ... " + (text "LDR" <+> (text.show) f <+> pprOp platform o1 <+> pprOp platform o2) -- LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2 -- STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3 @@ -634,6 +638,7 @@ pprInstr platform instr = case instr of SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 FCVTZS o1 o2 -> op2 (text "\tfcvtzs") o1 o2 FABS o1 o2 -> op2 (text "\tfabs") o1 o2 + instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ (instrCon instr) where op2 op o1 o2 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 op3 op o1 o2 o3 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 op4 op o1 o2 o3 o4 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4 ===================================== compiler/GHC/CmmToAsm/RV64/Regs.hs ===================================== @@ -145,6 +145,10 @@ classOfRealReg (RealRegSingle i) | i < 32 = RcInteger | otherwise = RcDouble +isIntRealReg :: Reg -> Bool +isIntRealReg (RegReal r) = classOfRealReg r == RcInteger +isIntRealReg _ = False + regDotColor :: RealReg -> SDoc regDotColor reg = case classOfRealReg reg of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3508989f96f9c44af768c33d7b21f8f1d6ae1df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3508989f96f9c44af768c33d7b21f8f1d6ae1df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 11:21:32 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 19 May 2023 07:21:32 -0400 Subject: [Git][ghc/ghc][wip/T23083] 4 commits: ANFise string literal arguments (#23270) Message-ID: <64675bbc617be_9760a200dba7c51072@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: ec8a4178 by Sebastian Graf at 2023-05-19T13:19:25+02:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Annoyingly, in -O0 we sometimes generate ``` foo = case "blah"# of sat { __DEFAULT -> unpackCString# sat } ``` which makes it a bit harder to spot that we can emit a standard `stg_unpack_cstring` thunk. Fixes #23270. - - - - - d1cbc110 by Sebastian Graf at 2023-05-19T13:21:25+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - b76e388e by Sebastian Graf at 2023-05-19T13:21:25+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - 53016aed by Sebastian Graf at 2023-05-19T13:21:25+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Utils/Trace.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c8858846fb0d67a550f5943bf8bfced19b5f46b...53016aed97a11a2a3d2718d51a738eafda06af3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c8858846fb0d67a550f5943bf8bfced19b5f46b...53016aed97a11a2a3d2718d51a738eafda06af3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 11:28:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 May 2023 07:28:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: base: Add test for #13660 Message-ID: <64675d673bb37_9760a23dde3705140a1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 5ff7788e by Simon Peyton Jones at 2023-05-19T07:28:34-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Types/Error/Codes.hs - ghc/GHCi/UI.hs - ghc/Main.hs - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - + libraries/base/tests/T13660.hs - + libraries/base/tests/T13660.stdout - libraries/base/tests/all.T - m4/fp_ld_supports_response_files.m4 - testsuite/tests/backpack/should_compile/bkp09.stderr - testsuite/tests/backpack/should_compile/bkp15.stderr - testsuite/tests/deSugar/should_compile/ds041.stderr - testsuite/tests/deriving/should_compile/T20501.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48e9aa20863d612a341ebf8076865765611a71d5...5ff7788e2038160a9168466a8fd96dc1d5a9f270 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48e9aa20863d612a341ebf8076865765611a71d5...5ff7788e2038160a9168466a8fd96dc1d5a9f270 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 12:19:14 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 19 May 2023 08:19:14 -0400 Subject: [Git][ghc/ghc][wip/T23083] 4 commits: ANFise string literal arguments (#23270) Message-ID: <6467694210fdd_9760a23de496452163@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 09a83f2b by Sebastian Graf at 2023-05-19T14:19:07+02:00 ANFise string literal arguments (#23270) This instates the invariant that a trivial CoreExpr translates to an atomic StgExpr. Nice. Annoyingly, in -O0 we sometimes generate ``` foo = case "blah"# of sat { __DEFAULT -> unpackCString# sat } ``` which makes it a bit harder to spot that we can emit a standard `stg_unpack_cstring` thunk. Fixes #23270. - - - - - e45566a8 by Sebastian Graf at 2023-05-19T14:19:07+02:00 Deactivate -fcatch-nonexhaustive-cases in ghc-bignum (#23345) - - - - - af75c1d5 by Sebastian Graf at 2023-05-19T14:19:07+02:00 CorePrep: Eliminate EmptyCase and unsafeEqualityProof in CoreToStg instead We eliminate EmptyCase by way of `coreToStg (Case e _ _ []) = coreToStg e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. We do also give the same treatment to unsafeCoerce proofs and treat them as trivial iff their RHS is trivial. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and `CorePrepProv`. - - - - - 3195e25c by Sebastian Graf at 2023-05-19T14:19:07+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. We only do this optimisation with -O2 because we saw 2-3% ghc/alloc regressions in T4801 and T5321FD. Fixes #23083. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Utils/Trace.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53016aed97a11a2a3d2718d51a738eafda06af3f...3195e25c8326c365b1af544457272324e994b884 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53016aed97a11a2a3d2718d51a738eafda06af3f...3195e25c8326c365b1af544457272324e994b884 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 12:19:28 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 19 May 2023 08:19:28 -0400 Subject: [Git][ghc/ghc][wip/or-pats-amendment] 189 commits: nonmoving: Disable slop-zeroing Message-ID: <64676950b8347_9760a23dde3845223b2@gitlab.mail> David pushed to branch wip/or-pats-amendment at Glasgow Haskell Compiler / GHC Commits: d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - bfacb34f by David Knothe at 2023-05-19T14:15:36+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. - - - - - faef4286 by David Knothe at 2023-05-19T14:15:38+02:00 stuff - - - - - a8989041 by David Knothe at 2023-05-19T14:15:38+02:00 Implement empty one of - - - - - 443fb188 by David Knothe at 2023-05-19T14:15:38+02:00 Prohibit TyApps - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - + a.out - cabal.project-reinstall - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80d0af35c2f2b469185ec41d233fc5ea919eebd5...443fb18838effd895e82df02c7db21fa461083f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80d0af35c2f2b469185ec41d233fc5ea919eebd5...443fb18838effd895e82df02c7db21fa461083f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 12:25:57 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 19 May 2023 08:25:57 -0400 Subject: [Git][ghc/ghc][wip/core-docs] Documentation for the Core data constructors Message-ID: <64676ad57efa2_9760a200dba7c52424f@gitlab.mail> Sebastian Graf pushed to branch wip/core-docs at Glasgow Haskell Compiler / GHC Commits: 8fc1802b by Sebastian Graf at 2023-05-19T14:25:51+02:00 Documentation for the Core data constructors - - - - - 1 changed file: - compiler/GHC/Core.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -165,99 +165,163 @@ These data types are the heart of the compiler -- optimization, analysis and code generation on. -- -- The type parameter @b@ is for the type of binders in the expression tree. --- --- The language consists of the following elements: --- --- * Variables --- See Note [Variable occurrences in Core] --- --- * Primitive literals --- --- * Applications: note that the argument may be a 'Type'. --- See Note [Representation polymorphism invariants] --- --- * Lambda abstraction --- See Note [Representation polymorphism invariants] --- --- * Recursive and non recursive @let at s. Operationally --- this corresponds to allocating a thunk for the things --- bound and then executing the sub-expression. --- --- See Note [Core letrec invariant] --- See Note [Core let-can-float invariant] --- See Note [Representation polymorphism invariants] --- See Note [Core type and coercion invariant] --- --- * Case expression. Operationally this corresponds to evaluating --- the scrutinee (expression examined) to weak head normal form --- and then examining at most one level of resulting constructor (i.e. you --- cannot do nested pattern matching directly with this). --- --- The binder gets bound to the value of the scrutinee, --- and the 'Type' must be that of all the case alternatives --- --- IMPORTANT: see Note [Case expression invariants] --- --- * Cast an expression to a particular type. --- This is used to implement @newtype at s (a @newtype@ constructor or --- destructor just becomes a 'Cast' in Core) and GADTs. --- --- * Ticks. These are used to represent all the source annotation we --- support: profiling SCCs, HPC ticks, and GHCi breakpoints. --- --- * A type: this should only show up at the top level of an Arg --- --- * A coercion - -{- Note [Why does Case have a 'Type' field?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The obvious alternative is - exprType (Case scrut bndr alts) - | (_,_,rhs1):_ <- alts - = exprType rhs1 - -But caching the type in the Case constructor - exprType (Case scrut bndr ty alts) = ty -is better for at least three reasons: - -* It works when there are no alternatives (see case invariant 1 above) - -* It might be faster in deeply-nested situations. - -* It might not be quite the same as (exprType rhs) for one - of the RHSs in alts. Consider a phantom type synonym - type S a = Int - and we want to form the case expression - case x of { K (a::*) -> (e :: S a) } - Then exprType of the RHS is (S a), but we cannot make that be - the 'ty' in the Case constructor because 'a' is simply not in - scope there. Instead we must expand the synonym to Int before - putting it in the Case constructor. See GHC.Core.Utils.mkSingleAltCase. - - So we'd have to do synonym expansion in exprType which would - be inefficient. - -* The type stored in the case is checked with lintInTy. This checks - (among other things) that it does not mention any variables that are - not in scope. If we did not have the type there, it would be a bit - harder for Core Lint to reject case blah of Ex x -> x where - data Ex = forall a. Ex a. --} +-- It is usually instantiated to 'Var' (in 'CoreExpr', the commonly used type +-- alias). To see why @b@ is useful, see 'TaggedExpr' and its use in +-- "GHC.Core.Opt.SetLevels". -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint data Expr b = Var Id + -- ^ A (term-level, hence 'Id') variable occurrence, + -- see Note [Variable occurrences in Core]. + -- + -- Refers to the 'Id' record of its binding site; + -- if you change its 'GHC.Types.Id.idInfo' you probably want to change the + -- 'GHC.Types.Id.idInfo' of the binding site as well. + | Lit Literal + -- ^ A primitive literal, always of unlifted kind. + -- + -- Haskell's number literals such as `0 :: Int` (where `Int` is a lifted data type) + -- do /not/ have a representation as a Core 'Literal'; rather they get desugared + -- to `I# 0#`, where `0#` is a Literal of type `Int#` (which has unlifted kind + -- `TYPE IntRep`). + -- + -- There are a few utility functions to create literals, for example + -- 'mkIntLit', 'mkDoubleLit', 'mkCharLit', 'mkStringLit'. + | App (Expr b) (Arg b) + -- ^ A unary application, often occuring in left-associated chains. + -- + -- There are a few utility functions working on application chains; + -- see 'collectArgs' and friends. + -- + -- Args have fixed runtime representation; + -- see Note [Representation polymorphism invariants]. + | Lam b (Expr b) + -- ^ A lambda, binding term arguments ('Id'), type or kind arguments ('TyVar') + -- or coercion arguments ('CoVar'). + -- + -- Note that type and coercion binders are dependently quantified. E.g., in + -- pretty-printed Core, + -- + -- > f = \(@a) (@co :: a ~# Int) -> :: ( a |> (... co)) + -- + -- Where you can pick out dependent quantifiers by the leading `@`. + -- Here, `a` occurs in the kind of `co` (the next lambda binder) and in the + -- type of ``, so both the kind of `co` /and/ the type of `` + -- depend on `a`. Furthermore, the type of `` is casted via a + -- coercion mentioning `co`. + -- + -- Subject to Note [Shadowing] for the lambda binder. + -- Lambda binders have fixed runtime representation; + -- see Note [Representation polymorphism invariants]. + -- + -- Use 'mkLams' to create multiple lambdas at once and 'wrapLamBody' to + -- map over the body of a lambda without touching its binders (beware of + -- name capture!). + | Let (Bind b) (Expr b) - | Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants] - -- and Note [Why does Case have a 'Type' field?] - | Cast (Expr b) CoercionR -- The Coercion has Representational role + -- ^ A let binding. 'Bind' is either a single, 'NonRec'ursive binding or a + -- list of mutually 'Rec'ursive bindings. + -- Operationally, this corresponds to allocating a thunk for the things bound + -- and then executing the sub-expression. + -- + -- Almost exclusively used for value bindings, e.g., 'Id's, in which case be + -- aware of the following invariants: + -- + -- * Note [Core letrec invariant] + -- * Note [Core let-can-float invariant] + -- * Note [Shadowing] of the let binders + -- * Let binders have fixed runtime representation; + -- see Note [Representation polymorphism invariants]. + -- + -- A very special kind of let binding is a /join point/, which can be detected + -- with 'GHC.Types.Id.isJoinId_maybe' or 'GHC.Core.Utils.isJoinBind'. + -- Consult Note [Join points] for details. + -- + -- In exception to \"exclusively\" above, we may bind a 'TyVar' or a 'CoVar' + -- in a non-recursive 'Bind', see Note [Core type and coercion invariant]. + -- + -- See also utility functions 'mkLet', 'mkLets', 'mkLetNonRec', 'mkLetRec'. + + | Case (Expr b) b Type [Alt b] + -- ^ Represents a Case expression, doing one level of pattern-matching. + -- Pretty-printed as + -- + -- > case scrut of wild { + -- > __DEFAULT -> rhs1; + -- > (:) x xs -> rhs2; + -- > } + -- + -- Operationally, the /scrutinee/ expression `scrut` is evaluated to head + -- normal form. The value is bound to the /case binder/ `wild` and is then + -- examined to do a one-level switch on the data constructor tag/literal to + -- jump to one of the /alternatives/. (Nested matches in Haskell have been + -- desugared to multiple Case matches in Core.) + -- + -- The type is the cached return type of the whole case + -- expression and hence matches that of the case alternatives, + -- see Note [Why does Case have a 'Type' field?]. + -- The list of case alternatives is roughly represented as + -- + -- > 'Alt' 'DefaultAlt' [] "rhs1", 'Alt' ('DataAlt' "(:)"), ["x","xs"], "rhs2"] + -- + -- Note that there is at most one catch-all `__DEFAULT` case and no overlap + -- between other alternatives, so the order of alternatives is arbitrary + -- (e.g., /no/ first-match semantics). + -- + -- See also + -- + -- * Note [Case expression invariants] + -- * Note [Empty case alternatives] + -- * Note [Shadowing] of the case binder + -- * Case binders have fixed runtime representation; + -- see Note [Representation polymorphism invariants]. + -- + -- Utility functions: 'GHC.Core.Utils.mkAltExpr', + -- 'GHC.Core.Utils.mkDefaultCase', 'GHC.Core.Utils.mkSingleAltCase' and the + -- various helper functions around case alternatives in "GHC.Core.Utils". + + | Cast (Expr b) CoercionR + -- ^ Cast an expression's type via a 'CoercionR' (the R denotes that it has a + -- Representational role). Doing so has no effect at runtime, but it is + -- crucial for justifying term-level transformations in the type system. + -- + -- This is used to implement `newtype`s (a `newtype` constructor or + -- destructor just becomes a 'Cast' in Core) and GADTs. + | Tick CoreTickish (Expr b) + -- ^ Wraps various sorts of debug information around an expression, such as + -- profiling SCCs, HPC ticks, and GHCi breakpoints. + -- + -- We try to preserve meaning throughout transformations as best as possible. + -- + -- There are quite a few utility functions that work on 'Ticks': + -- 'collectArgsTicks', 'GHC.Core.Utils.stripTicksTop' and friends in + -- "GHC.Core.Utils". + | Type Type + -- ^ Signals leaving of the \"term level\" and injects a type expression. + -- + -- Occurs only in argument position of an 'App' such as `id @Int (I# 42#)` + -- (where there is a non-pretty-printed `Type ...` wrapped around the type + -- expression @Int@) or (rarely) in the RHS of a 'Let' that binds a type + -- variable, such as `let { a = @(Rep MyBigGenericRecord) } in ...` + -- as in Note [Core type and coercion invariant]. + -- + -- If you want to turn a 'Var' into an argument and don't know whether it's an + -- term level 'Id', a type-level 'TyVar' or a 'CoVar', use 'varToCoreExpr'. + | Coercion Coercion + -- ^ Quite the same as the 'Type' constructor, but for introducing coercion + -- arguments (which encode equalities between types). + -- + -- Coercion arguments are morally values and should be treated as such (e.g., + -- somewhat close to tokens of type `()`) until they are erased in STG. + deriving Data -- | Type synonym for expressions that occur in function argument positions. @@ -585,6 +649,40 @@ checked by Core Lint. multiplicity of the corresponding field /scaled by the multiplicity of the case binder/. Checked in lintCoreAlt. +Note [Why does Case have a 'Type' field?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The obvious alternative is + exprType (Case scrut bndr alts) + | (_,_,rhs1):_ <- alts + = exprType rhs1 + +But caching the type in the Case constructor + exprType (Case scrut bndr ty alts) = ty +is better for at least three reasons: + +* It works when there are no alternatives (see case invariant 1 above) + +* It might be faster in deeply-nested situations. + +* It might not be quite the same as (exprType rhs) for one + of the RHSs in alts. Consider a phantom type synonym + type S a = Int + and we want to form the case expression + case x of { K (a::*) -> (e :: S a) } + Then exprType of the RHS is (S a), but we cannot make that be + the 'ty' in the Case constructor because 'a' is simply not in + scope there. Instead we must expand the synonym to Int before + putting it in the Case constructor. See GHC.Core.Utils.mkSingleAltCase. + + So we'd have to do synonym expansion in exprType which would + be inefficient. + +* The type stored in the case is checked with lintInTy. This checks + (among other things) that it does not mention any variables that are + not in scope. If we did not have the type there, it would be a bit + harder for Core Lint to reject case blah of Ex x -> x where + data Ex = forall a. Ex a. + Note [Core type and coercion invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We allow a /non-recursive/, /non-top-level/ let to bind type and View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fc1802bdee4626ab09e9ee073fd7681b919dbd8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fc1802bdee4626ab09e9ee073fd7681b919dbd8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 12:46:11 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 19 May 2023 08:46:11 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] Memory usage fixes for Haddock Message-ID: <64676f93d75fb_9760a23de49645318c@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 027eb2dd by Finley McIlwaine at 2023-05-19T06:44:04-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Strictly evaluate names in `rnHsDoc` to avoid retention of GlobalRdrEnv - Update haddock perf tests to be more accurate and force evaluation of renamed doc thunks - Update Haddock submodule - - - - - 5 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - testsuite/tests/haddock/perf/Makefile - utils/haddock Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -1360,11 +1360,15 @@ mkDocIE (L l_comment hdk_comment) = span = mkSrcSpanPs l_comment mkDocNext :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocNext (L l (HdkCommentNext doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocNext (L l (HdkCommentNext doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocNext _ = Nothing mkDocPrev :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocPrev (L l (HdkCommentPrev doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocPrev (L l (HdkCommentPrev doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocPrev _ = Nothing ===================================== compiler/GHC/Rename/Doc.hs ===================================== @@ -1,5 +1,7 @@ module GHC.Rename.Doc ( rnHsDoc, rnLHsDoc, rnLDocDecl, rnDocDecl ) where +import Control.DeepSeq (force) + import GHC.Prelude import GHC.Tc.Types @@ -33,7 +35,11 @@ rnDocDecl (DocGroup i doc) = do rnHsDoc :: WithHsDocIdentifiers a GhcPs -> RnM (WithHsDocIdentifiers a GhcRn) rnHsDoc (WithHsDocIdentifiers s ids) = do gre <- tcg_rdr_env <$> getGblEnv - pure (WithHsDocIdentifiers s (rnHsDocIdentifiers gre ids)) + + -- This is forced to avoid retention of the GlobalRdrEnv + let !rn = force $ rnHsDocIdentifiers gre ids + + pure (WithHsDocIdentifiers s rn) rnHsDocIdentifiers :: GlobalRdrEnv -> [Located RdrName] ===================================== testsuite/tests/haddock/perf/Makefile ===================================== @@ -4,12 +4,12 @@ include $(TOP)/mk/test.mk # We accept a 5% increase in parser allocations due to -haddock haddock_parser_perf : - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" # Similarly for the renamer haddock_renamer_perf : - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.20) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 +Subproject commit 04e9d6048bb297de5831651e60d496217525ef62 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/027eb2dd62d203450e03aa9b8323678ac2965810 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/027eb2dd62d203450e03aa9b8323678ac2965810 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 12:46:33 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 19 May 2023 08:46:33 -0400 Subject: [Git][ghc/ghc][wip/T23146] Fix inconsistencies in code comments Message-ID: <64676fa9aad0a_9760a200dba7c5322e8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 4d5cd5ac by Matthew Craven at 2023-05-19T12:46:31+00:00 Fix inconsistencies in code comments - - - - - 3 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Stg/Syntax.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -397,8 +397,7 @@ constructor worker or wrapper we generate S1 :: S -- A top-level unlifted binding S1 = S1 - We allow this top-level unlifted binding to exist, after CorePrep - only. + We allow this top-level unlifted binding to exist. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -627,8 +627,8 @@ For example: The arity might also differ due to unpacking, for example, consider the following datatype and its wrapper and worker's type: data V = MkV !() !Int - $WV :: () -> Int -> V - V :: Int# -> V + $WMkV :: () -> Int -> V + MkV :: Int# -> V As you see, because of unpacking we have both dropped the unit argument and unboxed the Int. In this case, the source arity (which is the arity of the wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -255,20 +255,20 @@ documents that design choice. As an example, consider: - data T a = MkT Int! a Void# + data T a = MkT !Int a Void# The wrapper's representation and the worker's representation (i.e. the datacon's Core representation) are respectively: - $WT :: Int -> a -> Void# -> T a - T :: Int# -> a -> Void# -> T a + $WMkT :: Int -> a -> Void# -> T a + MkT :: Int# -> a -> Void# -> T a T would end up being used in STG post-unarise as: - let x = T 1# y + let x = MkT 1# y in ... case x of - T int a -> ... + MkT int a -> ... The Void# argument is dropped. In essence we only generate binders for runtime relevant values. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d5cd5acadba24f41b74f8fc559bae25abd4e9bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d5cd5acadba24f41b74f8fc559bae25abd4e9bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 13:17:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 09:17:03 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.6 Message-ID: <646776cf27807_9760a23de496453612c@gitlab.mail> Ben Gamari deleted branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 13:17:05 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 09:17:05 -0400 Subject: [Git][ghc/ghc][ghc-9.6] 10 commits: JS: fix getpid (fix #23399) Message-ID: <646776d1b209_9760a23ddf36053636b@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: 5292bdf8 by Sylvain Henry at 2023-05-17T11:43:28-04:00 JS: fix getpid (fix #23399) (cherry picked from commit 2972fd66f91cb51426a1df86b8166a067015e231) - - - - - 6c5fcaba by Josh Meredith at 2023-05-17T11:43:34-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) (cherry picked from commit 5e3f9bb57680a40f6a9531e41dc2617c5f028e5c) - - - - - 86a9404a by Sylvain Henry at 2023-05-17T11:44:06-04:00 Fix GHCJS OS platform (fix #23346) (cherry picked from commit 2f571afe1c2aeb3f4dfca2012bc6b713144fd234) - - - - - 48da24c9 by Simon Peyton Jones at 2023-05-18T16:00:10-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] (cherry picked from commit 902f0730b4c50f39b7767a346be324c98bf7a8a6) - - - - - 74b8e5bd by Alexis King at 2023-05-18T16:00:10-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 (cherry picked from commit d85ed900b271109185251cb0494d51048a4cf213) - - - - - 4949111f by Alexis King at 2023-05-18T16:00:10-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. (cherry picked from commit 59aa4676a49b4f9d09c1cd3cc3b47c3c54b6ed80) - - - - - 27086298 by Krzysztof Gogolewski at 2023-05-18T16:00:10-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. (cherry picked from commit d683b2e5b91a39a2bf16796f5800f605a0281004) - - - - - 5bd85c7d by Ben Gamari at 2023-05-18T16:00:10-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. (cherry picked from commit c6cf9433e3d41e239265eaeff0fd02e6b45d5427) - - - - - 7607986e by sheaf at 2023-05-18T16:00:10-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 (cherry picked from commit c176ad1835ccfe55e2bde875b4a35e9d226ff657) - - - - - eaadcaa7 by Ryan Scott at 2023-05-18T16:00:10-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. (cherry picked from commit e8b72ff6e4aee1f889a9168df57bb1b00168fd21) - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Platform.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Types/Id/Make.hs - hadrian/bindist/Makefile - hadrian/src/Settings/Builders/SplitSections.hs - libraries/base/System/Posix/Internals.hs - libraries/base/tests/Concurrent/all.T - + libraries/base/tests/System/T23399.hs - + libraries/base/tests/System/T23399.stdout - libraries/base/tests/System/all.T - libraries/ghc-boot/GHC/Platform/ArchOS.hs - m4/fptools_set_haskell_platform_vars.m4 - rts/Disassembler.c - rts/Interpreter.c - rts/Printer.c - rts/StgMiscClosures.cmm - rts/include/rts/Bytecodes.h - rts/include/stg/MiscClosures.h - + rts/js/time.js - rts/rts.cabal.in - + testsuite/tests/deriving/should_compile/T23329.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1fdbbd8d81b3b5e80e8997d279764f62cdcc3c26...eaadcaa7ca2b7bb1d4d214339092dd9e6df12a96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1fdbbd8d81b3b5e80e8997d279764f62cdcc3c26...eaadcaa7ca2b7bb1d4d214339092dd9e6df12a96 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 13:57:08 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 19 May 2023 09:57:08 -0400 Subject: [Git][ghc/ghc][wip/test-nightlies] 2 commits: Remove stray dump flags in GHC.Rename.Names Message-ID: <646780345eda9_9760a23de059453999@gitlab.mail> Matthew Pickering pushed to branch wip/test-nightlies at Glasgow Haskell Compiler / GHC Commits: c393da4a by Matthew Pickering at 2023-05-18T10:26:22+01:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4d8ef877 by Matthew Pickering at 2023-05-19T12:23:55+01:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Rename/Names.hs Changes: ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -63,7 +63,8 @@ eprint(f"Supported platforms: {job_mapping.keys()}") # Artifact precisely specifies a job what the bindist to download is called. class Artifact(NamedTuple): job_name: str - name: str + download_name: str + output_name: str subdir: str # Platform spec provides a specification which is agnostic to Job @@ -72,8 +73,14 @@ class PlatformSpec(NamedTuple): name: str subdir: str -source_artifact = Artifact('source-tarball', 'ghc-{version}-src.tar.xz', 'ghc-{version}' ) -test_artifact = Artifact('source-tarball', 'ghc-{version}-testsuite.tar.xz', 'ghc-{version}' ) +source_artifact = Artifact('source-tarball' + , 'ghc-{version}-src.tar.xz' + , 'ghc-{version}-src.tar.xz' + , 'ghc-{version}' ) +test_artifact = Artifact('source-tarball' + , 'ghc-{version}-testsuite.tar.xz' + , 'ghc-{version}-testsuite.tar.xz' + , 'ghc-{version}' ) def debian(arch, n): return linux_platform(arch, "{arch}-linux-deb{n}".format(arch=arch, n=n)) @@ -129,7 +136,7 @@ def download_and_hash(url): def mk_one_metadata(release_mode, version, job_map, artifact): job_id = job_map[artifact.job_name].id - url = base_url.format(job_id=job_id, artifact_name=urllib.parse.quote_plus(artifact.name.format(version=version))) + url = base_url.format(job_id=job_id, artifact_name=urllib.parse.quote_plus(artifact.download_name.format(version=version))) # In --release-mode, the URL in the metadata needs to point into the downloads folder # rather then the pipeline. @@ -143,10 +150,13 @@ def mk_one_metadata(release_mode, version, job_map, artifact): eprint(f"Bindist URL: {url}") eprint(f"Download URL: {final_url}") - # Download and hash from the release pipeline, this must not change anyway during upload. + #Download and hash from the release pipeline, this must not change anyway during upload. h = download_and_hash(url) - res = { "dlUri": final_url, "dlSubdir": artifact.subdir.format(version=version), "dlHash" : h } + res = { "dlUri": final_url + , "dlSubdir": artifact.subdir.format(version=version) + , "dlOutput": artifact.output_name.format(version=version) + , "dlHash" : h } eprint(res) return res @@ -155,7 +165,11 @@ def mk_one_metadata(release_mode, version, job_map, artifact): def mk_from_platform(pipeline_type, platform): info = job_mapping[platform.name][pipeline_type] eprint(f"From {platform.name} / {pipeline_type} selecting {info['name']}") - return Artifact(info['name'] , f"{info['jobInfo']['bindistName']}.tar.xz", platform.subdir) + return Artifact(info['name'] + , f"{info['jobInfo']['bindistName']}.tar.xz" + , "ghc-{version}-{pn}.tar.xz".format(version="{version}", pn=platform.name) + , platform.subdir) + # Generate the new metadata for a specific GHC mode etc def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -12,8 +12,6 @@ Extracting imported and top-level names in scope {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -ddump-to-file -ddump-simpl #-} - module GHC.Rename.Names ( rnImports, getLocalNonValBinders, newRecordFieldLabel, extendGlobalRdrEnvRn, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08bd7063963df86397392b5ef4a7322d715a0b23...4d8ef877b4b8bd65ec0ea211abab0f34a307376c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08bd7063963df86397392b5ef4a7322d715a0b23...4d8ef877b4b8bd65ec0ea211abab0f34a307376c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 13:57:22 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 19 May 2023 09:57:22 -0400 Subject: [Git][ghc/ghc][wip/test-nightlies] ghcup-metadata: Add dlOutput field Message-ID: <6467804212cf4_9760a23dde38454036e@gitlab.mail> Matthew Pickering pushed to branch wip/test-nightlies at Glasgow Haskell Compiler / GHC Commits: 66c609ae by Matthew Pickering at 2023-05-19T14:57:14+01:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 1 changed file: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -63,7 +63,8 @@ eprint(f"Supported platforms: {job_mapping.keys()}") # Artifact precisely specifies a job what the bindist to download is called. class Artifact(NamedTuple): job_name: str - name: str + download_name: str + output_name: str subdir: str # Platform spec provides a specification which is agnostic to Job @@ -72,8 +73,14 @@ class PlatformSpec(NamedTuple): name: str subdir: str -source_artifact = Artifact('source-tarball', 'ghc-{version}-src.tar.xz', 'ghc-{version}' ) -test_artifact = Artifact('source-tarball', 'ghc-{version}-testsuite.tar.xz', 'ghc-{version}' ) +source_artifact = Artifact('source-tarball' + , 'ghc-{version}-src.tar.xz' + , 'ghc-{version}-src.tar.xz' + , 'ghc-{version}' ) +test_artifact = Artifact('source-tarball' + , 'ghc-{version}-testsuite.tar.xz' + , 'ghc-{version}-testsuite.tar.xz' + , 'ghc-{version}' ) def debian(arch, n): return linux_platform(arch, "{arch}-linux-deb{n}".format(arch=arch, n=n)) @@ -129,7 +136,7 @@ def download_and_hash(url): def mk_one_metadata(release_mode, version, job_map, artifact): job_id = job_map[artifact.job_name].id - url = base_url.format(job_id=job_id, artifact_name=urllib.parse.quote_plus(artifact.name.format(version=version))) + url = base_url.format(job_id=job_id, artifact_name=urllib.parse.quote_plus(artifact.download_name.format(version=version))) # In --release-mode, the URL in the metadata needs to point into the downloads folder # rather then the pipeline. @@ -143,10 +150,13 @@ def mk_one_metadata(release_mode, version, job_map, artifact): eprint(f"Bindist URL: {url}") eprint(f"Download URL: {final_url}") - # Download and hash from the release pipeline, this must not change anyway during upload. + #Download and hash from the release pipeline, this must not change anyway during upload. h = download_and_hash(url) - res = { "dlUri": final_url, "dlSubdir": artifact.subdir.format(version=version), "dlHash" : h } + res = { "dlUri": final_url + , "dlSubdir": artifact.subdir.format(version=version) + , "dlOutput": artifact.output_name.format(version=version) + , "dlHash" : h } eprint(res) return res @@ -155,7 +165,11 @@ def mk_one_metadata(release_mode, version, job_map, artifact): def mk_from_platform(pipeline_type, platform): info = job_mapping[platform.name][pipeline_type] eprint(f"From {platform.name} / {pipeline_type} selecting {info['name']}") - return Artifact(info['name'] , f"{info['jobInfo']['bindistName']}.tar.xz", platform.subdir) + return Artifact(info['name'] + , f"{info['jobInfo']['bindistName']}.tar.xz" + , "ghc-{version}-{pn}.tar.xz".format(version="{version}", pn=platform.name) + , platform.subdir) + # Generate the new metadata for a specific GHC mode etc def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c609ae1c60cf6d1bdec1a7e077c0937d3d8ef1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c609ae1c60cf6d1bdec1a7e077c0937d3d8ef1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 14:04:07 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 19 May 2023 10:04:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-ticky Message-ID: <646781d74b716_9760a23de49785443d@gitlab.mail> Matthew Pickering pushed new branch wip/fix-ticky at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-ticky You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 14:05:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 10:05:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/users-guide Message-ID: <646782246c9bd_9760a23dde3485464ac@gitlab.mail> Ben Gamari pushed new branch wip/users-guide at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/users-guide You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 14:05:55 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 10:05:55 -0400 Subject: [Git][ghc/ghc][wip/users-guide] users guide: A few small mark-up fixes Message-ID: <64678243eff47_9760a23de4964546690@gitlab.mail> Ben Gamari pushed to branch wip/users-guide at Glasgow Haskell Compiler / GHC Commits: 61390665 by Ben Gamari at 2023-05-19T10:05:52-04:00 users guide: A few small mark-up fixes - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -25,11 +25,11 @@ given compilation phase: Use ⟨cmd⟩ as the literate pre-processor. .. ghc-flag:: -pgmP ⟨cmd⟩ - :shortdesc: Use ⟨cmd⟩ as the C pre-processor (with ``-cpp`` only) + :shortdesc: Use ⟨cmd⟩ as the C pre-processor (with :ghc-flag:`-cpp` only) :type: dynamic :category: phase-programs - Use ⟨cmd⟩ as the C pre-processor (with ``-cpp`` only). + Use ⟨cmd⟩ as the C pre-processor (with :ghc-flag:`-cpp` only). .. ghc-flag:: -pgmc ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the C compiler @@ -159,11 +159,11 @@ the following flags: Pass ⟨option⟩ to the literate pre-processor .. ghc-flag:: -optP ⟨option⟩ - :shortdesc: pass ⟨option⟩ to cpp (with ``-cpp`` only) + :shortdesc: pass ⟨option⟩ to cpp (with :ghc-flag:`-cpp` only) :type: dynamic :category: phase-options - Pass ⟨option⟩ to CPP (makes sense only if ``-cpp`` is also on). + Pass ⟨option⟩ to CPP (makes sense only if :ghc-flag:`-cpp` is also on). .. ghc-flag:: -optF ⟨option⟩ :shortdesc: pass ⟨option⟩ to the custom pre-processor @@ -308,9 +308,9 @@ Options affecting the C pre-processor :category: cpp The C pre-processor :command:`cpp` is run over your Haskell code if - the ``-cpp`` option or ``-XCPP`` extension are given. Unless you are building a - large system with significant doses of conditional compilation, you - really shouldn't need it. + the :ghc-flag:`-cpp` option or :extension:`CPP` extension are given. Unless + you are building a large system with significant doses of conditional + compilation, you really shouldn't need it. .. ghc-flag:: -D⟨symbol⟩[=⟨value⟩] :shortdesc: Define a symbol in the C pre-processor View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6139066574ec43f07843ead6aef389decaefd955 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6139066574ec43f07843ead6aef389decaefd955 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 14:08:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 May 2023 10:08:54 -0400 Subject: [Git][ghc/ghc][master] Make Warn = Located DriverMessage Message-ID: <646782f695758_9760a23dde34855209f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Types/Error/Codes.hs - ghc/GHCi/UI.hs - ghc/Main.hs - testsuite/tests/backpack/should_compile/bkp09.stderr - testsuite/tests/backpack/should_compile/bkp15.stderr - testsuite/tests/deSugar/should_compile/ds041.stderr - testsuite/tests/deriving/should_compile/T20501.stderr - testsuite/tests/deriving/should_compile/T4325.stderr - testsuite/tests/deriving/should_compile/T4966.stderr - testsuite/tests/deriving/should_compile/drv-foldable-traversable1.stderr - testsuite/tests/deriving/should_compile/drv-functor1.stderr - testsuite/tests/deriving/should_fail/drvfail-functor2.stderr - testsuite/tests/driver/T11429a.stderr - testsuite/tests/driver/T11429c.stderr - testsuite/tests/driver/T12056b.stderr - testsuite/tests/driver/T12056c.stderr - testsuite/tests/driver/T20436/T20436.stderr - testsuite/tests/driver/T21682.stderr - testsuite/tests/driver/T2464.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bca0486232b5f0cf6f5a396b16d52e5db55fb9a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bca0486232b5f0cf6f5a396b16d52e5db55fb9a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 14:09:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 May 2023 10:09:34 -0400 Subject: [Git][ghc/ghc][master] Type inference for data family newtype instances Message-ID: <6467831ebefae_9760a23de4964555711@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - 3 changed files: - compiler/GHC/Tc/Solver/Equality.hs - + testsuite/tests/indexed-types/should_compile/T23408.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -205,15 +205,22 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel -- Decompose type constructor applications -- NB: we have expanded type synonyms already -can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ +can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ | Just (tc1, tys1) <- tcSplitTyConApp_maybe ty1 , Just (tc2, tys2) <- tcSplitTyConApp_maybe ty2 - -- we want to catch e.g. Maybe Int ~ (Int -> Int) here for better - -- error messages rather than decomposing into AppTys; - -- hence no direct match on TyConApp - , not (isTypeFamilyTyCon tc1) - , not (isTypeFamilyTyCon tc2) - = canTyConApp ev eq_rel tc1 tys1 tc2 tys2 + -- tcSplitTyConApp_maybe: we want to catch e.g. Maybe Int ~ (Int -> Int) + -- here for better error messages rather than decomposing into AppTys; + -- hence not using a direct match on TyConApp + + , not (isTypeFamilyTyCon tc1 || isTypeFamilyTyCon tc2) + -- A type family at the top of LHS or RHS: we want to fall through + -- to the canonical-LHS cases (look for canEqLHS_maybe) + + -- See (TC1) in Note [Canonicalising TyCon/TyCon equalities] + , let role = eqRelRole eq_rel + both_generative = isGenerativeTyCon tc1 role && isGenerativeTyCon tc2 role + , rewritten || both_generative + = canTyConApp ev eq_rel both_generative tc1 tys1 tc2 tys2 can_eq_nc' _rewritten _rdr_env _envs ev eq_rel s1@(ForAllTy (Bndr _ vis1) _) _ @@ -248,7 +255,7 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 -- Only rewritten types end up below here. ---------------------------- --- NB: pattern match on True: we want only rewritten types sent to canEqLHS +-- NB: pattern match on rewritten=True: we want only rewritten types sent to canEqLHS -- This means we've rewritten any variables and reduced any type family redexes -- See also Note [No top-level newtypes on RHS of representational equalities] can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 @@ -278,7 +285,7 @@ can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 ; case eq_rel of -- See Note [Unsolved equalities] ReprEq -> solveIrredEquality ReprEqReason ev NomEq -> solveIrredEquality ShapeMismatchReason ev } - -- No need to call canEqFailure/canEqHardFailure because they + -- No need to call canEqSoftFailure/canEqHardFailure because they -- rewrite, and the types involved here are already rewritten @@ -720,33 +727,31 @@ canEqCast rewritten ev eq_rel swapped ty1 co1 ty2 ps_ty2 ------------------------ canTyConApp :: CtEvidence -> EqRel + -> Bool -- Both TyCons are generative -> TyCon -> [TcType] -> TyCon -> [TcType] -> TcS (StopOrContinue Ct) -- See Note [Decomposing TyConApp equalities] -- Neither tc1 nor tc2 is a saturated funTyCon, nor a type family -- But they can be data families. -canTyConApp ev eq_rel tc1 tys1 tc2 tys2 +canTyConApp ev eq_rel both_generative tc1 tys1 tc2 tys2 | tc1 == tc2 , tys1 `equalLength` tys2 = do { inerts <- getTcSInerts ; if can_decompose inerts then canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 - else canEqFailure ev eq_rel ty1 ty2 } + else canEqSoftFailure ev eq_rel ty1 ty2 } -- See Note [Skolem abstract data] in GHC.Core.Tycon | tyConSkolem tc1 || tyConSkolem tc2 = do { traceTcS "canTyConApp: skolem abstract" (ppr tc1 $$ ppr tc2) ; solveIrredEquality AbstractTyConReason ev } - -- Fail straight away for better error messages - -- See Note [Use canEqFailure in canDecomposableTyConApp] - | eq_rel == ReprEq && not (isGenerativeTyCon tc1 Representational && - isGenerativeTyCon tc2 Representational) - = canEqFailure ev eq_rel ty1 ty2 - - | otherwise - = canEqHardFailure ev ty1 ty2 + | otherwise -- Different TyCons + = if both_generative -- See (TC2) and (TC3) in + -- Note [Canonicalising TyCon/TyCon equalities] + then canEqHardFailure ev ty1 ty2 + else canEqSoftFailure ev eq_rel ty1 ty2 where -- Reconstruct the types for error messages. This would do -- the wrong thing (from a pretty printing point of view) @@ -768,37 +773,42 @@ canTyConApp ev eq_rel tc1 tys1 tc2 tys2 ctEvFlavour ev == Wanted && noGivenNewtypeReprEqs tc1 inerts) -- See Note [Decomposing newtype equalities] (EX2) -{- -Note [Use canEqFailure in canDecomposableTyConApp] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We must use canEqFailure, not canEqHardFailure here, because there is -the possibility of success if working with a representational equality. -Here is one case: +{- Note [Canonicalising TyCon/TyCon equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int -Suppose we are canonicalising (Int ~R DF (TF a)), where we don't yet -know `a`. This is *not* a hard failure, because we might soon learn -that `a` is, in fact, Char, and then the equality succeeds. +Suppose we are canonicalising [W] Int ~R# DF (TF a). Then -Here is another case: +(TC1) We might have an inert Given (a ~# Char), so if we rewrote the wanted + (i.e. went around again in `can_eq_nc` with `rewritten`=True, we'd get + [W] Int ~R# DF Bool + and then the `tcTopNormaliseNewTypeTF_maybe` call would fire and + we'd unwrap the newtype. So we must do that "go round again" bit. + Hence the complicated guard (rewritten || both_generative) in `can_eq_nc`. - [G] Age ~R Int +(TC2) If we can't rewrite `a` yet, we'll finish with an unsolved + [W] Int ~R# DF (TF a) + in the inert set. But we must use canEqSoftFailure, not canEqHardFailure, + because it might be solved "later" when we learn more about `a`. + Hence the use of `both_generative` in `canTyConApp`. -where Age's constructor is not in scope. We don't want to report -an "inaccessible code" error in the context of this Given! +(TC3) Here's another example: + [G] Age ~R# Int + where Age's constructor is not in scope. We don't want to report + an "inaccessible code" error in the context of this Given! So again + we want `canEqSoftFailure`. -For example, see typecheck/should_compile/T10493, repeated here: + For example, see typecheck/should_compile/T10493, repeated here: + import Data.Ord (Down) -- no constructor + foo :: Coercible (Down Int) Int => Down Int -> Int + foo = coerce - import Data.Ord (Down) -- no constructor - - foo :: Coercible (Down Int) Int => Down Int -> Int - foo = coerce - -That should compile, but only because we use canEqFailure and not -canEqHardFailure. + That should compile, but only because we use canEqSoftFailure and + not canEqHardFailure. Note [Fast path when decomposing TyConApps] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1289,20 +1299,19 @@ canDecomposableFunTy ev eq_rel af f1@(m1,a1,r1) f2@(m2,a2,r2) loc = ctEvLoc ev role = eqRelRole eq_rel --- | Call when canonicalizing an equality fails, but if the equality is --- representational, there is some hope for the future. --- Examples in Note [Use canEqFailure in canDecomposableTyConApp] -canEqFailure :: CtEvidence -> EqRel - -> TcType -> TcType -> TcS (StopOrContinue Ct) -canEqFailure ev NomEq ty1 ty2 +-- | Call canEqSoftFailure when canonicalizing an equality fails, but if the +-- equality is representational, there is some hope for the future. +canEqSoftFailure :: CtEvidence -> EqRel + -> TcType -> TcType -> TcS (StopOrContinue Ct) +canEqSoftFailure ev NomEq ty1 ty2 = canEqHardFailure ev ty1 ty2 -canEqFailure ev ReprEq ty1 ty2 +canEqSoftFailure ev ReprEq ty1 ty2 = do { (redn1, rewriters1) <- rewrite ev ty1 ; (redn2, rewriters2) <- rewrite ev ty2 -- We must rewrite the types before putting them in the -- inert set, so that we are sure to kick them out when -- new equalities become available - ; traceTcS "canEqFailure with ReprEq" $ + ; traceTcS "canEqSoftFailure with ReprEq" $ vcat [ ppr ev, ppr redn1, ppr redn2 ] ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 ; continueWith (mkIrredCt ReprEqReason new_ev) } ===================================== testsuite/tests/indexed-types/should_compile/T23408.hs ===================================== @@ -0,0 +1,42 @@ +{-# LANGUAGE TypeFamilies, TypeApplications, GADTs, FunctionalDependencies, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} + +module T23408 where + +import Data.Coerce +import Data.Proxy + +f :: Proxy a -> Key a -> Maybe () +f _ _ = Nothing + +g :: Key a -> Proxy a -> Maybe () +g _ _ = Nothing + +data User + +data family Key a + +newtype instance Key User = UserKey String + +class Convert lhs result where + convert :: Proxy lhs -> Proxy result + +instance (rec ~ rec') => Convert rec rec' where + convert _ = Proxy + +a :: Maybe () +a = f (convert @User Proxy) (coerce "asdf") + +{- Typechecking `a` + + convert @User Proxy :: Proxy alpha + [W] Convert User alpha + coerce "asdf" :: Key alpha + [W] Coercible String (Key alpha) + + Solve [W] Convert User alpha ==> [W] User ~ alpha + [W] Coercible String (Key User) +-} + +b :: Maybe () +b = g (coerce "asdf") (convert @User Proxy) + ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -308,3 +308,4 @@ test('T4254', normal, compile, ['']) test('T22547', normal, compile, ['']) test('T22717', normal, makefile_test, ['T22717']) test('T22717_fam_orph', normal, multimod_compile, ['T22717_fam_orph', '-v0']) +test('T23408', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/525ed55400d49e36a7953047c93c8f6731dd7f72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/525ed55400d49e36a7953047c93c8f6731dd7f72 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 14:13:39 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 19 May 2023 10:13:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/docs-ghc-ticket Message-ID: <64678413e3ccd_9760a200dba7c555971@gitlab.mail> Matthew Pickering pushed new branch wip/docs-ghc-ticket at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/docs-ghc-ticket You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 14:14:01 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 19 May 2023 10:14:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-ticket-directive Message-ID: <646784294dff5_9760a35c228f85561d3@gitlab.mail> Matthew Pickering pushed new branch wip/ghc-ticket-directive at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-ticket-directive You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 14:32:59 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 19 May 2023 10:32:59 -0400 Subject: [Git][ghc/ghc][wip/users-guide] 14 commits: Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <6467889b1c861_9760a23de0594564579@gitlab.mail> Matthew Pickering pushed to branch wip/users-guide at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - 9765af3a by Ben Gamari at 2023-05-19T14:32:53+00:00 users guide: A few small mark-up fixes - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/ghci.rst - docs/users_guide/phases.rst - ghc/GHCi/UI.hs - ghc/Main.hs - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - + libraries/base/tests/T13660.hs - + libraries/base/tests/T13660.stdout - libraries/base/tests/all.T - m4/fp_ld_supports_response_files.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6139066574ec43f07843ead6aef389decaefd955...9765af3aa272d3f48f8fae1cf4168dbcc8fab741 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6139066574ec43f07843ead6aef389decaefd955...9765af3aa272d3f48f8fae1cf4168dbcc8fab741 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 15:42:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 11:42:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/split-ghc-base Message-ID: <64679903b9b5a_9760a3611a2485806d4@gitlab.mail> Ben Gamari pushed new branch wip/split-ghc-base at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/split-ghc-base You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 16:10:39 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 May 2023 12:10:39 -0400 Subject: [Git][ghc/ghc][wip/T23109] Wibbles Message-ID: <64679f7f5e0f4_9760a3687e6385863c6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 76f92e51 by Simon Peyton Jones at 2023-05-19T17:12:19+01:00 Wibbles - - - - - 5 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Tc/TyCl/Instance.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -45,7 +45,7 @@ module GHC.Core.Coercion ( mkPhantomCo, mkHoleCo, mkUnivCo, mkSubCo, mkAxiomInstCo, mkProofIrrelCo, - downgradeRole, mkAxiomRuleCo, + downgradeRole, upgradeRole, mkAxiomRuleCo, mkGReflRightCo, mkGReflLeftCo, mkCoherenceLeftCo, mkCoherenceRightCo, mkKindCo, castCoercionKind, castCoercionKind1, castCoercionKind2, @@ -75,7 +75,7 @@ module GHC.Core.Coercion ( coToMCo, mkTransMCo, mkTransMCoL, mkTransMCoR, mkCastTyMCo, mkSymMCo, mkHomoForAllMCo, mkFunResMCo, mkPiMCos, - isReflMCo, checkReflexiveMCo, + isReflMCo, checkReflexiveMCo, isSubCo_maybe, -- ** Coercion variables mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique, @@ -1305,6 +1305,10 @@ mkSubCo co@(FunCo { fco_role = Nominal, fco_arg = arg, fco_res = res }) mkSubCo co = assertPpr (coercionRole co == Nominal) (ppr co <+> ppr (coercionRole co)) $ SubCo co +isSubCo_maybe :: Coercion -> Maybe Coercion +isSubCo_maybe (SubCo co) = Just co +isSubCo_maybe co = Nothing + -- | Changes a role, but only a downgrade. See Note [Role twiddling functions] downgradeRole_maybe :: Role -- ^ desired role -> Role -- ^ current role @@ -1332,6 +1336,10 @@ downgradeRole r1 r2 co Just co' -> co' Nothing -> pprPanic "downgradeRole" (ppr co) +upgradeRole :: Coercion -> Coercion +upgradeRole (SubCo co) = co +upgradeRole co = co + mkAxiomRuleCo :: CoAxiomRule -> [Coercion] -> Coercion mkAxiomRuleCo = AxiomRuleCo ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2411,8 +2411,11 @@ lintCoercion the_co@(SelCo cs co) ; return (SelCo cs co') } | otherwise - -> failWithL (hang (text "Bad SelCo:") - 2 (ppr the_co $$ ppr s $$ ppr t)) } + -> failWithL $ hang (text "Bad SelCo:") 2 $ + vcat [ text "the_co:" <+> ppr the_co + , text "lhs type:" <+> ppr s + , text "rhs type:" <+> ppr t + , text "role:" <+> ppr co_role ] } lintCoercion the_co@(LRCo lr co) = do { co' <- lintCoercion co ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -52,7 +52,7 @@ import GHC.Core import GHC.Core.FVs import GHC.Core.Utils import GHC.Core.DataCon -import GHC.Core.TyCon ( tyConArity ) +import GHC.Core.TyCon ( TyCon, tyConArity, isInjectiveTyCon ) import GHC.Core.TyCon.RecWalk ( initRecTc, checkRecTc ) import GHC.Core.Predicate ( isDictTy, isEvVar, isCallStackPredTy ) import GHC.Core.Multiplicity @@ -2952,39 +2952,17 @@ pushCoDataCon dc dc_args co -- where S is a type function. In fact, exprIsConApp -- will probably not be called in such circumstances, -- but there's nothing wrong with it - - = let - tc_arity = tyConArity to_tc - dc_univ_tyvars = dataConUnivTyVars dc - dc_ex_tcvars = dataConExTyCoVars dc - arg_tys = dataConRepArgTys dc - - non_univ_args = dropList dc_univ_tyvars dc_args - (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args - - -- Make the "Psi" from the paper - omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc) - (psi_subst, to_ex_arg_tys) - = liftCoSubstWithEx Representational - dc_univ_tyvars - omegas - dc_ex_tcvars - (map exprToType ex_args) - - -- Cast the value arguments (which include dictionaries) - new_val_args = zipWith cast_arg (map scaledThing arg_tys) val_args - cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty) - - to_ex_args = map Type to_ex_arg_tys - - dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tcvars, - ppr arg_tys, ppr dc_args, - ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc - , ppr $ mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) ] - in - assertPpr (eqType from_ty (mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args))) dump_doc $ - assertPpr (equalLength val_args arg_tys) dump_doc $ - Just (dc, to_tc_arg_tys, to_ex_args ++ new_val_args) + = case isSubCo_maybe co of + Just co' -> Just (push_data_con to_tc to_tc_arg_tys dc dc_args co') + _ | isInjectiveTyCon to_tc Representational + -> Just (push_data_con to_tc to_tc_arg_tys dc dc_args co) + | otherwise + -> pprTrace "Yikes" + (vcat [ text "Scrut:" <+> ppr dc <+> ppr dc_args + , text "Co:" <+> ppr co + , text "of type:" <+> ppr (coercionType co) + , text "role:" <+> ppr (coercionRole co) ]) + Nothing | otherwise = Nothing @@ -2992,6 +2970,45 @@ pushCoDataCon dc dc_args co where Pair from_ty to_ty = coercionKind co +push_data_con :: TyCon -> [Type] -> DataCon -> [CoreExpr] -> Coercion + -> (DataCon, [Type], [CoreExpr]) +push_data_con to_tc to_tc_arg_tys dc dc_args co + = assertPpr (eqType from_ty dc_app_ty) dump_doc $ + assertPpr (equalLength val_args arg_tys) dump_doc $ + assertPpr (isInjectiveTyCon to_tc (coercionRole co)) dump_doc $ + (dc, to_tc_arg_tys, to_ex_args ++ new_val_args) + where + Pair from_ty to_ty = coercionKind co + tc_arity = tyConArity to_tc + dc_univ_tyvars = dataConUnivTyVars dc + dc_ex_tcvars = dataConExTyCoVars dc + arg_tys = dataConRepArgTys dc + + dc_app_ty = mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) + + non_univ_args = dropList dc_univ_tyvars dc_args + (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args + + -- Make the "Psi" from the paper + omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc) + (psi_subst, to_ex_arg_tys) + = liftCoSubstWithEx Representational + dc_univ_tyvars + omegas + dc_ex_tcvars + (map exprToType ex_args) + + -- Cast the value arguments (which include dictionaries) + new_val_args = zipWith cast_arg (map scaledThing arg_tys) val_args + cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty) + + to_ex_args = map Type to_ex_arg_tys + + dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tcvars, + ppr arg_tys, ppr dc_args, + ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc + , ppr $ mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) ] + collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) -- Collect lambda binders, pushing coercions inside if possible -- E.g. (\x.e) |> g g :: -> blah @@ -3047,7 +3064,33 @@ collectBindersPushingCo e | otherwise = (reverse bs, mkCast (Lam b e) co) -{- +{- Note [pushCoDataCon for newtypes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + newtype N a = MkN (Maybe a) +and the expression + MkN @Int e |> co +where + d :: Maybe Int + co :: N Int ~R# N T is a coercion + +Then can we use pushCoDataCon to transform this to + MkInt @T (e |> Maybe co') +where + (co' : Int ~R# T) = SelCo (SelTc 0 R) co + +Well, no. Look at Note [SelCo] in GHC.Core.TyCo.Rep, and especially +Note [SelCo and newtypes]. We can't use SelCo on a representational +coercion for a newtype -- it is not injective. + +But what if it happens that co = Sub co2 where + co2 : N Int ~N# N T +Well, now we *can* use co2 to give + MkInt @T (e |> Maybe (Sub co')) +where + (co' : Int ~N# T) = SelCo (SelTc 0 N) co2 + +This is a rather common case. Note [collectBindersPushingCo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -938,7 +938,7 @@ instance Outputable Coercion where ppr = pprCo instance Outputable CoSel where - ppr (SelTyCon n _r) = text "Tc" <> parens (int n) + ppr (SelTyCon n r) = text "Tc" <> parens (int n <> comma <> ppr r) ppr SelForAll = text "All" ppr (SelFun fs) = text "Fun" <> parens (ppr fs) @@ -1045,19 +1045,21 @@ The Coercion form SelCo allows us to decompose a structural coercion, one between ForallTys, or TyConApps, or FunTys. There are three forms, split by the CoSel field inside the SelCo: -SelTyCon, SelForAll, and SelFun. +SelTyCon, SelForAll, and SelFun. The typing rules below are directly +checked by the SelCo case of GHC.Core.Lint.lintCoercion. * SelTyCon: - co : (T s1..sn) ~r0 (T t1..tn) - T is a data type, not a newtype, nor an arrow type - r = tyConRole tc r0 i + co : (T s1..sn) ~r (T t1..tn) + T is not a saturated FunTyCon (use SelFun for that) + T is injective at role r + ri = tyConRole tc r i i < n (i is zero-indexed) ---------------------------------- - SelCo (SelTyCon i r) : si ~r ti + SelCo (SelTyCon i ri) : si ~ri ti - "Not a newtype": see Note [SelCo and newtypes] - "Not an arrow type": see SelFun below + "Injective at role r": see Note [SelCo and newtypes] + "Not saturated FunTyCon": see SelFun below See Note [SelCo Cached Roles] @@ -1360,6 +1362,10 @@ SelCo, we'll get out a representational coercion. That is: Yikes! Clearly, this is terrible. The solution is simple: forbid SelCo to be used on newtypes if the internal coercion is representational. +More specifically, we use isInjectiveTyCon to determine whether +T is injective at role r: +* Newtypes and datatypes are both injective at Nominal role, but +* Newtypes are not injective at Representational role See the SelCo equation for GHC.Core.Lint.lintCoercion. This is not just some corner case discovered by a segfault somewhere; ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -54,9 +54,10 @@ import GHC.Tc.Utils.Unify import GHC.Builtin.Names ( unsatisfiableIdName ) import GHC.Core ( Expr(..), mkApps, mkVarApps, mkLams ) import GHC.Core.Make ( nO_METHOD_BINDING_ERROR_ID ) -import GHC.Core.Unfold.Make ( mkInlineUnfoldingWithArity, mkDFunUnfolding ) +-- import GHC.Core.Unfold.Make ( mkInlineUnfoldingWithArity, mkDFunUnfolding ) +import GHC.Core.Unfold.Make (mkDFunUnfolding ) import GHC.Core.Type -import GHC.Core.SimpleOpt +-- import GHC.Core.SimpleOpt import GHC.Core.Predicate( classMethodInstTy ) import GHC.Tc.Types.Evidence import GHC.Core.TyCon @@ -1314,7 +1315,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) inst_tv_tys = mkTyVarTys inst_tyvars arg_wrapper = mkWpEvVarApps dfun_ev_vars <.> mkWpTyApps inst_tv_tys - is_newtype = isNewTyCon class_tc +-- is_newtype = isNewTyCon class_tc dfun_id_w_prags = addDFunPrags dfun_id sc_meth_ids dfun_spec_prags -- | is_newtype = SpecPrags [] @@ -1361,8 +1362,8 @@ addDFunPrags dfun_id sc_meth_ids = dfun_id `setIdUnfolding` mkDFunUnfolding dfun_bndrs dict_con dict_args `setInlinePragma` dfunInlinePragma where - con_app = mkLams dfun_bndrs $ - mkApps (Var (dataConWrapId dict_con)) dict_args +-- con_app = mkLams dfun_bndrs $ +-- mkApps (Var (dataConWrapId dict_con)) dict_args -- This application will satisfy the Core invariants -- from Note [Representation polymorphism invariants] in GHC.Core, -- because typeclass method types are never unlifted. @@ -1374,7 +1375,7 @@ addDFunPrags dfun_id sc_meth_ids dfun_bndrs = dfun_tvs ++ ev_ids clas_tc = classTyCon clas dict_con = tyConSingleDataCon clas_tc - is_newtype = isNewTyCon clas_tc +-- is_newtype = isNewTyCon clas_tc wrapId :: HsWrapper -> Id -> HsExpr GhcTc wrapId wrapper id = mkHsWrap wrapper (HsVar noExtField (noLocA id)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76f92e51618db5fb3b09167fbd12957c7743ec2d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76f92e51618db5fb3b09167fbd12957c7743ec2d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 16:21:39 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 19 May 2023 12:21:39 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement MO_S_Shr and truncateReg Message-ID: <6467a213b2a33_9760a364c017c5923e7@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: c1413de1 by Sven Tennie at 2023-05-19T18:19:28+02:00 Implement MO_S_Shr and truncateReg These store and load on the stack to move values in changed widths into registers. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -707,30 +707,25 @@ getRegister' config plat expr (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do + CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | fitsIn12bitImm n -> do (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n))))) - CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do + return $ Any (intFormat w) (\dst -> + code_x `appOL` toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w))) + , STR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) + , LDR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) + , ADD sp sp (OpImm (ImmInt (widthInBits w))) + , ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) + ]) + CmmMachOp (MO_S_Shr w) [x, y] -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n))))) - CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - + return $ Any (intFormat w) (\dst -> + code_x `appOL` code_y `appOL` toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w))) + , STR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) + , LDR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) + , ADD sp sp (OpImm (ImmInt (widthInBits w))) + , ASR (OpReg w dst) (OpReg w reg_y) (OpImm (ImmInteger 0)) + ]) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x @@ -1010,15 +1005,14 @@ signExtendReg w w' r = -- | Instructions to truncate the value in the given register from width @w@ -- down to width @w'@. truncateReg :: Width -> Width -> Reg -> OrdList Instr +truncateReg w _w' _r | w == W64 = nilOL +truncateReg w w' _r | w == w' = nilOL truncateReg w w' r = - case w of - W64 -> nilOL - W32 - | w' == W32 -> nilOL - _ -> unitOL $ UBFM (OpReg w r) - (OpReg w r) - (OpImm (ImmInt 0)) - (OpImm $ ImmInt $ widthInBits w' - 1) + toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w))) + , STR (intFormat w) (OpReg w r) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) + , LDR (intFormat w') (OpReg w' r) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) + , ADD sp sp (OpImm (ImmInt (widthInBits w))) + ] -- ----------------------------------------------------------------------------- -- The 'Amode' type: Memory addressing modes passed up the tree. ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -783,6 +783,7 @@ data Operand | OpRegExt Width Reg ExtMode ExtShift -- rm, [, ] | OpRegShift Width Reg ShiftMode RegShift -- rm, , <0-64> | OpImm Imm -- immediate value + -- TODO: Does OpImmShift exist in RV64? | OpImmShift Imm ShiftMode RegShift | OpAddr AddrMode -- memory reference deriving (Eq, Show) ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -498,6 +498,7 @@ pprInstr platform instr = case instr of AND o1 o2 o3 -> op3 (text "\tand") o1 o2 o3 OR o1 o2 o3 -> op3 (text "\tor") o1 o2 o3 -- ANDS o1 o2 o3 -> op3 (text "\tands") o1 o2 o3 + ASR o1 o2 o3 | isImmOp o3 -> op3 (text "\tsrai") o1 o2 o3 ASR o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3 BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3 BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1413de14cfda8cd9cbe6197714f77e74c7f60a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1413de14cfda8cd9cbe6197714f77e74c7f60a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 17:16:04 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 19 May 2023 13:16:04 -0400 Subject: [Git][ghc/ghc][wip/expand-do] disallow overlapping warnings in do expansion generated match equations Message-ID: <6467aed46e38e_9760a3687e6385992fb@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 0c59c4e0 by Apoorv Ingle at 2023-05-19T12:13:47-05:00 disallow overlapping warnings in do expansion generated match equations - - - - - 8 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Types/Hint.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) - -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -345,8 +345,8 @@ subordinates env instMap decl = case decl of InstD _ (ClsInstD _ d) -> let data_fams = do DataFamInstDecl { dfid_eqn = - (FamEqn { feqn_tycon = L l _ - , feqn_rhs = defn })} <- unLoc <$> cid_datafam_insts d + FamEqn { feqn_tycon = L l _ + , feqn_rhs = defn }} <- unLoc <$> cid_datafam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn ty_fams = do TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ }) } <- unLoc <$> cid_tyfam_insts d ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -28,7 +28,7 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) -import GHC.Types.Basic ( Origin(..), isGenerated ) +import GHC.Types.Basic ( Origin(..), isGenerated, GenReason (..)) import GHC.Types.SourceText import GHC.Driver.Session import GHC.Hs @@ -788,12 +788,13 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. -- Each Match will split off one Nablas for its RHSs from this. ; tracePm "matchWrapper" (vcat [ ppr ctxt + , text "scrs" <+> ppr scrs , text "matches group" <+> ppr matches , text "matchPmChecked" <+> ppr (isMatchContextPmChecked dflags origin ctxt)]) ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt then addHsScrutTmCs (concat scrs) new_vars $ -- See Note [Long-distance information] - pmcMatches (DsMatchContext ctxt locn) new_vars matches + pmcMatches origin (DsMatchContext ctxt locn) new_vars matches else pure (initNablasMatches matches) ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas @@ -814,7 +815,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource + , eqn_orig = origin -- Not all equations are from source , eqn_rhs = match_result } } handleWarnings = if isGenerated origin @@ -834,7 +835,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' is_pat_syn_match (Generated _) (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat is_pat_syn_match _ _ = False non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool - non_wc (Generated _) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc (Generated DoExpansion) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False non_wc _ _ = True matchEquations :: HsMatchContext GhcRn ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -50,7 +50,7 @@ import GHC.HsToCore.Pmc.Utils import GHC.HsToCore.Pmc.Desugar import GHC.HsToCore.Pmc.Check import GHC.HsToCore.Pmc.Solver -import GHC.Types.Basic (Origin(..)) +import GHC.Types.Basic (Origin(..), isDoExpansionGenerated) import GHC.Core (CoreExpr) import GHC.Driver.Session import GHC.Hs @@ -146,12 +146,13 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- checks and @-XEmptyCase@ with only a single match variable. -- See Note [Checking EmptyCase]. pmcMatches - :: DsMatchContext -- ^ Match context, for warnings messages + :: Origin + -> DsMatchContext -- ^ Match context, for warnings messages -> [Id] -- ^ Match variables, i.e. x and y above -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. -pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do +pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do -- We have to force @missing@ before printing out the trace message, -- otherwise we get interleaved output from the solver. This function -- should be strict in @missing@ anyway! @@ -175,7 +176,9 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do result <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result + when (not (isDoExpansionGenerated origin)) + ({-# SCC "formatReportWarnings" #-} + formatReportWarnings ReportMatchGroup ctxt vars result) return (NE.toList (ldiMatchGroup (cr_ret result))) {- Note [pmcPatBind only checks PatBindRhs] ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -120,8 +120,10 @@ isMatchContextPmChecked dflags origin kind -- are enabled, in which case we need to run the pattern match checker. needToRunPmCheck :: DynFlags -> Origin -> Bool needToRunPmCheck dflags origin + | isDoExpansionGenerated origin + = False | isGenerated origin - = True + = True | otherwise = notNull (filter (`wopt` dflags) allPmCheckWarnings) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -408,26 +408,24 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr (HsDo _ doFlav@(DoExpr{}) (L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty + -- Do expansion on the fly + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; traceTc "tcDoStmts doExpr" (vcat [ text "original:" <+> ppr expanded_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expanded_do_expr res_ty } -tcExpr (HsDo _ doFlav@(MDoExpr{}) (L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty + -- Do expansion on the fly + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; traceTc "tcDoStmts mDoExpr" (vcat [ text "original:" <+> ppr expanded_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expanded_do_expr res_ty } tcExpr (HsDo _ do_or_lc stmts) res_ty ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1644,10 +1644,8 @@ isIrrefutableHsPatRn tc_env is_strict pat = go (AsPat _ _ _ pat) = goL pat go (ViewPat _ _ pat) = goL pat go (SigPat _ pat _) = goL pat - go (TuplePat _ pats _) = - do traceTc "isIrrefutableHsPatRn TuplePat" empty - foldM (\a p -> do {b <- goL p; return (a && b)}) True pats - + go (TuplePat _ pats _) = do bs <- mapM goL pats + return (and bs) go (SumPat {}) = return False -- See Note [Unboxed sum patterns aren't irrefutable] go (ListPat {}) = return False @@ -1656,31 +1654,21 @@ isIrrefutableHsPatRn tc_env is_strict pat = { pat_con = L _ dcName , pat_args = details }) = do { tyth <- tcLookupGlobal dcName - ; traceTc "isIrrefutableHsPatRn dataCon" (ppr tyth) + ; traceTc "isIrrefutableHsPatRn TyThing" (ppr tyth) ; case tyth of (ATyCon tycon) -> - do { b <- foldM (\a p -> do {b <- goL p; return (a && b)}) True (hsConPatArgs details) - ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon - , ppr (isNewTyCon tycon) - , ppr (tcHasFixedRuntimeRep tycon)]) + do { bs <- mapM goL (hsConPatArgs details) ; let b' = isJust (tyConSingleDataCon_maybe tycon) - ; return (b && b') } - id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + ; return (b' && and bs) } (AConLike cl) -> case cl of RealDataCon dc -> do let tycon = dataConTyCon dc - b <- foldM (\a p -> do {b <- goL p; return (a && b)}) - True (hsConPatArgs details) - traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon - , ppr (isNewTyCon tycon) - , ppr (tcHasFixedRuntimeRep tycon)] ) let b' = isJust (tyConSingleDataCon_maybe tycon) - return (b && b') - PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) - return False -- conservative - - ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + bs <- mapM goL (hsConPatArgs details) + return (b' && and bs) + PatSynCon _pat -> return False -- conservative + _ -> pprPanic "isIrrefutableHsPatRn" (ppr tyth) } go (LitPat {}) = do traceTc "isIrrefutableHsPatRn LitPat" empty return False ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic -import {-# SOURCE #-} Language.Haskell.Syntax.Expr +import Language.Haskell.Syntax.Expr import GHC.Unit.Module.Imported (ImportedModsVal) import GHC.Data.FastString (fsLit) import Language.Haskell.Syntax (LPat, LIdP) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c59c4e0235c3b3ea8e8f83261268e8f08a277db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c59c4e0235c3b3ea8e8f83261268e8f08a277db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 17:24:18 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 19 May 2023 13:24:18 -0400 Subject: [Git][ghc/ghc][wip/expand-do] disallow overlapping warnings in do expansion generated match equations Message-ID: <6467b0c2e6234_9760a3687e5fc59987d@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: b464815c by Apoorv Ingle at 2023-05-19T12:24:10-05:00 disallow overlapping warnings in do expansion generated match equations - - - - - 9 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Types/Hint.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) - -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -345,8 +345,8 @@ subordinates env instMap decl = case decl of InstD _ (ClsInstD _ d) -> let data_fams = do DataFamInstDecl { dfid_eqn = - (FamEqn { feqn_tycon = L l _ - , feqn_rhs = defn })} <- unLoc <$> cid_datafam_insts d + FamEqn { feqn_tycon = L l _ + , feqn_rhs = defn }} <- unLoc <$> cid_datafam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn ty_fams = do TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ }) } <- unLoc <$> cid_tyfam_insts d ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -28,7 +28,7 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) -import GHC.Types.Basic ( Origin(..), isGenerated ) +import GHC.Types.Basic ( Origin(..), isGenerated, GenReason (..)) import GHC.Types.SourceText import GHC.Driver.Session import GHC.Hs @@ -788,12 +788,13 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. -- Each Match will split off one Nablas for its RHSs from this. ; tracePm "matchWrapper" (vcat [ ppr ctxt + , text "scrs" <+> ppr scrs , text "matches group" <+> ppr matches , text "matchPmChecked" <+> ppr (isMatchContextPmChecked dflags origin ctxt)]) ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt then addHsScrutTmCs (concat scrs) new_vars $ -- See Note [Long-distance information] - pmcMatches (DsMatchContext ctxt locn) new_vars matches + pmcMatches origin (DsMatchContext ctxt locn) new_vars matches else pure (initNablasMatches matches) ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas @@ -814,7 +815,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource + , eqn_orig = origin -- Not all equations are from source , eqn_rhs = match_result } } handleWarnings = if isGenerated origin @@ -834,7 +835,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' is_pat_syn_match (Generated _) (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat is_pat_syn_match _ _ = False non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool - non_wc (Generated _) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc (Generated DoExpansion) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False non_wc _ _ = True matchEquations :: HsMatchContext GhcRn ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -50,7 +50,7 @@ import GHC.HsToCore.Pmc.Utils import GHC.HsToCore.Pmc.Desugar import GHC.HsToCore.Pmc.Check import GHC.HsToCore.Pmc.Solver -import GHC.Types.Basic (Origin(..)) +import GHC.Types.Basic (Origin(..), isDoExpansionGenerated) import GHC.Core (CoreExpr) import GHC.Driver.Session import GHC.Hs @@ -146,12 +146,13 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- checks and @-XEmptyCase@ with only a single match variable. -- See Note [Checking EmptyCase]. pmcMatches - :: DsMatchContext -- ^ Match context, for warnings messages + :: Origin + -> DsMatchContext -- ^ Match context, for warnings messages -> [Id] -- ^ Match variables, i.e. x and y above -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. -pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do +pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do -- We have to force @missing@ before printing out the trace message, -- otherwise we get interleaved output from the solver. This function -- should be strict in @missing@ anyway! @@ -175,7 +176,9 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do result <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result + when (not (isDoExpansionGenerated origin)) + ({-# SCC "formatReportWarnings" #-} + formatReportWarnings ReportMatchGroup ctxt vars result) return (NE.toList (ldiMatchGroup (cr_ret result))) {- Note [pmcPatBind only checks PatBindRhs] ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -120,8 +120,10 @@ isMatchContextPmChecked dflags origin kind -- are enabled, in which case we need to run the pattern match checker. needToRunPmCheck :: DynFlags -> Origin -> Bool needToRunPmCheck dflags origin + | isDoExpansionGenerated origin + = False | isGenerated origin - = True + = True | otherwise = notNull (filter (`wopt` dflags) allPmCheckWarnings) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -408,26 +408,24 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr (HsDo _ doFlav@(DoExpr{}) (L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty + -- Do expansion on the fly + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; traceTc "tcDoStmts doExpr" (vcat [ text "original:" <+> ppr expanded_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expanded_do_expr res_ty } -tcExpr (HsDo _ doFlav@(MDoExpr{}) (L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty + -- Do expansion on the fly + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; traceTc "tcDoStmts mDoExpr" (vcat [ text "original:" <+> ppr expanded_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expanded_do_expr res_ty } tcExpr (HsDo _ do_or_lc stmts) res_ty ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1644,10 +1644,8 @@ isIrrefutableHsPatRn tc_env is_strict pat = go (AsPat _ _ _ pat) = goL pat go (ViewPat _ _ pat) = goL pat go (SigPat _ pat _) = goL pat - go (TuplePat _ pats _) = - do traceTc "isIrrefutableHsPatRn TuplePat" empty - foldM (\a p -> do {b <- goL p; return (a && b)}) True pats - + go (TuplePat _ pats _) = do bs <- mapM goL pats + return (and bs) go (SumPat {}) = return False -- See Note [Unboxed sum patterns aren't irrefutable] go (ListPat {}) = return False @@ -1656,31 +1654,21 @@ isIrrefutableHsPatRn tc_env is_strict pat = { pat_con = L _ dcName , pat_args = details }) = do { tyth <- tcLookupGlobal dcName - ; traceTc "isIrrefutableHsPatRn dataCon" (ppr tyth) + ; traceTc "isIrrefutableHsPatRn TyThing" (ppr tyth) ; case tyth of (ATyCon tycon) -> - do { b <- foldM (\a p -> do {b <- goL p; return (a && b)}) True (hsConPatArgs details) - ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon - , ppr (isNewTyCon tycon) - , ppr (tcHasFixedRuntimeRep tycon)]) + do { bs <- mapM goL (hsConPatArgs details) ; let b' = isJust (tyConSingleDataCon_maybe tycon) - ; return (b && b') } - id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + ; return (b' && and bs) } (AConLike cl) -> case cl of RealDataCon dc -> do let tycon = dataConTyCon dc - b <- foldM (\a p -> do {b <- goL p; return (a && b)}) - True (hsConPatArgs details) - traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon - , ppr (isNewTyCon tycon) - , ppr (tcHasFixedRuntimeRep tycon)] ) let b' = isJust (tyConSingleDataCon_maybe tycon) - return (b && b') - PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) - return False -- conservative - - ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + bs <- mapM goL (hsConPatArgs details) + return (b' && and bs) + PatSynCon _pat -> return False -- conservative + _ -> pprPanic "isIrrefutableHsPatRn" (ppr tyth) } go (LitPat {}) = do traceTc "isIrrefutableHsPatRn LitPat" empty return False ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic -import {-# SOURCE #-} Language.Haskell.Syntax.Expr +import Language.Haskell.Syntax.Expr import GHC.Unit.Module.Imported (ImportedModsVal) import GHC.Data.FastString (fsLit) import Language.Haskell.Syntax (LPat, LIdP) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2672,6 +2672,7 @@ instance ExactPrint (HsExpr GhcPs) where getAnnotationEntry (HsProc an _ _) = fromAnn an getAnnotationEntry (HsStatic an _) = fromAnn an getAnnotationEntry (HsPragE{}) = NoEntryVal + getAnnotationEntry (PopSrcSpan{}) = NoEntryVal setAnnotationAnchor a@(HsVar{}) _ _s = a setAnnotationAnchor (HsUnboundVar an a) anc cs = (HsUnboundVar (setAnchorEpa an anc cs) a) @@ -2710,6 +2711,7 @@ instance ExactPrint (HsExpr GhcPs) where setAnnotationAnchor (HsProc an a b) anc cs = (HsProc (setAnchorEpa an anc cs) a b) setAnnotationAnchor (HsStatic an a) anc cs = (HsStatic (setAnchorEpa an anc cs) a) setAnnotationAnchor a@(HsPragE{}) _ _s = a + setAnnotationAnchor a@(PopSrcSpan{}) _ _s = a exact (HsVar x n) = do n' <- markAnnotated n View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b464815c8a09fb8273009a652caf716a1ee6920e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b464815c8a09fb8273009a652caf716a1ee6920e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 17:34:35 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 19 May 2023 13:34:35 -0400 Subject: [Git][ghc/ghc][wip/expand-do] disallow overlapping warnings in do expansion generated match equations Message-ID: <6467b32b847e4_9760a35e48240600420@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: cb9e9066 by Apoorv Ingle at 2023-05-19T12:34:27-05:00 disallow overlapping warnings in do expansion generated match equations - - - - - 9 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Types/Hint.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1114,9 +1114,9 @@ data HsExpansion orig expanded -- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) - -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -345,8 +345,8 @@ subordinates env instMap decl = case decl of InstD _ (ClsInstD _ d) -> let data_fams = do DataFamInstDecl { dfid_eqn = - (FamEqn { feqn_tycon = L l _ - , feqn_rhs = defn })} <- unLoc <$> cid_datafam_insts d + FamEqn { feqn_tycon = L l _ + , feqn_rhs = defn }} <- unLoc <$> cid_datafam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn ty_fams = do TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ }) } <- unLoc <$> cid_tyfam_insts d ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -28,7 +28,7 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) -import GHC.Types.Basic ( Origin(..), isGenerated ) +import GHC.Types.Basic ( Origin(..), isGenerated, GenReason (..)) import GHC.Types.SourceText import GHC.Driver.Session import GHC.Hs @@ -788,12 +788,13 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. -- Each Match will split off one Nablas for its RHSs from this. ; tracePm "matchWrapper" (vcat [ ppr ctxt + , text "scrs" <+> ppr scrs , text "matches group" <+> ppr matches , text "matchPmChecked" <+> ppr (isMatchContextPmChecked dflags origin ctxt)]) ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt then addHsScrutTmCs (concat scrs) new_vars $ -- See Note [Long-distance information] - pmcMatches (DsMatchContext ctxt locn) new_vars matches + pmcMatches origin (DsMatchContext ctxt locn) new_vars matches else pure (initNablasMatches matches) ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas @@ -814,7 +815,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource + , eqn_orig = origin -- Not all equations are from source , eqn_rhs = match_result } } handleWarnings = if isGenerated origin @@ -834,7 +835,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' is_pat_syn_match (Generated _) (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat is_pat_syn_match _ _ = False non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool - non_wc (Generated _) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc (Generated DoExpansion) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False non_wc _ _ = True matchEquations :: HsMatchContext GhcRn ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -50,7 +50,7 @@ import GHC.HsToCore.Pmc.Utils import GHC.HsToCore.Pmc.Desugar import GHC.HsToCore.Pmc.Check import GHC.HsToCore.Pmc.Solver -import GHC.Types.Basic (Origin(..)) +import GHC.Types.Basic (Origin(..), isDoExpansionGenerated) import GHC.Core (CoreExpr) import GHC.Driver.Session import GHC.Hs @@ -146,12 +146,13 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- checks and @-XEmptyCase@ with only a single match variable. -- See Note [Checking EmptyCase]. pmcMatches - :: DsMatchContext -- ^ Match context, for warnings messages + :: Origin + -> DsMatchContext -- ^ Match context, for warnings messages -> [Id] -- ^ Match variables, i.e. x and y above -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. -pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do +pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do -- We have to force @missing@ before printing out the trace message, -- otherwise we get interleaved output from the solver. This function -- should be strict in @missing@ anyway! @@ -175,7 +176,9 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do result <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result + when (not (isDoExpansionGenerated origin)) + ({-# SCC "formatReportWarnings" #-} + formatReportWarnings ReportMatchGroup ctxt vars result) return (NE.toList (ldiMatchGroup (cr_ret result))) {- Note [pmcPatBind only checks PatBindRhs] ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -120,8 +120,10 @@ isMatchContextPmChecked dflags origin kind -- are enabled, in which case we need to run the pattern match checker. needToRunPmCheck :: DynFlags -> Origin -> Bool needToRunPmCheck dflags origin + | isDoExpansionGenerated origin + = False | isGenerated origin - = True + = True | otherwise = notNull (filter (`wopt` dflags) allPmCheckWarnings) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -408,26 +408,24 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr (HsDo _ doFlav@(DoExpr{}) (L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty + -- Do expansion on the fly + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; traceTc "tcDoStmts doExpr" (vcat [ text "original:" <+> ppr expanded_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expanded_do_expr res_ty } -tcExpr (HsDo _ doFlav@(MDoExpr{}) (L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty + -- Do expansion on the fly + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; traceTc "tcDoStmts mDoExpr" (vcat [ text "original:" <+> ppr expanded_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expanded_do_expr res_ty } tcExpr (HsDo _ do_or_lc stmts) res_ty ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1644,10 +1644,8 @@ isIrrefutableHsPatRn tc_env is_strict pat = go (AsPat _ _ _ pat) = goL pat go (ViewPat _ _ pat) = goL pat go (SigPat _ pat _) = goL pat - go (TuplePat _ pats _) = - do traceTc "isIrrefutableHsPatRn TuplePat" empty - foldM (\a p -> do {b <- goL p; return (a && b)}) True pats - + go (TuplePat _ pats _) = do bs <- mapM goL pats + return (and bs) go (SumPat {}) = return False -- See Note [Unboxed sum patterns aren't irrefutable] go (ListPat {}) = return False @@ -1656,31 +1654,21 @@ isIrrefutableHsPatRn tc_env is_strict pat = { pat_con = L _ dcName , pat_args = details }) = do { tyth <- tcLookupGlobal dcName - ; traceTc "isIrrefutableHsPatRn dataCon" (ppr tyth) + ; traceTc "isIrrefutableHsPatRn TyThing" (ppr tyth) ; case tyth of (ATyCon tycon) -> - do { b <- foldM (\a p -> do {b <- goL p; return (a && b)}) True (hsConPatArgs details) - ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon - , ppr (isNewTyCon tycon) - , ppr (tcHasFixedRuntimeRep tycon)]) + do { bs <- mapM goL (hsConPatArgs details) ; let b' = isJust (tyConSingleDataCon_maybe tycon) - ; return (b && b') } - id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + ; return (b' && and bs) } (AConLike cl) -> case cl of RealDataCon dc -> do let tycon = dataConTyCon dc - b <- foldM (\a p -> do {b <- goL p; return (a && b)}) - True (hsConPatArgs details) - traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon - , ppr (isNewTyCon tycon) - , ppr (tcHasFixedRuntimeRep tycon)] ) let b' = isJust (tyConSingleDataCon_maybe tycon) - return (b && b') - PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) - return False -- conservative - - ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + bs <- mapM goL (hsConPatArgs details) + return (b' && and bs) + PatSynCon _pat -> return False -- conservative + _ -> pprPanic "isIrrefutableHsPatRn" (ppr tyth) } go (LitPat {}) = do traceTc "isIrrefutableHsPatRn LitPat" empty return False ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic -import {-# SOURCE #-} Language.Haskell.Syntax.Expr +import Language.Haskell.Syntax.Expr import GHC.Unit.Module.Imported (ImportedModsVal) import GHC.Data.FastString (fsLit) import Language.Haskell.Syntax (LPat, LIdP) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2672,6 +2672,7 @@ instance ExactPrint (HsExpr GhcPs) where getAnnotationEntry (HsProc an _ _) = fromAnn an getAnnotationEntry (HsStatic an _) = fromAnn an getAnnotationEntry (HsPragE{}) = NoEntryVal + getAnnotationEntry (PopSrcSpan{}) = NoEntryVal setAnnotationAnchor a@(HsVar{}) _ _s = a setAnnotationAnchor (HsUnboundVar an a) anc cs = (HsUnboundVar (setAnchorEpa an anc cs) a) @@ -2710,6 +2711,7 @@ instance ExactPrint (HsExpr GhcPs) where setAnnotationAnchor (HsProc an a b) anc cs = (HsProc (setAnchorEpa an anc cs) a b) setAnnotationAnchor (HsStatic an a) anc cs = (HsStatic (setAnchorEpa an anc cs) a) setAnnotationAnchor a@(HsPragE{}) _ _s = a + setAnnotationAnchor a@(PopSrcSpan{}) _ _s = a exact (HsVar x n) = do n' <- markAnnotated n View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb9e9066c5f9df60534accb24b5934cfea4303d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb9e9066c5f9df60534accb24b5934cfea4303d9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 18:05:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 14:05:25 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 40 commits: Replace the implementation of CodeBuffers with unboxed types Message-ID: <6467ba6531673_9760a36b0053c60311e@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - a5b2dfde by Ben Gamari at 2023-05-19T14:02:19-04:00 compiler: Make OccSet opaque - - - - - 9b8f248e by Ben Gamari at 2023-05-19T14:05:02-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - f11db5c5 by Ben Gamari at 2023-05-19T14:05:13-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc7ca88b0bec358b5f57affda1514cc74b3337fc...f11db5c56f204bf615711d28c1910a8a2b144fc3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc7ca88b0bec358b5f57affda1514cc74b3337fc...f11db5c56f204bf615711d28c1910a8a2b144fc3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 18:27:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 14:27:39 -0400 Subject: [Git][ghc/ghc][wip/split-ghc-base] 74 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <6467bf9b3f1ec_9760a3611a2486132fe@gitlab.mail> Ben Gamari pushed to branch wip/split-ghc-base at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - a5b2dfde by Ben Gamari at 2023-05-19T14:02:19-04:00 compiler: Make OccSet opaque - - - - - 9b8f248e by Ben Gamari at 2023-05-19T14:05:02-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - f11db5c5 by Ben Gamari at 2023-05-19T14:05:13-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - acba4af8 by Ben Gamari at 2023-05-19T14:26:08-04:00 base: Break up GHC.Base - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0eafe88c94d292db8ea4d22fcf5543b0f5cb06da...acba4af8b8259a9f43655170cda3607aed10bb01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0eafe88c94d292db8ea4d22fcf5543b0f5cb06da...acba4af8b8259a9f43655170cda3607aed10bb01 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 18:49:14 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 19 May 2023 14:49:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/configure-cpp Message-ID: <6467c4aa678f9_9760a35e48240615430@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/configure-cpp You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 19:29:27 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 19 May 2023 15:29:27 -0400 Subject: [Git][ghc/ghc][wip/expand-do] disallow overlapping warnings in do expansion generated match equations Message-ID: <6467ce1777c86_9760a36afc5546193c0@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 94811104 by Apoorv Ingle at 2023-05-19T14:29:18-05:00 disallow overlapping warnings in do expansion generated match equations - - - - - 8 changed files: - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Types/Hint.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -345,8 +345,8 @@ subordinates env instMap decl = case decl of InstD _ (ClsInstD _ d) -> let data_fams = do DataFamInstDecl { dfid_eqn = - (FamEqn { feqn_tycon = L l _ - , feqn_rhs = defn })} <- unLoc <$> cid_datafam_insts d + FamEqn { feqn_tycon = L l _ + , feqn_rhs = defn }} <- unLoc <$> cid_datafam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn ty_fams = do TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ }) } <- unLoc <$> cid_tyfam_insts d ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -28,7 +28,7 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) -import GHC.Types.Basic ( Origin(..), isGenerated ) +import GHC.Types.Basic ( Origin(..), isGenerated, GenReason (..)) import GHC.Types.SourceText import GHC.Driver.Session import GHC.Hs @@ -788,12 +788,13 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. -- Each Match will split off one Nablas for its RHSs from this. ; tracePm "matchWrapper" (vcat [ ppr ctxt + , text "scrs" <+> ppr scrs , text "matches group" <+> ppr matches , text "matchPmChecked" <+> ppr (isMatchContextPmChecked dflags origin ctxt)]) ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt then addHsScrutTmCs (concat scrs) new_vars $ -- See Note [Long-distance information] - pmcMatches (DsMatchContext ctxt locn) new_vars matches + pmcMatches origin (DsMatchContext ctxt locn) new_vars matches else pure (initNablasMatches matches) ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas @@ -814,7 +815,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource + , eqn_orig = origin -- Not all equations are from source , eqn_rhs = match_result } } handleWarnings = if isGenerated origin @@ -834,7 +835,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' is_pat_syn_match (Generated _) (L _ (Match _ _ [l_pat] _)) = isPatSyn l_pat is_pat_syn_match _ _ = False non_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool - non_wc (Generated _) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_wc (Generated DoExpansion) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False non_wc _ _ = True matchEquations :: HsMatchContext GhcRn ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -50,7 +50,7 @@ import GHC.HsToCore.Pmc.Utils import GHC.HsToCore.Pmc.Desugar import GHC.HsToCore.Pmc.Check import GHC.HsToCore.Pmc.Solver -import GHC.Types.Basic (Origin(..)) +import GHC.Types.Basic (Origin(..), isDoExpansionGenerated) import GHC.Core (CoreExpr) import GHC.Driver.Session import GHC.Hs @@ -142,16 +142,17 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- Returns one non-empty 'Nablas' for 1.) each pattern of a 'Match' and 2.) -- each of a 'Match'es 'GRHS' for Note [Long-distance information]. -- --- Special case: When there are /no matches/, then the functionassumes it +-- Special case: When there are /no matches/, then the function assumes it -- checks and @-XEmptyCase@ with only a single match variable. -- See Note [Checking EmptyCase]. pmcMatches - :: DsMatchContext -- ^ Match context, for warnings messages + :: Origin + -> DsMatchContext -- ^ Match context, for warnings messages -> [Id] -- ^ Match variables, i.e. x and y above -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. -pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do +pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do -- We have to force @missing@ before printing out the trace message, -- otherwise we get interleaved output from the solver. This function -- should be strict in @missing@ anyway! @@ -175,7 +176,9 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do result <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result + when (not (isDoExpansionGenerated origin)) -- Generated code shouldn't generate overlapping warnings + ({-# SCC "formatReportWarnings" #-} + formatReportWarnings ReportMatchGroup ctxt vars result) return (NE.toList (ldiMatchGroup (cr_ret result))) {- Note [pmcPatBind only checks PatBindRhs] ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -120,8 +120,10 @@ isMatchContextPmChecked dflags origin kind -- are enabled, in which case we need to run the pattern match checker. needToRunPmCheck :: DynFlags -> Origin -> Bool needToRunPmCheck dflags origin + | isDoExpansionGenerated origin + = False | isGenerated origin - = True + = True | otherwise = notNull (filter (`wopt` dflags) allPmCheckWarnings) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -408,26 +408,24 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr (HsDo _ doFlav@(DoExpr{}) (L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty + -- Do expansion on the fly + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; traceTc "tcDoStmts doExpr" (vcat [ text "original:" <+> ppr expanded_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expanded_do_expr res_ty } -tcExpr (HsDo _ doFlav@(MDoExpr{}) (L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts - ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doFlav (L loc stmts)) - (unLoc expand_expr) - -- Do expansion on the fly - ; traceTc "tcDoStmts do" (vcat [ text "original:" <+> ppr expand_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; tcExpr expand_do_expr res_ty + -- Do expansion on the fly + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; traceTc "tcDoStmts mDoExpr" (vcat [ text "original:" <+> ppr expanded_do_expr + , text "expanded:" <+> ppr expand_expr + ]) + ; tcExpr expanded_do_expr res_ty } tcExpr (HsDo _ do_or_lc stmts) res_ty ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1644,10 +1644,8 @@ isIrrefutableHsPatRn tc_env is_strict pat = go (AsPat _ _ _ pat) = goL pat go (ViewPat _ _ pat) = goL pat go (SigPat _ pat _) = goL pat - go (TuplePat _ pats _) = - do traceTc "isIrrefutableHsPatRn TuplePat" empty - foldM (\a p -> do {b <- goL p; return (a && b)}) True pats - + go (TuplePat _ pats _) = do bs <- mapM goL pats + return (and bs) go (SumPat {}) = return False -- See Note [Unboxed sum patterns aren't irrefutable] go (ListPat {}) = return False @@ -1656,31 +1654,21 @@ isIrrefutableHsPatRn tc_env is_strict pat = { pat_con = L _ dcName , pat_args = details }) = do { tyth <- tcLookupGlobal dcName - ; traceTc "isIrrefutableHsPatRn dataCon" (ppr tyth) + ; traceTc "isIrrefutableHsPatRn TyThing" (ppr tyth) ; case tyth of (ATyCon tycon) -> - do { b <- foldM (\a p -> do {b <- goL p; return (a && b)}) True (hsConPatArgs details) - ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon - , ppr (isNewTyCon tycon) - , ppr (tcHasFixedRuntimeRep tycon)]) + do { bs <- mapM goL (hsConPatArgs details) ; let b' = isJust (tyConSingleDataCon_maybe tycon) - ; return (b && b') } - id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id) + ; return (b' && and bs) } (AConLike cl) -> case cl of RealDataCon dc -> do let tycon = dataConTyCon dc - b <- foldM (\a p -> do {b <- goL p; return (a && b)}) - True (hsConPatArgs details) - traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon - , ppr (isNewTyCon tycon) - , ppr (tcHasFixedRuntimeRep tycon)] ) let b' = isJust (tyConSingleDataCon_maybe tycon) - return (b && b') - PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con) - return False -- conservative - - ax@(ACoAxiom _) -> pprPanic "isIrrefutableHsPatRn ACoAxiom" (ppr ax) + bs <- mapM goL (hsConPatArgs details) + return (b' && and bs) + PatSynCon _pat -> return False -- conservative + _ -> pprPanic "isIrrefutableHsPatRn" (ppr tyth) } go (LitPat {}) = do traceTc "isIrrefutableHsPatRn LitPat" empty return False ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic -import {-# SOURCE #-} Language.Haskell.Syntax.Expr +import Language.Haskell.Syntax.Expr import GHC.Unit.Module.Imported (ImportedModsVal) import GHC.Data.FastString (fsLit) import Language.Haskell.Syntax (LPat, LIdP) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2672,6 +2672,7 @@ instance ExactPrint (HsExpr GhcPs) where getAnnotationEntry (HsProc an _ _) = fromAnn an getAnnotationEntry (HsStatic an _) = fromAnn an getAnnotationEntry (HsPragE{}) = NoEntryVal + getAnnotationEntry (PopSrcSpan{}) = NoEntryVal setAnnotationAnchor a@(HsVar{}) _ _s = a setAnnotationAnchor (HsUnboundVar an a) anc cs = (HsUnboundVar (setAnchorEpa an anc cs) a) @@ -2710,6 +2711,7 @@ instance ExactPrint (HsExpr GhcPs) where setAnnotationAnchor (HsProc an a b) anc cs = (HsProc (setAnchorEpa an anc cs) a b) setAnnotationAnchor (HsStatic an a) anc cs = (HsStatic (setAnchorEpa an anc cs) a) setAnnotationAnchor a@(HsPragE{}) _ _s = a + setAnnotationAnchor a@(PopSrcSpan{}) _ _s = a exact (HsVar x n) = do n' <- markAnnotated n View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9481110439d9f905521848fccd8a6ba1055d97de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9481110439d9f905521848fccd8a6ba1055d97de You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 19:31:04 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 15:31:04 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <6467ce7825fc0_9760a3687e5fc619920@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 81bb7ed7 by Ben Gamari at 2023-05-19T15:30:50-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elem` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/81bb7ed7ad8d4be8f5e3d7f74ade0f0a5d57d90a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/81bb7ed7ad8d4be8f5e3d7f74ade0f0a5d57d90a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 20:22:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 16:22:40 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <6467da9064790_9760a36af8940634772@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 921e16a2 by Ben Gamari at 2023-05-19T16:20:45-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elem` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/921e16a2e8b174e9059e6de1b0a6549c05acb767 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/921e16a2e8b174e9059e6de1b0a6549c05acb767 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 20:54:57 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 16:54:57 -0400 Subject: [Git][ghc/ghc][wip/split-ghc-base] 2 commits: testsuite: Add test to catch changes in core libraries Message-ID: <6467e221c4645_9760a3bbe34e0637418@gitlab.mail> Ben Gamari pushed to branch wip/split-ghc-base at Glasgow Haskell Compiler / GHC Commits: 921e16a2 by Ben Gamari at 2023-05-19T16:20:45-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 67252ef1 by Ben Gamari at 2023-05-19T16:40:19-04:00 base: Break up GHC.Base - - - - - 22 changed files: - compiler/GHC/Builtin/Names.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - libraries/base/Data/Semigroup/Internal.hs-boot - libraries/base/GHC/Base.hs - + libraries/base/GHC/Base/FunOps.hs - + libraries/base/GHC/Base/Functor.hs - + libraries/base/GHC/Base/List.hs - + libraries/base/GHC/Base/NonEmpty.hs - + libraries/base/GHC/Base/Semigroup.hs - libraries/base/GHC/Base.hs-boot → libraries/base/GHC/Base/Semigroup.hs-boot - + libraries/base/GHC/Base/String.hs - + libraries/base/GHC/Base/Void.hs - libraries/base/base.cabal - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -549,7 +549,10 @@ pRELUDE = mkBaseModule_ pRELUDE_NAME gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_GENERICS, gHC_MAGIC, gHC_MAGIC_DICT, - gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM, + gHC_CLASSES, gHC_PRIMOPWRAPPERS, + gHC_BASE, gHC_BASE_FUNOPS, gHC_BASE_FUNCTOR, gHC_BASE_LIST, gHC_BASE_NONEMPTY, + gHC_BASE_SEMIGROUP, gHC_BASE_STRING, gHC_BASE_VOID, + gHC_ENUM, gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING, gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_NUM_INTEGER, gHC_NUM_NATURAL, gHC_NUM_BIGNAT, @@ -574,7 +577,14 @@ gHC_CSTRING = mkPrimModule (fsLit "GHC.CString") gHC_CLASSES = mkPrimModule (fsLit "GHC.Classes") gHC_PRIMOPWRAPPERS = mkPrimModule (fsLit "GHC.PrimopWrappers") -gHC_BASE = mkBaseModule (fsLit "GHC.Base") +gHC_BASE = mkBaseModule (fsLit "GHC.Base") +gHC_BASE_FUNOPS = mkBaseModule (fsLit "GHC.Base.FunOps") +gHC_BASE_FUNCTOR = mkBaseModule (fsLit "GHC.Base.Functor") +gHC_BASE_LIST = mkBaseModule (fsLit "GHC.Base.List") +gHC_BASE_NONEMPTY = mkBaseModule (fsLit "GHC.Base.NonEmpty") +gHC_BASE_SEMIGROUP = mkBaseModule (fsLit "GHC.Base.Semigroup") +gHC_BASE_STRING = mkBaseModule (fsLit "GHC.Base.String") +gHC_BASE_VOID = mkBaseModule (fsLit "GHC.Base.Void") gHC_ENUM = mkBaseModule (fsLit "GHC.Enum") gHC_GHCI = mkBaseModule (fsLit "GHC.GHCi") gHC_GHCI_HELPERS= mkBaseModule (fsLit "GHC.GHCi.Helpers") @@ -786,7 +796,7 @@ fromListN_RDR = nameRdrName fromListNName toList_RDR = nameRdrName toListName compose_RDR :: RdrName -compose_RDR = varQual_RDR gHC_BASE (fsLit ".") +compose_RDR = varQual_RDR gHC_BASE_FUNOPS (fsLit ".") not_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, and_RDR, range_RDR, inRange_RDR, index_RDR, @@ -915,10 +925,10 @@ fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR, foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR, mappend_RDR :: RdrName fmap_RDR = nameRdrName fmapName -replace_RDR = varQual_RDR gHC_BASE (fsLit "<$") +replace_RDR = varQual_RDR gHC_BASE_FUNCTOR (fsLit "<$") pure_RDR = nameRdrName pureAName ap_RDR = nameRdrName apAName -liftA2_RDR = varQual_RDR gHC_BASE (fsLit "liftA2") +liftA2_RDR = varQual_RDR gHC_BASE_FUNCTOR (fsLit "liftA2") foldable_foldr_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldr") foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") null_RDR = varQual_RDR dATA_FOLDABLE (fsLit "null") @@ -972,7 +982,7 @@ leftDataConName = dcQual dATA_EITHER (fsLit "Left") leftDataConKey rightDataConName = dcQual dATA_EITHER (fsLit "Right") rightDataConKey voidTyConName :: Name -voidTyConName = tcQual gHC_BASE (fsLit "Void") voidTyConKey +voidTyConName = tcQual gHC_BASE_VOID (fsLit "Void") voidTyConKey -- Generics (types) v1TyConName, u1TyConName, par1TyConName, rec1TyConName, @@ -1054,7 +1064,7 @@ unpackCStringName, unpackCStringFoldrName, unpackCStringAppendName, unpackCStringAppendUtf8Name, eqStringName, cstringLengthName :: Name cstringLengthName = varQual gHC_CSTRING (fsLit "cstringLength#") cstringLengthIdKey -eqStringName = varQual gHC_BASE (fsLit "eqString") eqStringIdKey +eqStringName = varQual gHC_BASE_STRING (fsLit "eqString") eqStringIdKey unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey unpackCStringAppendName = varQual gHC_CSTRING (fsLit "unpackAppendCString#") unpackCStringAppendIdKey @@ -1075,15 +1085,15 @@ eqClassName = clsQual gHC_CLASSES (fsLit "Eq") eqClassKey eqName = varQual gHC_CLASSES (fsLit "==") eqClassOpKey ordClassName = clsQual gHC_CLASSES (fsLit "Ord") ordClassKey geName = varQual gHC_CLASSES (fsLit ">=") geClassOpKey -functorClassName = clsQual gHC_BASE (fsLit "Functor") functorClassKey -fmapName = varQual gHC_BASE (fsLit "fmap") fmapClassOpKey +functorClassName = clsQual gHC_BASE_FUNCTOR (fsLit "Functor") functorClassKey +fmapName = varQual gHC_BASE_FUNCTOR (fsLit "fmap") fmapClassOpKey -- Class Monad monadClassName, thenMName, bindMName, returnMName :: Name -monadClassName = clsQual gHC_BASE (fsLit "Monad") monadClassKey -thenMName = varQual gHC_BASE (fsLit ">>") thenMClassOpKey -bindMName = varQual gHC_BASE (fsLit ">>=") bindMClassOpKey -returnMName = varQual gHC_BASE (fsLit "return") returnMClassOpKey +monadClassName = clsQual gHC_BASE_FUNCTOR (fsLit "Monad") monadClassKey +thenMName = varQual gHC_BASE_FUNCTOR (fsLit ">>") thenMClassOpKey +bindMName = varQual gHC_BASE_FUNCTOR (fsLit ">>=") bindMClassOpKey +returnMName = varQual gHC_BASE_FUNCTOR (fsLit "return") returnMClassOpKey -- Class MonadFail monadFailClassName, failMName :: Name @@ -1092,10 +1102,10 @@ failMName = varQual mONAD_FAIL (fsLit "fail") failMClassOpKey -- Class Applicative applicativeClassName, pureAName, apAName, thenAName :: Name -applicativeClassName = clsQual gHC_BASE (fsLit "Applicative") applicativeClassKey -apAName = varQual gHC_BASE (fsLit "<*>") apAClassOpKey -pureAName = varQual gHC_BASE (fsLit "pure") pureAClassOpKey -thenAName = varQual gHC_BASE (fsLit "*>") thenAClassOpKey +applicativeClassName = clsQual gHC_BASE_FUNCTOR (fsLit "Applicative") applicativeClassKey +apAName = varQual gHC_BASE_FUNCTOR (fsLit "<*>") apAClassOpKey +pureAName = varQual gHC_BASE_FUNCTOR (fsLit "pure") pureAClassOpKey +thenAName = varQual gHC_BASE_FUNCTOR (fsLit "*>") thenAClassOpKey -- Classes (Foldable, Traversable) foldableClassName, traversableClassName :: Name @@ -1104,20 +1114,20 @@ traversableClassName = clsQual dATA_TRAVERSABLE (fsLit "Traversable") trave -- Classes (Semigroup, Monoid) semigroupClassName, sappendName :: Name -semigroupClassName = clsQual gHC_BASE (fsLit "Semigroup") semigroupClassKey -sappendName = varQual gHC_BASE (fsLit "<>") sappendClassOpKey +semigroupClassName = clsQual gHC_BASE_SEMIGROUP (fsLit "Semigroup") semigroupClassKey +sappendName = varQual gHC_BASE_SEMIGROUP (fsLit "<>") sappendClassOpKey monoidClassName, memptyName, mappendName, mconcatName :: Name -monoidClassName = clsQual gHC_BASE (fsLit "Monoid") monoidClassKey -memptyName = varQual gHC_BASE (fsLit "mempty") memptyClassOpKey -mappendName = varQual gHC_BASE (fsLit "mappend") mappendClassOpKey -mconcatName = varQual gHC_BASE (fsLit "mconcat") mconcatClassOpKey +monoidClassName = clsQual gHC_BASE_SEMIGROUP (fsLit "Monoid") monoidClassKey +memptyName = varQual gHC_BASE_SEMIGROUP (fsLit "mempty") memptyClassOpKey +mappendName = varQual gHC_BASE_SEMIGROUP (fsLit "mappend") mappendClassOpKey +mconcatName = varQual gHC_BASE_SEMIGROUP (fsLit "mconcat") mconcatClassOpKey -- AMP additions joinMName, alternativeClassName :: Name -joinMName = varQual gHC_BASE (fsLit "join") joinMIdKey +joinMName = varQual gHC_BASE_FUNCTOR (fsLit "join") joinMIdKey alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey -- @@ -1138,13 +1148,13 @@ considerAccessibleName = varQual gHC_EXTS (fsLit "considerAccessible") considerA fromStringName, otherwiseIdName, foldrName, buildName, augmentName, mapName, appendName, assertName, dollarName :: Name -dollarName = varQual gHC_BASE (fsLit "$") dollarIdKey +dollarName = varQual gHC_BASE_FUNOPS (fsLit "$") dollarIdKey otherwiseIdName = varQual gHC_BASE (fsLit "otherwise") otherwiseIdKey -foldrName = varQual gHC_BASE (fsLit "foldr") foldrIdKey -buildName = varQual gHC_BASE (fsLit "build") buildIdKey -augmentName = varQual gHC_BASE (fsLit "augment") augmentIdKey -mapName = varQual gHC_BASE (fsLit "map") mapIdKey -appendName = varQual gHC_BASE (fsLit "++") appendIdKey +foldrName = varQual gHC_BASE_LIST (fsLit "foldr") foldrIdKey +buildName = varQual gHC_BASE_LIST (fsLit "build") buildIdKey +augmentName = varQual gHC_BASE_LIST (fsLit "augment") augmentIdKey +mapName = varQual gHC_BASE_LIST (fsLit "map") mapIdKey +appendName = varQual gHC_BASE_LIST (fsLit "++") appendIdKey assertName = varQual gHC_BASE (fsLit "assert") assertIdKey fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey @@ -1431,7 +1441,7 @@ withDictClassName :: Name withDictClassName = clsQual gHC_MAGIC_DICT (fsLit "WithDict") withDictClassKey nonEmptyTyConName :: Name -nonEmptyTyConName = tcQual gHC_BASE (fsLit "NonEmpty") nonEmptyTyConKey +nonEmptyTyConName = tcQual gHC_BASE_NONEMPTY (fsLit "NonEmpty") nonEmptyTyConKey -- Custom type errors errorMessageTypeErrorFamName @@ -1546,10 +1556,10 @@ ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName, failIOName :: Name ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey ioDataConName = dcQual gHC_TYPES (fsLit "IO") ioDataConKey -thenIOName = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey -bindIOName = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey -returnIOName = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey -failIOName = varQual gHC_IO (fsLit "failIO") failIOIdKey +thenIOName = varQual gHC_BASE_FUNCTOR (fsLit "thenIO") thenIOIdKey +bindIOName = varQual gHC_BASE_FUNCTOR (fsLit "bindIO") bindIOIdKey +returnIOName = varQual gHC_BASE_FUNCTOR (fsLit "returnIO") returnIOIdKey +failIOName = varQual gHC_BASE_FUNCTOR (fsLit "failIO") failIOIdKey -- IO things printName :: Name ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== libraries/base/Data/Semigroup/Internal.hs-boot ===================================== @@ -3,7 +3,8 @@ module Data.Semigroup.Internal where import {-# SOURCE #-} GHC.Real (Integral) -import {-# SOURCE #-} GHC.Base (Semigroup,Monoid,Maybe) +import {-# SOURCE #-} GHC.Base.Semigroup (Semigroup,Monoid) +import GHC.Maybe (Maybe) import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a ===================================== libraries/base/GHC/Base.hs ===================================== @@ -75,9 +75,6 @@ Other Prelude modules are much easier with fewer complex dependencies. {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} --- -Wno-orphans is needed for things like: --- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 -{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- @@ -97,20 +94,24 @@ Other Prelude modules are much easier with fewer complex dependencies. #include "MachDeps.h" module GHC.Base - ( - module GHC.Base, - module GHC.Classes, - module GHC.CString, - module GHC.Magic, - module GHC.Magic.Dict, - module GHC.Types, - module GHC.Prim, -- Re-export GHC.Prim, GHC.Prim.Ext, - module GHC.Prim.Ext, -- GHC.Prim.PtrEq and [boot] GHC.Err - module GHC.Prim.PtrEq, -- to avoid lots of people having to - module GHC.Err, -- import these modules explicitly - module GHC.Maybe - ) - where + ( module GHC.Base + , module GHC.Base.FunOps + , module GHC.Base.Functor + , module GHC.Base.List + , module GHC.Base.NonEmpty + , module GHC.Base.Semigroup + , module GHC.Base.String + , module GHC.Base.Void + , module GHC.Classes + , module GHC.CString + , module GHC.Magic + , module GHC.Magic.Dict , module GHC.Types + , module GHC.Prim -- Re-export GHC.Prim, GHC.Prim.Ext, + , module GHC.Prim.Ext -- GHC.Prim.PtrEq and [boot] GHC.Err + , module GHC.Prim.PtrEq -- to avoid lots of people having to + , module GHC.Err -- import these modules explicitly + , module GHC.Maybe + ) where import GHC.Types import GHC.Classes @@ -122,31 +123,20 @@ import GHC.Prim.Ext import GHC.Prim.PtrEq import GHC.Err import GHC.Maybe -import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO) -import GHC.Tuple (Solo (MkSolo)) -- Note [Depend on GHC.Tuple] import GHC.Num.Integer () -- Note [Depend on GHC.Num.Integer] --- for 'class Semigroup' -import {-# SOURCE #-} GHC.Real (Integral) -import {-# SOURCE #-} Data.Semigroup.Internal ( stimesDefault - , stimesMaybe - , stimesList - , stimesIdempotentMonoid - ) +import GHC.Base.FunOps +import GHC.Base.Functor +import GHC.Base.List +import GHC.Base.NonEmpty +import GHC.Base.Semigroup +import GHC.Base.String +import GHC.Base.Void -- $setup -- >>> import GHC.Num -infixr 9 . -infixr 5 ++ -infixl 4 <$ -infixl 1 >>, >>= -infixr 1 =<< -infixr 0 $, $! - -infixl 4 <*>, <*, *>, <**> - default () -- Double isn't available yet {- @@ -191,1296 +181,12 @@ data Char = C# Char# type String = [Char] data Int = I# Int# data () = () -data [] a = MkNil not True = False (&&) True True = True otherwise = True - -build = errorWithoutStackTrace "urk" -foldr = errorWithoutStackTrace "urk" #endif --- | Uninhabited data type --- --- @since 4.8.0.0 -data Void deriving - ( Eq -- ^ @since 4.8.0.0 - , Ord -- ^ @since 4.8.0.0 - ) - --- | Since 'Void' values logically don't exist, this witnesses the --- logical reasoning tool of \"ex falso quodlibet\". --- --- >>> let x :: Either Void Int; x = Right 5 --- >>> :{ --- case x of --- Right r -> r --- Left l -> absurd l --- :} --- 5 --- --- @since 4.8.0.0 -absurd :: Void -> a -absurd a = case a of {} - --- | If 'Void' is uninhabited then any 'Functor' that holds only --- values of type 'Void' is holding no values. --- It is implemented in terms of @fmap absurd at . --- --- @since 4.8.0.0 -vacuous :: Functor f => f Void -> f a -vacuous = fmap absurd - -infixr 6 <> - --- | The class of semigroups (types with an associative binary operation). --- --- Instances should satisfy the following: --- --- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ --- --- You can alternatively define `sconcat` instead of (`<>`), in which case the --- laws are: --- --- [Unit]: @'sconcat' ('pure' x) = x@ --- [Multiplication]: @'sconcat' ('join' xss) = 'sconcat' ('fmap' 'sconcat' xss)@ --- --- @since 4.9.0.0 -class Semigroup a where - -- | An associative operation. - -- - -- >>> [1,2,3] <> [4,5,6] - -- [1,2,3,4,5,6] - (<>) :: a -> a -> a - a <> b = sconcat (a :| [ b ]) - - -- | Reduce a non-empty list with '<>' - -- - -- The default definition should be sufficient, but this can be - -- overridden for efficiency. - -- - -- >>> import Data.List.NonEmpty (NonEmpty (..)) - -- >>> sconcat $ "Hello" :| [" ", "Haskell", "!"] - -- "Hello Haskell!" - sconcat :: NonEmpty a -> a - sconcat (a :| as) = go a as where - go b (c:cs) = b <> go c cs - go b [] = b - - -- | Repeat a value @n@ times. - -- - -- Given that this works on a 'Semigroup' it is allowed to fail if - -- you request 0 or fewer repetitions, and the default definition - -- will do so. - -- - -- By making this a member of the class, idempotent semigroups - -- and monoids can upgrade this to execute in \(\mathcal{O}(1)\) by - -- picking @stimes = 'Data.Semigroup.stimesIdempotent'@ or @stimes = - -- 'stimesIdempotentMonoid'@ respectively. - -- - -- >>> stimes 4 [1] - -- [1,1,1,1] - stimes :: Integral b => b -> a -> a - stimes = stimesDefault - - {-# MINIMAL (<>) | sconcat #-} - - --- | The class of monoids (types with an associative binary operation that --- has an identity). Instances should satisfy the following: --- --- [Right identity] @x '<>' 'mempty' = x@ --- [Left identity] @'mempty' '<>' x = x@ --- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law) --- [Concatenation] @'mconcat' = 'foldr' ('<>') 'mempty'@ --- --- You can alternatively define `mconcat` instead of `mempty`, in which case the --- laws are: --- --- [Unit]: @'mconcat' ('pure' x) = x@ --- [Multiplication]: @'mconcat' ('join' xss) = 'mconcat' ('fmap' 'mconcat' xss)@ --- [Subclass]: @'mconcat' ('toList' xs) = 'sconcat' xs@ --- --- The method names refer to the monoid of lists under concatenation, --- but there are many other instances. --- --- Some types can be viewed as a monoid in more than one way, --- e.g. both addition and multiplication on numbers. --- In such cases we often define @newtype at s and make those instances --- of 'Monoid', e.g. 'Data.Semigroup.Sum' and 'Data.Semigroup.Product'. --- --- __NOTE__: 'Semigroup' is a superclass of 'Monoid' since /base-4.11.0.0/. -class Semigroup a => Monoid a where - -- | Identity of 'mappend' - -- - -- >>> "Hello world" <> mempty - -- "Hello world" - mempty :: a - mempty = mconcat [] - {-# INLINE mempty #-} - - -- | An associative operation - -- - -- __NOTE__: This method is redundant and has the default - -- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/. - -- Should it be implemented manually, since 'mappend' is a synonym for - -- ('<>'), it is expected that the two functions are defined the same - -- way. In a future GHC release 'mappend' will be removed from 'Monoid'. - mappend :: a -> a -> a - mappend = (<>) - {-# INLINE mappend #-} - - -- | Fold a list using the monoid. - -- - -- For most types, the default definition for 'mconcat' will be - -- used, but the function is included in the class definition so - -- that an optimized version can be provided for specific types. - -- - -- >>> mconcat ["Hello", " ", "Haskell", "!"] - -- "Hello Haskell!" - mconcat :: [a] -> a - mconcat = foldr mappend mempty - {-# INLINE mconcat #-} - -- INLINE in the hope of fusion with mconcat's argument (see !4890) - - {-# MINIMAL mempty | mconcat #-} - --- | @since 4.9.0.0 -instance Semigroup [a] where - (<>) = (++) - {-# INLINE (<>) #-} - - stimes = stimesList - --- | @since 2.01 -instance Monoid [a] where - {-# INLINE mempty #-} - mempty = [] - {-# INLINE mconcat #-} - mconcat xss = [x | xs <- xss, x <- xs] --- See Note: [List comprehensions and inlining] - --- | @since 4.9.0.0 -instance Semigroup Void where - a <> _ = a - stimes _ a = a - -{- -Note: [List comprehensions and inlining] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The list monad operations are traditionally described in terms of concatMap: - -xs >>= f = concatMap f xs - -Similarly, mconcat for lists is just concat. Here in Base, however, we don't -have concatMap, and we'll refrain from adding it here so it won't have to be -hidden in imports. Instead, we use GHC's list comprehension desugaring -mechanism to define mconcat and the Applicative and Monad instances for lists. -We mark them INLINE because the inliner is not generally too keen to inline -build forms such as the ones these desugar to without our insistence. Defining -these using list comprehensions instead of foldr has an additional potential -benefit, as described in compiler/GHC/HsToCore/ListComp.hs: if optimizations -needed to make foldr/build forms efficient are turned off, we'll get reasonably -efficient translations anyway. --} - --- | @since 4.9.0.0 -instance Semigroup (NonEmpty a) where - (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) - --- | @since 4.9.0.0 -instance Semigroup b => Semigroup (a -> b) where - f <> g = \x -> f x <> g x - stimes n f e = stimes n (f e) - --- | @since 2.01 -instance Monoid b => Monoid (a -> b) where - mempty _ = mempty - -- If `b` has a specialised mconcat, use that, rather than the default - -- mconcat, which can be much less efficient. Inline in the hope that - -- it may result in list fusion. - mconcat = \fs x -> mconcat $ map (\f -> f x) fs - {-# INLINE mconcat #-} - --- | @since 4.9.0.0 -instance Semigroup () where - _ <> _ = () - sconcat _ = () - stimes _ _ = () - --- | @since 2.01 -instance Monoid () where - -- Should it be strict? - mempty = () - mconcat _ = () - --- | @since 4.15 -instance Semigroup a => Semigroup (Solo a) where - MkSolo a <> MkSolo b = MkSolo (a <> b) - stimes n (MkSolo a) = MkSolo (stimes n a) - --- | @since 4.15 -instance Monoid a => Monoid (Solo a) where - mempty = MkSolo mempty - --- | @since 4.9.0.0 -instance (Semigroup a, Semigroup b) => Semigroup (a, b) where - (a,b) <> (a',b') = (a<>a',b<>b') - stimes n (a,b) = (stimes n a, stimes n b) - --- | @since 2.01 -instance (Monoid a, Monoid b) => Monoid (a,b) where - mempty = (mempty, mempty) - --- | @since 4.9.0.0 -instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where - (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') - stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c) - --- | @since 2.01 -instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where - mempty = (mempty, mempty, mempty) - --- | @since 4.9.0.0 -instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) - => Semigroup (a, b, c, d) where - (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') - stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d) - --- | @since 2.01 -instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where - mempty = (mempty, mempty, mempty, mempty) - --- | @since 4.9.0.0 -instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) - => Semigroup (a, b, c, d, e) where - (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') - stimes n (a,b,c,d,e) = - (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e) - --- | @since 2.01 -instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => - Monoid (a,b,c,d,e) where - mempty = (mempty, mempty, mempty, mempty, mempty) - - --- | @since 4.9.0.0 -instance Semigroup Ordering where - LT <> _ = LT - EQ <> y = y - GT <> _ = GT - - stimes = stimesIdempotentMonoid - --- lexicographical ordering --- | @since 2.01 -instance Monoid Ordering where - mempty = EQ - --- | @since 4.9.0.0 -instance Semigroup a => Semigroup (Maybe a) where - Nothing <> b = b - a <> Nothing = a - Just a <> Just b = Just (a <> b) - - stimes = stimesMaybe - --- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to --- : \"Any semigroup @S@ may be --- turned into a monoid simply by adjoining an element @e@ not in @S@ --- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S at .\" --- --- /Since 4.11.0/: constraint on inner @a@ value generalised from --- 'Monoid' to 'Semigroup'. --- --- @since 2.01 -instance Semigroup a => Monoid (Maybe a) where - mempty = Nothing - --- | @since 4.15 -instance Applicative Solo where - pure = MkSolo - - -- Note: we really want to match strictly here. This lets us write, - -- for example, - -- - -- forceSpine :: Foldable f => f a -> () - -- forceSpine xs - -- | MkSolo r <- traverse_ MkSolo xs - -- = r - MkSolo f <*> MkSolo x = MkSolo (f x) - liftA2 f (MkSolo x) (MkSolo y) = MkSolo (f x y) - --- | For tuples, the 'Monoid' constraint on @a@ determines --- how the first values merge. --- For example, 'String's concatenate: --- --- > ("hello ", (+15)) <*> ("world!", 2002) --- > ("hello world!",2017) --- --- @since 2.01 -instance Monoid a => Applicative ((,) a) where - pure x = (mempty, x) - (u, f) <*> (v, x) = (u <> v, f x) - liftA2 f (u, x) (v, y) = (u <> v, f x y) - --- | @since 4.15 -instance Monad Solo where - MkSolo x >>= f = f x - --- | @since 4.9.0.0 -instance Monoid a => Monad ((,) a) where - (u, a) >>= k = case k a of (v, b) -> (u <> v, b) - --- | @since 4.14.0.0 -instance Functor ((,,) a b) where - fmap f (a, b, c) = (a, b, f c) - --- | @since 4.14.0.0 -instance (Monoid a, Monoid b) => Applicative ((,,) a b) where - pure x = (mempty, mempty, x) - (a, b, f) <*> (a', b', x) = (a <> a', b <> b', f x) - --- | @since 4.14.0.0 -instance (Monoid a, Monoid b) => Monad ((,,) a b) where - (u, v, a) >>= k = case k a of (u', v', b) -> (u <> u', v <> v', b) - --- | @since 4.14.0.0 -instance Functor ((,,,) a b c) where - fmap f (a, b, c, d) = (a, b, c, f d) - --- | @since 4.14.0.0 -instance (Monoid a, Monoid b, Monoid c) => Applicative ((,,,) a b c) where - pure x = (mempty, mempty, mempty, x) - (a, b, c, f) <*> (a', b', c', x) = (a <> a', b <> b', c <> c', f x) - --- | @since 4.14.0.0 -instance (Monoid a, Monoid b, Monoid c) => Monad ((,,,) a b c) where - (u, v, w, a) >>= k = case k a of (u', v', w', b) -> (u <> u', v <> v', w <> w', b) - --- | @since 4.18.0.0 -instance Functor ((,,,,) a b c d) where - fmap f (a, b, c, d, e) = (a, b, c, d, f e) - --- | @since 4.18.0.0 -instance Functor ((,,,,,) a b c d e) where - fmap fun (a, b, c, d, e, f) = (a, b, c, d, e, fun f) - --- | @since 4.18.0.0 -instance Functor ((,,,,,,) a b c d e f) where - fmap fun (a, b, c, d, e, f, g) = (a, b, c, d, e, f, fun g) - --- | @since 4.10.0.0 -instance Semigroup a => Semigroup (IO a) where - (<>) = liftA2 (<>) - --- | @since 4.9.0.0 -instance Monoid a => Monoid (IO a) where - mempty = pure mempty - -{- | A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@ -lets you apply any function from @(a -> b)@ to turn an @f a@ into an @f b@, preserving the -structure of @f at . Furthermore @f@ needs to adhere to the following: - -[Identity] @'fmap' 'id' == 'id'@ -[Composition] @'fmap' (f . g) == 'fmap' f . 'fmap' g@ - -Note, that the second law follows from the free theorem of the type 'fmap' and -the first law, so you need only check that the former condition holds. -See or - -for an explanation. --} - -class Functor f where - -- | 'fmap' is used to apply a function of type @(a -> b)@ to a value of type @f a@, - -- where f is a functor, to produce a value of type @f b at . - -- Note that for any type constructor with more than one parameter (e.g., `Either`), - -- only the last type parameter can be modified with `fmap` (e.g., `b` in `Either a b`). - -- - -- Some type constructors with two parameters or more have a @'Data.Bifunctor'@ instance that allows - -- both the last and the penultimate parameters to be mapped over. - -- - -- ==== __Examples__ - -- - -- Convert from a @'Data.Maybe.Maybe' Int@ to a @Maybe String@ - -- using 'Prelude.show': - -- - -- >>> fmap show Nothing - -- Nothing - -- >>> fmap show (Just 3) - -- Just "3" - -- - -- Convert from an @'Data.Either.Either' Int Int@ to an - -- @Either Int String@ using 'Prelude.show': - -- - -- >>> fmap show (Left 17) - -- Left 17 - -- >>> fmap show (Right 17) - -- Right "17" - -- - -- Double each element of a list: - -- - -- >>> fmap (*2) [1,2,3] - -- [2,4,6] - -- - -- Apply 'Prelude.even' to the second element of a pair: - -- - -- >>> fmap even (2,2) - -- (2,True) - -- - -- It may seem surprising that the function is only applied to the last element of the tuple - -- compared to the list example above which applies it to every element in the list. - -- To understand, remember that tuples are type constructors with multiple type parameters: - -- a tuple of 3 elements @(a,b,c)@ can also be written @(,,) a b c@ and its @Functor@ instance - -- is defined for @Functor ((,,) a b)@ (i.e., only the third parameter is free to be mapped over - -- with @fmap@). - -- - -- It explains why @fmap@ can be used with tuples containing values of different types as in the - -- following example: - -- - -- >>> fmap even ("hello", 1.0, 4) - -- ("hello",1.0,True) - - fmap :: (a -> b) -> f a -> f b - - -- | Replace all locations in the input with the same value. - -- The default definition is @'fmap' . 'const'@, but this may be - -- overridden with a more efficient version. - -- - -- ==== __Examples__ - -- - -- Perform a computation with 'Maybe' and replace the result with a - -- constant value if it is 'Just': - -- - -- >>> 'a' <$ Just 2 - -- Just 'a' - -- >>> 'a' <$ Nothing - -- Nothing - (<$) :: a -> f b -> f a - (<$) = fmap . const - --- | A functor with application, providing operations to --- --- * embed pure expressions ('pure'), and --- --- * sequence computations and combine their results ('<*>' and 'liftA2'). --- --- A minimal complete definition must include implementations of 'pure' --- and of either '<*>' or 'liftA2'. If it defines both, then they must behave --- the same as their default definitions: --- --- @('<*>') = 'liftA2' 'id'@ --- --- @'liftA2' f x y = f 'Prelude.<$>' x '<*>' y@ --- --- Further, any definition must satisfy the following: --- --- [Identity] --- --- @'pure' 'id' '<*>' v = v@ --- --- [Composition] --- --- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ --- --- [Homomorphism] --- --- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ --- --- [Interchange] --- --- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ --- --- --- The other methods have the following default definitions, which may --- be overridden with equivalent specialized implementations: --- --- * @u '*>' v = ('id' '<$' u) '<*>' v@ --- --- * @u '<*' v = 'liftA2' 'const' u v@ --- --- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy --- --- * @'fmap' f x = 'pure' f '<*>' x@ --- --- --- It may be useful to note that supposing --- --- @forall x y. p (q x y) = f x . g y@ --- --- it follows from the above that --- --- @'liftA2' p ('liftA2' q u v) = 'liftA2' f u . 'liftA2' g v@ --- --- --- If @f@ is also a 'Monad', it should satisfy --- --- * @'pure' = 'return'@ --- --- * @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ --- --- * @('*>') = ('>>')@ --- --- (which implies that 'pure' and '<*>' satisfy the applicative functor laws). - -class Functor f => Applicative f where - {-# MINIMAL pure, ((<*>) | liftA2) #-} - -- | Lift a value. - pure :: a -> f a - - -- | Sequential application. - -- - -- A few functors support an implementation of '<*>' that is more - -- efficient than the default one. - -- - -- ==== __Example__ - -- Used in combination with @('<$>')@, @('<*>')@ can be used to build a record. - -- - -- >>> data MyState = MyState {arg1 :: Foo, arg2 :: Bar, arg3 :: Baz} - -- - -- >>> produceFoo :: Applicative f => f Foo - -- - -- >>> produceBar :: Applicative f => f Bar - -- >>> produceBaz :: Applicative f => f Baz - -- - -- >>> mkState :: Applicative f => f MyState - -- >>> mkState = MyState <$> produceFoo <*> produceBar <*> produceBaz - (<*>) :: f (a -> b) -> f a -> f b - (<*>) = liftA2 id - - -- | Lift a binary function to actions. - -- - -- Some functors support an implementation of 'liftA2' that is more - -- efficient than the default one. In particular, if 'fmap' is an - -- expensive operation, it is likely better to use 'liftA2' than to - -- 'fmap' over the structure and then use '<*>'. - -- - -- This became a typeclass method in 4.10.0.0. Prior to that, it was - -- a function defined in terms of '<*>' and 'fmap'. - -- - -- ==== __Example__ - -- >>> liftA2 (,) (Just 3) (Just 5) - -- Just (3,5) - - liftA2 :: (a -> b -> c) -> f a -> f b -> f c - liftA2 f x = (<*>) (fmap f x) - - -- | Sequence actions, discarding the value of the first argument. - -- - -- ==== __Examples__ - -- If used in conjunction with the Applicative instance for 'Maybe', - -- you can chain Maybe computations, with a possible "early return" - -- in case of 'Nothing'. - -- - -- >>> Just 2 *> Just 3 - -- Just 3 - -- - -- >>> Nothing *> Just 3 - -- Nothing - -- - -- Of course a more interesting use case would be to have effectful - -- computations instead of just returning pure values. - -- - -- >>> import Data.Char - -- >>> import Text.ParserCombinators.ReadP - -- >>> let p = string "my name is " *> munch1 isAlpha <* eof - -- >>> readP_to_S p "my name is Simon" - -- [("Simon","")] - - (*>) :: f a -> f b -> f b - a1 *> a2 = (id <$ a1) <*> a2 - - -- This is essentially the same as liftA2 (flip const), but if the - -- Functor instance has an optimized (<$), it may be better to use - -- that instead. Before liftA2 became a method, this definition - -- was strictly better, but now it depends on the functor. For a - -- functor supporting a sharing-enhancing (<$), this definition - -- may reduce allocation by preventing a1 from ever being fully - -- realized. In an implementation with a boring (<$) but an optimizing - -- liftA2, it would likely be better to define (*>) using liftA2. - - -- | Sequence actions, discarding the value of the second argument. - -- - (<*) :: f a -> f b -> f a - (<*) = liftA2 const - --- | A variant of '<*>' with the arguments reversed. --- -(<**>) :: Applicative f => f a -> f (a -> b) -> f b -(<**>) = liftA2 (\a f -> f a) --- Don't use $ here, see the note at the top of the page - --- | Lift a function to actions. --- Equivalent to Functor's `fmap` but implemented using only `Applicative`'s methods: --- @'liftA' f a = 'pure' f '<*>' a@ --- --- As such this function may be used to implement a `Functor` instance from an `Applicative` one. --- --- ==== __Examples__ --- Using the Applicative instance for Lists: --- --- >>> liftA (+1) [1, 2] --- [2,3] --- --- Or the Applicative instance for 'Maybe' --- --- >>> liftA (+1) (Just 3) --- Just 4 - -liftA :: Applicative f => (a -> b) -> f a -> f b -liftA f a = pure f <*> a --- Caution: since this may be used for `fmap`, we can't use the obvious --- definition of liftA = fmap. - --- | Lift a ternary function to actions. - -liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d -liftA3 f a b c = liftA2 f a b <*> c - - -{-# INLINABLE liftA #-} -{-# SPECIALISE liftA :: (a1->r) -> IO a1 -> IO r #-} -{-# SPECIALISE liftA :: (a1->r) -> Maybe a1 -> Maybe r #-} -{-# INLINABLE liftA3 #-} -{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} -{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> - Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} - --- | The 'join' function is the conventional monad join operator. It --- is used to remove one level of monadic structure, projecting its --- bound argument into the outer level. --- --- --- \'@'join' bss@\' can be understood as the @do@ expression --- --- @ --- do bs <- bss --- bs --- @ --- --- ==== __Examples__ --- --- A common use of 'join' is to run an 'IO' computation returned from --- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions --- can't perform 'IO' directly. Recall that --- --- @ --- 'GHC.Conc.atomically' :: STM a -> IO a --- @ --- --- is used to run 'GHC.Conc.STM' transactions atomically. So, by --- specializing the types of 'GHC.Conc.atomically' and 'join' to --- --- @ --- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b) --- 'join' :: IO (IO b) -> IO b --- @ --- --- we can compose them as --- --- @ --- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b --- @ --- --- to run an 'GHC.Conc.STM' transaction and the 'IO' action it --- returns. -join :: (Monad m) => m (m a) -> m a -join x = x >>= id - -{- | The 'Monad' class defines the basic operations over a /monad/, -a concept from a branch of mathematics known as /category theory/. -From the perspective of a Haskell programmer, however, it is best to -think of a monad as an /abstract datatype/ of actions. -Haskell's @do@ expressions provide a convenient syntax for writing -monadic expressions. - -Instances of 'Monad' should satisfy the following: - -[Left identity] @'return' a '>>=' k = k a@ -[Right identity] @m '>>=' 'return' = m@ -[Associativity] @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ - -Furthermore, the 'Monad' and 'Applicative' operations should relate as follows: - -* @'pure' = 'return'@ -* @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ - -The above laws imply: - -* @'fmap' f xs = xs '>>=' 'return' . f@ -* @('>>') = ('*>')@ - -and that 'pure' and ('<*>') satisfy the applicative functor laws. - -The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' -defined in the "Prelude" satisfy these laws. --} -class Applicative m => Monad m where - -- | Sequentially compose two actions, passing any value produced - -- by the first as an argument to the second. - -- - -- \'@as '>>=' bs@\' can be understood as the @do@ expression - -- - -- @ - -- do a <- as - -- bs a - -- @ - (>>=) :: forall a b. m a -> (a -> m b) -> m b - - -- | Sequentially compose two actions, discarding any value produced - -- by the first, like sequencing operators (such as the semicolon) - -- in imperative languages. - -- - -- \'@as '>>' bs@\' can be understood as the @do@ expression - -- - -- @ - -- do as - -- bs - -- @ - (>>) :: forall a b. m a -> m b -> m b - m >> k = m >>= \_ -> k -- See Note [Recursive bindings for Applicative/Monad] - {-# INLINE (>>) #-} - - -- | Inject a value into the monadic type. - return :: a -> m a - return = pure - -{- Note [Recursive bindings for Applicative/Monad] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The original Applicative/Monad proposal stated that after -implementation, the designated implementation of (>>) would become - - (>>) :: forall a b. m a -> m b -> m b - (>>) = (*>) - -by default. You might be inclined to change this to reflect the stated -proposal, but you really shouldn't! Why? Because people tend to define -such instances the /other/ way around: in particular, it is perfectly -legitimate to define an instance of Applicative (*>) in terms of (>>), -which would lead to an infinite loop for the default implementation of -Monad! And people do this in the wild. - -This turned into a nasty bug that was tricky to track down, and rather -than eliminate it everywhere upstream, it's easier to just retain the -original default. - --} - --- | Same as '>>=', but with the arguments interchanged. -{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-} -(=<<) :: Monad m => (a -> m b) -> m a -> m b -f =<< x = x >>= f - --- | Conditional execution of 'Applicative' expressions. For example, --- --- > when debug (putStrLn "Debugging") --- --- will output the string @Debugging@ if the Boolean value @debug@ --- is 'True', and otherwise do nothing. -when :: (Applicative f) => Bool -> f () -> f () -{-# INLINABLE when #-} -{-# SPECIALISE when :: Bool -> IO () -> IO () #-} -{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} -when p s = if p then s else pure () - --- | Evaluate each action in the sequence from left to right, --- and collect the results. -sequence :: Monad m => [m a] -> m [a] -{-# INLINE sequence #-} -sequence = mapM id --- Note: [sequence and mapM] - --- | @'mapM' f@ is equivalent to @'sequence' . 'map' f at . -mapM :: Monad m => (a -> m b) -> [a] -> m [b] -{-# INLINE mapM #-} -mapM f as = foldr k (return []) as - where - k a r = do { x <- f a; xs <- r; return (x:xs) } - -{- -Note: [sequence and mapM] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Originally, we defined - -mapM f = sequence . map f - -This relied on list fusion to produce efficient code for mapM, and led to -excessive allocation in cryptarithm2. Defining - -sequence = mapM id - -relies only on inlining a tiny function (id) and beta reduction, which tends to -be a more reliable aspect of simplification. Indeed, this does not lead to -similar problems in nofib. --} - --- | Promote a function to a monad. -liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r -liftM f m1 = do { x1 <- m1; return (f x1) } - --- | Promote a function to a monad, scanning the monadic arguments from --- left to right. For example, --- --- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] --- > liftM2 (+) (Just 1) Nothing = Nothing --- -liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r -liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) } --- Caution: since this may be used for `liftA2`, we can't use the obvious --- definition of liftM2 = liftA2. - --- | Promote a function to a monad, scanning the monadic arguments from --- left to right (cf. 'liftM2'). -liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r -liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) } - --- | Promote a function to a monad, scanning the monadic arguments from --- left to right (cf. 'liftM2'). -liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r -liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) } - --- | Promote a function to a monad, scanning the monadic arguments from --- left to right (cf. 'liftM2'). -liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r -liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) } - -{-# INLINABLE liftM #-} -{-# SPECIALISE liftM :: (a1->r) -> IO a1 -> IO r #-} -{-# SPECIALISE liftM :: (a1->r) -> Maybe a1 -> Maybe r #-} -{-# INLINABLE liftM2 #-} -{-# SPECIALISE liftM2 :: (a1->a2->r) -> IO a1 -> IO a2 -> IO r #-} -{-# SPECIALISE liftM2 :: (a1->a2->r) -> Maybe a1 -> Maybe a2 -> Maybe r #-} -{-# INLINABLE liftM3 #-} -{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} -{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} -{-# INLINABLE liftM4 #-} -{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO r #-} -{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe r #-} -{-# INLINABLE liftM5 #-} -{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO a5 -> IO r #-} -{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe a5 -> Maybe r #-} - -{- | In many situations, the 'liftM' operations can be replaced by uses of -'ap', which promotes function application. - -> return f `ap` x1 `ap` ... `ap` xn - -is equivalent to - -> liftMn f x1 x2 ... xn - --} - -ap :: (Monad m) => m (a -> b) -> m a -> m b -ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } --- Since many Applicative instances define (<*>) = ap, we --- cannot define ap = (<*>) -{-# INLINABLE ap #-} -{-# SPECIALISE ap :: IO (a -> b) -> IO a -> IO b #-} -{-# SPECIALISE ap :: Maybe (a -> b) -> Maybe a -> Maybe b #-} - --- instances for Prelude types - --- | @since 2.01 -instance Functor ((->) r) where - fmap = (.) - --- | @since 2.01 -instance Applicative ((->) r) where - pure = const - (<*>) f g x = f x (g x) - liftA2 q f g x = q (f x) (g x) - --- | @since 2.01 -instance Monad ((->) r) where - f >>= k = \ r -> k (f r) r - --- | @since 4.15 -instance Functor Solo where - fmap f (MkSolo a) = MkSolo (f a) - - -- Being strict in the `Solo` argument here seems most consistent - -- with the concept behind `Solo`: always strict in the wrapper and lazy - -- in the contents. - x <$ MkSolo _ = MkSolo x - --- | @since 2.01 -instance Functor ((,) a) where - fmap f (x,y) = (x, f y) - --- | @since 2.01 -instance Functor Maybe where - fmap _ Nothing = Nothing - fmap f (Just a) = Just (f a) - --- | @since 2.01 -instance Applicative Maybe where - pure = Just - - Just f <*> m = fmap f m - Nothing <*> _m = Nothing - - liftA2 f (Just x) (Just y) = Just (f x y) - liftA2 _ _ _ = Nothing - - Just _m1 *> m2 = m2 - Nothing *> _m2 = Nothing - --- | @since 2.01 -instance Monad Maybe where - (Just x) >>= k = k x - Nothing >>= _ = Nothing - - (>>) = (*>) - --- ----------------------------------------------------------------------------- --- The Alternative class definition - -infixl 3 <|> - --- | A monoid on applicative functors. --- --- If defined, 'some' and 'many' should be the least solutions --- of the equations: --- --- * @'some' v = (:) 'Prelude.<$>' v '<*>' 'many' v@ --- --- * @'many' v = 'some' v '<|>' 'pure' []@ -class Applicative f => Alternative f where - -- | The identity of '<|>' - empty :: f a - -- | An associative binary operation - (<|>) :: f a -> f a -> f a - - -- | One or more. - some :: f a -> f [a] - some v = some_v - where - many_v = some_v <|> pure [] - some_v = liftA2 (:) v many_v - - -- | Zero or more. - many :: f a -> f [a] - many v = many_v - where - many_v = some_v <|> pure [] - some_v = liftA2 (:) v many_v - - --- | Picks the leftmost 'Just' value, or, alternatively, 'Nothing'. --- --- @since 2.01 -instance Alternative Maybe where - empty = Nothing - Nothing <|> r = r - l <|> _ = l - --- ----------------------------------------------------------------------------- --- The MonadPlus class definition - --- | Monads that also support choice and failure. -class (Alternative m, Monad m) => MonadPlus m where - -- | The identity of 'mplus'. It should also satisfy the equations - -- - -- > mzero >>= f = mzero - -- > v >> mzero = mzero - -- - -- The default definition is - -- - -- @ - -- mzero = 'empty' - -- @ - mzero :: m a - mzero = empty - - -- | An associative operation. The default definition is - -- - -- @ - -- mplus = ('<|>') - -- @ - mplus :: m a -> m a -> m a - mplus = (<|>) - --- | Picks the leftmost 'Just' value, or, alternatively, 'Nothing'. --- --- @since 2.01 -instance MonadPlus Maybe - ---------------------------------------------- --- The non-empty list type - -infixr 5 :| - --- | Non-empty (and non-strict) list type. --- --- @since 4.9.0.0 -data NonEmpty a = a :| [a] - deriving ( Eq -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - ) - --- | @since 4.9.0.0 -instance Functor NonEmpty where - fmap f ~(a :| as) = f a :| fmap f as - b <$ ~(_ :| as) = b :| (b <$ as) - --- | @since 4.9.0.0 -instance Applicative NonEmpty where - pure a = a :| [] - (<*>) = ap - liftA2 = liftM2 - --- | @since 4.9.0.0 -instance Monad NonEmpty where - ~(a :| as) >>= f = b :| (bs ++ bs') - where b :| bs = f a - bs' = as >>= toList . f - toList ~(c :| cs) = c : cs - ----------------------------------------------- --- The list type - --- | @since 2.01 -instance Functor [] where - {-# INLINE fmap #-} - fmap = map - --- See Note: [List comprehensions and inlining] --- | @since 2.01 -instance Applicative [] where - {-# INLINE pure #-} - pure x = [x] - {-# INLINE (<*>) #-} - fs <*> xs = [f x | f <- fs, x <- xs] - {-# INLINE liftA2 #-} - liftA2 f xs ys = [f x y | x <- xs, y <- ys] - {-# INLINE (*>) #-} - xs *> ys = [y | _ <- xs, y <- ys] - --- See Note: [List comprehensions and inlining] --- | @since 2.01 -instance Monad [] where - {-# INLINE (>>=) #-} - xs >>= f = [y | x <- xs, y <- f x] - {-# INLINE (>>) #-} - (>>) = (*>) - --- | Combines lists by concatenation, starting from the empty list. --- --- @since 2.01 -instance Alternative [] where - empty = [] - (<|>) = (++) - --- | Combines lists by concatenation, starting from the empty list. --- --- @since 2.01 -instance MonadPlus [] - -{- -A few list functions that appear here because they are used here. -The rest of the prelude list functions are in GHC.List. --} - ----------------------------------------------- --- foldr/build/augment ----------------------------------------------- - --- | 'foldr', applied to a binary operator, a starting value (typically --- the right-identity of the operator), and a list, reduces the list --- using the binary operator, from right to left: --- --- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) - -foldr :: (a -> b -> b) -> b -> [a] -> b --- foldr _ z [] = z --- foldr f z (x:xs) = f x (foldr f z xs) -{-# INLINE [0] foldr #-} --- Inline only in the final stage, after the foldr/cons rule has had a chance --- Also note that we inline it when it has *two* parameters, which are the --- ones we are keen about specialising! -foldr k z = go - where - go [] = z - go (y:ys) = y `k` go ys - --- | A list producer that can be fused with 'foldr'. --- This function is merely --- --- > build g = g (:) [] --- --- but GHC's simplifier will transform an expression of the form --- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@, --- which avoids producing an intermediate list. - -build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] -{-# INLINE [1] build #-} - -- The INLINE is important, even though build is tiny, - -- because it prevents [] getting inlined in the version that - -- appears in the interface file. If [] *is* inlined, it - -- won't match with [] appearing in rules in an importing module. - -- - -- The "1" says to inline in phase 1 - -build g = g (:) [] - --- | A list producer that can be fused with 'foldr'. --- This function is merely --- --- > augment g xs = g (:) xs --- --- but GHC's simplifier will transform an expression of the form --- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to --- @g k ('foldr' k z xs)@, which avoids producing an intermediate list. - -augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a] -{-# INLINE [1] augment #-} -augment g xs = g (:) xs - -{-# RULES -"fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) . - foldr k z (build g) = g k z - -"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . - foldr k z (augment g xs) = g k (foldr k z xs) - -"foldr/id" foldr (:) [] = \x -> x -"foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys - -- Only activate this from phase 1, because that's - -- when we disable the rule that expands (++) into foldr - --- The foldr/cons rule looks nice, but it can give disastrously --- bloated code when compiling --- array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] --- i.e. when there are very very long literal lists --- So I've disabled it for now. We could have special cases --- for short lists, I suppose. --- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs) - -"foldr/single" forall k z x. foldr k z [x] = k x z -"foldr/nil" forall k z. foldr k z [] = z - -"foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) . - foldr k z (x:build g) = k x (g k z) - -"augment/build" forall (g::forall b. (a->b->b) -> b -> b) - (h::forall b. (a->b->b) -> b -> b) . - augment g (build h) = build (\c n -> g c (h c n)) -"augment/nil" forall (g::forall b. (a->b->b) -> b -> b) . - augment g [] = build g - #-} - --- This rule is true, but not (I think) useful: --- augment g (augment h t) = augment (\cn -> g c (h c n)) t - ----------------------------------------------- --- map ----------------------------------------------- - --- | \(\mathcal{O}(n)\). 'map' @f xs@ is the list obtained by applying @f@ to --- each element of @xs@, i.e., --- --- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn] --- > map f [x1, x2, ...] == [f x1, f x2, ...] --- --- >>> map (+1) [1, 2, 3] --- [2,3,4] -map :: (a -> b) -> [a] -> [b] -{-# NOINLINE [0] map #-} - -- We want the RULEs "map" and "map/coerce" to fire first. - -- map is recursive, so won't inline anyway, - -- but saying so is more explicit, and silences warnings -map _ [] = [] -map f (x:xs) = f x : map f xs - --- Note eta expanded -mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst -{-# INLINE [0] mapFB #-} -- See Note [Inline FB functions] in GHC.List -mapFB c f = \x ys -> c (f x) ys - -{- Note [The rules for map] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The rules for map work like this. - -* Up to (but not including) phase 1, we use the "map" rule to - rewrite all saturated applications of map with its build/fold - form, hoping for fusion to happen. - - In phase 1 and 0, we switch off that rule, inline build, and - switch on the "mapList" rule, which rewrites the foldr/mapFB - thing back into plain map. - - It's important that these two rules aren't both active at once - (along with build's unfolding) else we'd get an infinite loop - in the rules. Hence the activation control below. - -* This same pattern is followed by many other functions: - e.g. append, filter, iterate, repeat, etc. in GHC.List - - See also Note [Inline FB functions] in GHC.List - -* The "mapFB" rule optimises compositions of map - -* The "mapFB/id" rule gets rid of 'map id' calls. - You might think that (mapFB c id) will turn into c simply - when mapFB is inlined; but before that happens the "mapList" - rule turns - (foldr (mapFB (:) id) [] a - back into - map id - Which is not very clever. - -* Any similarity to the Functor laws for [] is expected. --} - -{-# RULES -"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) -"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f -"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g) -"mapFB/id" forall c. mapFB c (\x -> x) = c - #-} - --- See Breitner, Eisenberg, Peyton Jones, and Weirich, "Safe Zero-cost --- Coercions for Haskell", section 6.5: --- http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf - -{-# RULES "map/coerce" [1] map coerce = coerce #-} --- See Note [Getting the map/coerce RULE to work] in GHC.Core.SimpleOpt - ----------------------------------------------- --- append ----------------------------------------------- - --- | Append two lists, i.e., --- --- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] --- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] --- --- If the first list is not finite, the result is the first list. --- --- WARNING: This function takes linear time in the number of elements of the --- first list. - -(++) :: [a] -> [a] -> [a] -{-# NOINLINE [2] (++) #-} - -- Give time for the RULEs for (++) to fire in InitialPhase - -- It's recursive, so won't inline anyway, - -- but saying so is more explicit -(++) [] ys = ys -(++) (x:xs) ys = x : xs ++ ys - -{-# RULES -"++/literal" forall x. (++) (unpackCString# x) = unpackAppendCString# x -"++/literal_utf8" forall x. (++) (unpackCStringUtf8# x) = unpackAppendCStringUtf8# x #-} - -{-# RULES -"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys - #-} - - -- |'otherwise' is defined as the value 'True'. It helps to make -- guards more readable. eg. -- @@ -1489,35 +195,6 @@ The rules for map work like this. otherwise :: Bool otherwise = True ----------------------------------------------- --- Type Char and String ----------------------------------------------- - --- | A 'String' is a list of characters. String constants in Haskell are values --- of type 'String'. --- --- See "Data.List" for operations on lists. -type String = [Char] - -unsafeChr :: Int -> Char -unsafeChr (I# i#) = C# (chr# i#) - --- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'. -ord :: Char -> Int -ord (C# c#) = I# (ord# c#) - --- | This 'String' equality predicate is used when desugaring --- pattern-matches against strings. -eqString :: String -> String -> Bool -eqString [] [] = True -eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 -eqString _ _ = False - -{-# RULES "eqString" (==) = eqString #-} --- eqString also has a BuiltInRule in GHC.Core.Opt.ConstantFold: --- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2 - - ---------------------------------------------- -- 'Int' related definitions ---------------------------------------------- @@ -1536,16 +213,6 @@ minInt = I# (-0x8000000000000000#) maxInt = I# 0x7FFFFFFFFFFFFFFF# #endif ----------------------------------------------- --- The function type ----------------------------------------------- - --- | Identity function. --- --- > id x = x -id :: a -> a -id x = x - -- Assertion function. This simply ignores its boolean argument. -- The compiler may rewrite it to @('assertError' line)@. @@ -1574,112 +241,7 @@ breakpointCond :: Bool -> a -> a breakpointCond _ r = r data Opaque = forall a. O a --- | @const x y@ always evaluates to @x@, ignoring its second argument. --- --- >>> const 42 "hello" --- 42 --- --- >>> map (const 42) [0..3] --- [42,42,42,42] -const :: a -> b -> a -const x _ = x - --- | Function composition. -{-# INLINE (.) #-} --- Make sure it has TWO args only on the left, so that it inlines --- when applied to two functions, even if there is no final argument -(.) :: (b -> c) -> (a -> b) -> a -> c -(.) f g = \x -> f (g x) - --- | @'flip' f@ takes its (first) two arguments in the reverse order of @f at . --- --- >>> flip (++) "hello" "world" --- "worldhello" -flip :: (a -> b -> c) -> b -> a -> c -flip f x y = f y x - --- Note: Before base-4.19, ($) was not representation polymorphic --- in both type parameters but only in the return type. --- The generalization forced a change to the implementation, --- changing its laziness, affecting expressions like (($) undefined): before --- base-4.19 the expression (($) undefined) `seq` () was equivalent to --- (\x -> undefined x) `seq` () and thus would just evaluate to (), but now --- it is equivalent to undefined `seq` () which diverges. - -{- | @($)@ is the __function application__ operator. - -Applying @($)@ to a function @f@ and an argument @x@ gives the same result as applying @f@ to @x@ directly. The definition is akin to this: - -@ -($) :: (a -> b) -> a -> b -($) f x = f x -@ - -On the face of it, this may appear pointless! But it's actually one of the most useful and important operators in Haskell. - -The order of operations is very different between @($)@ and normal function application. Normal function application has precedence 10 - higher than any operator - and associates to the left. So these two definitions are equivalent: - -@ -expr = min 5 1 + 5 -expr = ((min 5) 1) + 5 -@ - -@($)@ has precedence 0 (the lowest) and associates to the right, so these are equivalent: - -@ -expr = min 5 $ 1 + 5 -expr = (min 5) (1 + 5) -@ - -=== Uses -A common use cases of @($)@ is to avoid parentheses in complex expressions. - -For example, instead of using nested parentheses in the following - Haskell function: - -@ --- | Sum numbers in a string: strSum "100 5 -7" == 98 -strSum :: 'String' -> 'Int' -strSum s = 'sum' ('Data.Maybe.mapMaybe' 'Text.Read.readMaybe' ('words' s)) -@ - -we can deploy the function application operator: - -@ --- | Sum numbers in a string: strSum "100 5 -7" == 98 -strSum :: 'String' -> 'Int' -strSum s = 'sum' '$' 'Data.Maybe.mapMaybe' 'Text.Read.readMaybe' '$' 'words' s -@ - -@($)@ is also used as a section (a partially applied operator), in order to indicate that we wish to apply some yet-unspecified function to a given value. For example, to apply the argument @5@ to a list of functions: - -@ -applyFive :: [Int] -applyFive = map ($ 5) [(+1), (2^)] ->>> [6, 32] -@ - -=== Technical Remark (Representation Polymorphism) - -@($)@ is fully representation-polymorphic. This allows it to also be used with arguments of unlifted and even unboxed kinds, such as unboxed integers: - -@ -fastMod :: Int -> Int -> Int -fastMod (I# x) (I# m) = I# $ remInt# x m -@ --} -{-# INLINE ($) #-} -($) :: forall repa repb (a :: TYPE repa) (b :: TYPE repb). (a -> b) -> a -> b -($) f = f - --- | Strict (call-by-value) application operator. It takes a function and an --- argument, evaluates the argument to weak head normal form (WHNF), then calls --- the function with that value. - -($!) :: forall r a (b :: TYPE r). (a -> b) -> a -> b -{-# INLINE ($!) #-} -f $! x = let !vx = x in f vx -- see #2273 -- | @'until' p f@ yields the result of applying @f@ until @p@ holds. until :: (a -> Bool) -> (a -> a) -> a -> a @@ -1688,70 +250,6 @@ until p f = go go x | p x = x | otherwise = go (f x) --- | 'asTypeOf' is a type-restricted version of 'const'. It is usually --- used as an infix operator, and its typing forces its first argument --- (which is usually overloaded) to have the same type as the second. -asTypeOf :: a -> a -> a -asTypeOf = const - ----------------------------------------------- --- Functor/Applicative/Monad instances for IO ----------------------------------------------- - --- | @since 2.01 -instance Functor IO where - fmap f x = x >>= (pure . f) - --- | @since 2.01 -instance Applicative IO where - {-# INLINE pure #-} - {-# INLINE (*>) #-} - {-# INLINE liftA2 #-} - pure = returnIO - (*>) = thenIO - (<*>) = ap - liftA2 = liftM2 - --- | @since 2.01 -instance Monad IO where - {-# INLINE (>>) #-} - {-# INLINE (>>=) #-} - (>>) = (*>) - (>>=) = bindIO - --- | Takes the first non-throwing 'IO' action\'s result. --- 'empty' throws an exception. --- --- @since 4.9.0.0 -instance Alternative IO where - empty = failIO "mzero" - (<|>) = mplusIO - --- | Takes the first non-throwing 'IO' action\'s result. --- 'mzero' throws an exception. --- --- @since 4.9.0.0 -instance MonadPlus IO - -returnIO :: a -> IO a -returnIO x = IO (\ s -> (# s, x #)) - -bindIO :: IO a -> (a -> IO b) -> IO b -bindIO (IO m) k = IO (\ s -> case m s of (# new_s, a #) -> unIO (k a) new_s) - -thenIO :: IO a -> IO b -> IO b -thenIO (IO m) k = IO (\ s -> case m s of (# new_s, _ #) -> unIO k new_s) - --- Note that it is import that we do not SOURCE import this as --- its demand signature encodes knowledge of its bottoming --- behavior, which can expose useful simplifications. See --- #16588. -failIO :: String -> IO a -failIO s = IO (raiseIO# (mkUserError s)) - -unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #)) -unIO (IO a) = a - {- | Returns the tag of a constructor application; this function is used by the deriving code for Eq, Ord and Enum. @@ -1918,21 +416,3 @@ a `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = negateInt# (a <# 0#) iShiftRL# :: Int# -> Int# -> Int# a `iShiftRL#` b = (a `uncheckedIShiftRL#` b) `andI#` shift_mask WORD_SIZE_IN_BITS# b --- Rules for C strings (the functions themselves are now in GHC.CString) -{-# RULES -"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) -"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a -"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n -"unpack-append-nil" forall a . unpackAppendCString# a [] = unpackCString# a - -"unpack-utf8" [~1] forall a . unpackCStringUtf8# a = build (unpackFoldrCStringUtf8# a) -"unpack-list-utf8" [1] forall a . unpackFoldrCStringUtf8# a (:) [] = unpackCStringUtf8# a -"unpack-append-utf8" forall a n . unpackFoldrCStringUtf8# a (:) n = unpackAppendCStringUtf8# a n -"unpack-append-nil-utf8" forall a . unpackAppendCStringUtf8# a [] = unpackCStringUtf8# a - --- There's a built-in rule (in GHC.Core.Op.ConstantFold) for --- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n - --- See also the Note [String literals in GHC] in CString.hs - - #-} ===================================== libraries/base/GHC/Base/FunOps.hs ===================================== @@ -0,0 +1,140 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} + +module GHC.Base.FunOps + ( id + , const + , (.) + , flip + , ($) + , ($!) + , asTypeOf + ) where + +import GHC.Types + +infixr 9 . +infixr 0 $, $! + +-- | Identity function. +-- +-- > id x = x +id :: a -> a +id x = x + +-- | @const x y@ always evaluates to @x@, ignoring its second argument. +-- +-- >>> const 42 "hello" +-- 42 +-- +-- >>> map (const 42) [0..3] +-- [42,42,42,42] +const :: a -> b -> a +const x _ = x + +-- | Function composition. +{-# INLINE (.) #-} +-- Make sure it has TWO args only on the left, so that it inlines +-- when applied to two functions, even if there is no final argument +(.) :: (b -> c) -> (a -> b) -> a -> c +(.) f g = \x -> f (g x) + +-- | @'flip' f@ takes its (first) two arguments in the reverse order of @f at . +-- +-- >>> flip (++) "hello" "world" +-- "worldhello" +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +-- Note: Before base-4.19, ($) was not representation polymorphic +-- in both type parameters but only in the return type. +-- The generalization forced a change to the implementation, +-- changing its laziness, affecting expressions like (($) undefined): before +-- base-4.19 the expression (($) undefined) `seq` () was equivalent to +-- (\x -> undefined x) `seq` () and thus would just evaluate to (), but now +-- it is equivalent to undefined `seq` () which diverges. + +{- | @($)@ is the __function application__ operator. + +Applying @($)@ to a function @f@ and an argument @x@ gives the same result as applying @f@ to @x@ directly. The definition is akin to this: + +@ +($) :: (a -> b) -> a -> b +($) f x = f x +@ + +On the face of it, this may appear pointless! But it's actually one of the most useful and important operators in Haskell. + +The order of operations is very different between @($)@ and normal function application. Normal function application has precedence 10 - higher than any operator - and associates to the left. So these two definitions are equivalent: + +@ +expr = min 5 1 + 5 +expr = ((min 5) 1) + 5 +@ + +@($)@ has precedence 0 (the lowest) and associates to the right, so these are equivalent: + +@ +expr = min 5 $ 1 + 5 +expr = (min 5) (1 + 5) +@ + +=== Uses + +A common use cases of @($)@ is to avoid parentheses in complex expressions. + +For example, instead of using nested parentheses in the following + Haskell function: + +@ +-- | Sum numbers in a string: strSum "100 5 -7" == 98 +strSum :: 'String' -> 'Int' +strSum s = 'sum' ('Data.Maybe.mapMaybe' 'Text.Read.readMaybe' ('words' s)) +@ + +we can deploy the function application operator: + +@ +-- | Sum numbers in a string: strSum "100 5 -7" == 98 +strSum :: 'String' -> 'Int' +strSum s = 'sum' '$' 'Data.Maybe.mapMaybe' 'Text.Read.readMaybe' '$' 'words' s +@ + +@($)@ is also used as a section (a partially applied operator), in order to indicate that we wish to apply some yet-unspecified function to a given value. For example, to apply the argument @5@ to a list of functions: + +@ +applyFive :: [Int] +applyFive = map ($ 5) [(+1), (2^)] +>>> [6, 32] +@ + +=== Technical Remark (Representation Polymorphism) + +@($)@ is fully representation-polymorphic. This allows it to also be used with arguments of unlifted and even unboxed kinds, such as unboxed integers: + +@ +fastMod :: Int -> Int -> Int +fastMod (I# x) (I# m) = I# $ remInt# x m +@ +-} +{-# INLINE ($) #-} +($) :: forall repa repb (a :: TYPE repa) (b :: TYPE repb). (a -> b) -> a -> b +($) f = f + +-- | Strict (call-by-value) application operator. It takes a function and an +-- argument, evaluates the argument to weak head normal form (WHNF), then calls +-- the function with that value. + +($!) :: forall r a (b :: TYPE r). (a -> b) -> a -> b +{-# INLINE ($!) #-} +f $! x = let !vx = x in f vx -- see #2273 + +-- | 'asTypeOf' is a type-restricted version of 'const'. It is usually +-- used as an infix operator, and its typing forces its first argument +-- (which is usually overloaded) to have the same type as the second. +asTypeOf :: a -> a -> a +asTypeOf = const + ===================================== libraries/base/GHC/Base/Functor.hs ===================================== @@ -0,0 +1,883 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE RankNTypes #-} + +{-# OPTIONS_HADDOCK not-home #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Base.Functor +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- The functor class hierarchy. +-- +----------------------------------------------------------------------------- + +module GHC.Base.Functor + ( Functor(..) + , Applicative(..) + , Monad(..) + , liftA + , liftA3 + , join + , when + , sequence + , mapM + , liftM + , liftM2 + , liftM3 + , liftM4 + , liftM5 + , ap + , (<**>) + , (=<<) + -- * Alternative + , Alternative(..) + , MonadPlus(..) + -- * 'IO' helpers + , returnIO + , bindIO + , thenIO + , failIO + , unIO + ) where + +import GHC.Types (Bool, IO(..)) +import GHC.Prim (State#, RealWorld, raiseIO#) +import GHC.Tuple (Solo(..)) + +import GHC.Base.FunOps (const, id, (.)) +import GHC.Base.List +import GHC.Base.NonEmpty (NonEmpty(..)) +import GHC.Base.Semigroup (Monoid(mempty), Semigroup((<>))) +import GHC.Base.String (String) +import GHC.Maybe (Maybe(..)) + +import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO) + +default () -- Double isn't available yet + +infixl 4 <$ +infixl 1 >>, >>= +infixr 1 =<< +infixl 4 <*>, <*, *>, <**> +infixl 3 <|> + +{- | A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@ +lets you apply any function from @(a -> b)@ to turn an @f a@ into an @f b@, preserving the +structure of @f at . Furthermore @f@ needs to adhere to the following: + +[Identity] @'fmap' 'id' == 'id'@ +[Composition] @'fmap' (f . g) == 'fmap' f . 'fmap' g@ + +Note, that the second law follows from the free theorem of the type 'fmap' and +the first law, so you need only check that the former condition holds. +See or + +for an explanation. +-} + +class Functor f where + -- | 'fmap' is used to apply a function of type @(a -> b)@ to a value of type @f a@, + -- where f is a functor, to produce a value of type @f b at . + -- Note that for any type constructor with more than one parameter (e.g., `Either`), + -- only the last type parameter can be modified with `fmap` (e.g., `b` in `Either a b`). + -- + -- Some type constructors with two parameters or more have a @'Data.Bifunctor'@ instance that allows + -- both the last and the penultimate parameters to be mapped over. + -- + -- ==== __Examples__ + -- + -- Convert from a @'Data.Maybe.Maybe' Int@ to a @Maybe String@ + -- using 'Prelude.show': + -- + -- >>> fmap show Nothing + -- Nothing + -- >>> fmap show (Just 3) + -- Just "3" + -- + -- Convert from an @'Data.Either.Either' Int Int@ to an + -- @Either Int String@ using 'Prelude.show': + -- + -- >>> fmap show (Left 17) + -- Left 17 + -- >>> fmap show (Right 17) + -- Right "17" + -- + -- Double each element of a list: + -- + -- >>> fmap (*2) [1,2,3] + -- [2,4,6] + -- + -- Apply 'Prelude.even' to the second element of a pair: + -- + -- >>> fmap even (2,2) + -- (2,True) + -- + -- It may seem surprising that the function is only applied to the last element of the tuple + -- compared to the list example above which applies it to every element in the list. + -- To understand, remember that tuples are type constructors with multiple type parameters: + -- a tuple of 3 elements @(a,b,c)@ can also be written @(,,) a b c@ and its @Functor@ instance + -- is defined for @Functor ((,,) a b)@ (i.e., only the third parameter is free to be mapped over + -- with @fmap@). + -- + -- It explains why @fmap@ can be used with tuples containing values of different types as in the + -- following example: + -- + -- >>> fmap even ("hello", 1.0, 4) + -- ("hello",1.0,True) + + fmap :: (a -> b) -> f a -> f b + + -- | Replace all locations in the input with the same value. + -- The default definition is @'fmap' . 'const'@, but this may be + -- overridden with a more efficient version. + -- + -- ==== __Examples__ + -- + -- Perform a computation with 'Maybe' and replace the result with a + -- constant value if it is 'Just': + -- + -- >>> 'a' <$ Just 2 + -- Just 'a' + -- >>> 'a' <$ Nothing + -- Nothing + (<$) :: a -> f b -> f a + (<$) = fmap . const + +-- | A functor with application, providing operations to +-- +-- * embed pure expressions ('pure'), and +-- +-- * sequence computations and combine their results ('<*>' and 'liftA2'). +-- +-- A minimal complete definition must include implementations of 'pure' +-- and of either '<*>' or 'liftA2'. If it defines both, then they must behave +-- the same as their default definitions: +-- +-- @('<*>') = 'liftA2' 'id'@ +-- +-- @'liftA2' f x y = f 'Prelude.<$>' x '<*>' y@ +-- +-- Further, any definition must satisfy the following: +-- +-- [Identity] +-- +-- @'pure' 'id' '<*>' v = v@ +-- +-- [Composition] +-- +-- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ +-- +-- [Homomorphism] +-- +-- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ +-- +-- [Interchange] +-- +-- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ +-- +-- +-- The other methods have the following default definitions, which may +-- be overridden with equivalent specialized implementations: +-- +-- * @u '*>' v = ('id' '<$' u) '<*>' v@ +-- +-- * @u '<*' v = 'liftA2' 'const' u v@ +-- +-- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy +-- +-- * @'fmap' f x = 'pure' f '<*>' x@ +-- +-- +-- It may be useful to note that supposing +-- +-- @forall x y. p (q x y) = f x . g y@ +-- +-- it follows from the above that +-- +-- @'liftA2' p ('liftA2' q u v) = 'liftA2' f u . 'liftA2' g v@ +-- +-- +-- If @f@ is also a 'Monad', it should satisfy +-- +-- * @'pure' = 'return'@ +-- +-- * @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ +-- +-- * @('*>') = ('>>')@ +-- +-- (which implies that 'pure' and '<*>' satisfy the applicative functor laws). + +class Functor f => Applicative f where + {-# MINIMAL pure, ((<*>) | liftA2) #-} + -- | Lift a value. + pure :: a -> f a + + -- | Sequential application. + -- + -- A few functors support an implementation of '<*>' that is more + -- efficient than the default one. + -- + -- ==== __Example__ + -- Used in combination with @('<$>')@, @('<*>')@ can be used to build a record. + -- + -- >>> data MyState = MyState {arg1 :: Foo, arg2 :: Bar, arg3 :: Baz} + -- + -- >>> produceFoo :: Applicative f => f Foo + -- + -- >>> produceBar :: Applicative f => f Bar + -- >>> produceBaz :: Applicative f => f Baz + -- + -- >>> mkState :: Applicative f => f MyState + -- >>> mkState = MyState <$> produceFoo <*> produceBar <*> produceBaz + (<*>) :: f (a -> b) -> f a -> f b + (<*>) = liftA2 id + + -- | Lift a binary function to actions. + -- + -- Some functors support an implementation of 'liftA2' that is more + -- efficient than the default one. In particular, if 'fmap' is an + -- expensive operation, it is likely better to use 'liftA2' than to + -- 'fmap' over the structure and then use '<*>'. + -- + -- This became a typeclass method in 4.10.0.0. Prior to that, it was + -- a function defined in terms of '<*>' and 'fmap'. + -- + -- ==== __Example__ + -- >>> liftA2 (,) (Just 3) (Just 5) + -- Just (3,5) + + liftA2 :: (a -> b -> c) -> f a -> f b -> f c + liftA2 f x = (<*>) (fmap f x) + + -- | Sequence actions, discarding the value of the first argument. + -- + -- ==== __Examples__ + -- If used in conjunction with the Applicative instance for 'Maybe', + -- you can chain Maybe computations, with a possible "early return" + -- in case of 'Nothing'. + -- + -- >>> Just 2 *> Just 3 + -- Just 3 + -- + -- >>> Nothing *> Just 3 + -- Nothing + -- + -- Of course a more interesting use case would be to have effectful + -- computations instead of just returning pure values. + -- + -- >>> import Data.Char + -- >>> import Text.ParserCombinators.ReadP + -- >>> let p = string "my name is " *> munch1 isAlpha <* eof + -- >>> readP_to_S p "my name is Simon" + -- [("Simon","")] + + (*>) :: f a -> f b -> f b + a1 *> a2 = (id <$ a1) <*> a2 + + -- This is essentially the same as liftA2 (flip const), but if the + -- Functor instance has an optimized (<$), it may be better to use + -- that instead. Before liftA2 became a method, this definition + -- was strictly better, but now it depends on the functor. For a + -- functor supporting a sharing-enhancing (<$), this definition + -- may reduce allocation by preventing a1 from ever being fully + -- realized. In an implementation with a boring (<$) but an optimizing + -- liftA2, it would likely be better to define (*>) using liftA2. + + -- | Sequence actions, discarding the value of the second argument. + -- + (<*) :: f a -> f b -> f a + (<*) = liftA2 const + +{- | The 'Monad' class defines the basic operations over a /monad/, +a concept from a branch of mathematics known as /category theory/. +From the perspective of a Haskell programmer, however, it is best to +think of a monad as an /abstract datatype/ of actions. +Haskell's @do@ expressions provide a convenient syntax for writing +monadic expressions. + +Instances of 'Monad' should satisfy the following: + +[Left identity] @'return' a '>>=' k = k a@ +[Right identity] @m '>>=' 'return' = m@ +[Associativity] @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ + +Furthermore, the 'Monad' and 'Applicative' operations should relate as follows: + +* @'pure' = 'return'@ +* @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ + +The above laws imply: + +* @'fmap' f xs = xs '>>=' 'return' . f@ +* @('>>') = ('*>')@ + +and that 'pure' and ('<*>') satisfy the applicative functor laws. + +The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' +defined in the "Prelude" satisfy these laws. +-} +class Applicative m => Monad m where + -- | Sequentially compose two actions, passing any value produced + -- by the first as an argument to the second. + -- + -- \'@as '>>=' bs@\' can be understood as the @do@ expression + -- + -- @ + -- do a <- as + -- bs a + -- @ + (>>=) :: forall a b. m a -> (a -> m b) -> m b + + -- | Sequentially compose two actions, discarding any value produced + -- by the first, like sequencing operators (such as the semicolon) + -- in imperative languages. + -- + -- \'@as '>>' bs@\' can be understood as the @do@ expression + -- + -- @ + -- do as + -- bs + -- @ + (>>) :: forall a b. m a -> m b -> m b + m >> k = m >>= \_ -> k -- See Note [Recursive bindings for Applicative/Monad] + {-# INLINE (>>) #-} + + -- | Inject a value into the monadic type. + return :: a -> m a + return = pure + +-- | @since 4.15 +instance Applicative Solo where + pure = MkSolo + + -- Note: we really want to match strictly here. This lets us write, + -- for example, + -- + -- forceSpine :: Foldable f => f a -> () + -- forceSpine xs + -- | MkSolo r <- traverse_ MkSolo xs + -- = r + MkSolo f <*> MkSolo x = MkSolo (f x) + liftA2 f (MkSolo x) (MkSolo y) = MkSolo (f x y) + +-- | For tuples, the 'Monoid' constraint on @a@ determines +-- how the first values merge. +-- For example, 'String's concatenate: +-- +-- > ("hello ", (+15)) <*> ("world!", 2002) +-- > ("hello world!",2017) +-- +-- @since 2.01 +instance Monoid a => Applicative ((,) a) where + pure x = (mempty, x) + (u, f) <*> (v, x) = (u <> v, f x) + liftA2 f (u, x) (v, y) = (u <> v, f x y) + +-- | @since 4.15 +instance Monad Solo where + MkSolo x >>= f = f x + +-- | @since 4.9.0.0 +instance Monoid a => Monad ((,) a) where + (u, a) >>= k = case k a of (v, b) -> (u <> v, b) + +-- | @since 4.14.0.0 +instance Functor ((,,) a b) where + fmap f (a, b, c) = (a, b, f c) + +-- | @since 4.14.0.0 +instance (Monoid a, Monoid b) => Applicative ((,,) a b) where + pure x = (mempty, mempty, x) + (a, b, f) <*> (a', b', x) = (a <> a', b <> b', f x) + +-- | @since 4.14.0.0 +instance (Monoid a, Monoid b) => Monad ((,,) a b) where + (u, v, a) >>= k = case k a of (u', v', b) -> (u <> u', v <> v', b) + +-- | @since 4.14.0.0 +instance Functor ((,,,) a b c) where + fmap f (a, b, c, d) = (a, b, c, f d) + +-- | @since 4.14.0.0 +instance (Monoid a, Monoid b, Monoid c) => Applicative ((,,,) a b c) where + pure x = (mempty, mempty, mempty, x) + (a, b, c, f) <*> (a', b', c', x) = (a <> a', b <> b', c <> c', f x) + +-- | @since 4.14.0.0 +instance (Monoid a, Monoid b, Monoid c) => Monad ((,,,) a b c) where + (u, v, w, a) >>= k = case k a of (u', v', w', b) -> (u <> u', v <> v', w <> w', b) + +-- | @since 4.18.0.0 +instance Functor ((,,,,) a b c d) where + fmap f (a, b, c, d, e) = (a, b, c, d, f e) + +-- | @since 4.18.0.0 +instance Functor ((,,,,,) a b c d e) where + fmap fun (a, b, c, d, e, f) = (a, b, c, d, e, fun f) + +-- | @since 4.18.0.0 +instance Functor ((,,,,,,) a b c d e f) where + fmap fun (a, b, c, d, e, f, g) = (a, b, c, d, e, f, fun g) + +-- | A variant of '<*>' with the arguments reversed. +-- +(<**>) :: Applicative f => f a -> f (a -> b) -> f b +(<**>) = liftA2 (\a f -> f a) +-- Don't use $ here, see the note at the top of the page + +-- | Lift a function to actions. +-- Equivalent to Functor's `fmap` but implemented using only `Applicative`'s methods: +-- @'liftA' f a = 'pure' f '<*>' a@ +-- +-- As such this function may be used to implement a `Functor` instance from an `Applicative` one. +-- +-- ==== __Examples__ +-- Using the Applicative instance for Lists: +-- +-- >>> liftA (+1) [1, 2] +-- [2,3] +-- +-- Or the Applicative instance for 'Maybe' +-- +-- >>> liftA (+1) (Just 3) +-- Just 4 + +liftA :: Applicative f => (a -> b) -> f a -> f b +liftA f a = pure f <*> a +-- Caution: since this may be used for `fmap`, we can't use the obvious +-- definition of liftA = fmap. + +-- | Lift a ternary function to actions. + +liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d +liftA3 f a b c = liftA2 f a b <*> c + + +{-# INLINABLE liftA #-} +{-# SPECIALISE liftA :: (a1->r) -> IO a1 -> IO r #-} +{-# SPECIALISE liftA :: (a1->r) -> Maybe a1 -> Maybe r #-} +{-# INLINABLE liftA3 #-} +{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} +{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> + Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} + +-- | The 'join' function is the conventional monad join operator. It +-- is used to remove one level of monadic structure, projecting its +-- bound argument into the outer level. +-- +-- +-- \'@'join' bss@\' can be understood as the @do@ expression +-- +-- @ +-- do bs <- bss +-- bs +-- @ +-- +-- ==== __Examples__ +-- +-- A common use of 'join' is to run an 'IO' computation returned from +-- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions +-- can't perform 'IO' directly. Recall that +-- +-- @ +-- 'GHC.Conc.atomically' :: STM a -> IO a +-- @ +-- +-- is used to run 'GHC.Conc.STM' transactions atomically. So, by +-- specializing the types of 'GHC.Conc.atomically' and 'join' to +-- +-- @ +-- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b) +-- 'join' :: IO (IO b) -> IO b +-- @ +-- +-- we can compose them as +-- +-- @ +-- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b +-- @ +-- +-- to run an 'GHC.Conc.STM' transaction and the 'IO' action it +-- returns. +join :: (Monad m) => m (m a) -> m a +join x = x >>= id + + +{- Note [Recursive bindings for Applicative/Monad] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The original Applicative/Monad proposal stated that after +implementation, the designated implementation of (>>) would become + + (>>) :: forall a b. m a -> m b -> m b + (>>) = (*>) + +by default. You might be inclined to change this to reflect the stated +proposal, but you really shouldn't! Why? Because people tend to define +such instances the /other/ way around: in particular, it is perfectly +legitimate to define an instance of Applicative (*>) in terms of (>>), +which would lead to an infinite loop for the default implementation of +Monad! And people do this in the wild. + +This turned into a nasty bug that was tricky to track down, and rather +than eliminate it everywhere upstream, it's easier to just retain the +original default. + +-} + +-- | Same as '>>=', but with the arguments interchanged. +{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-} +(=<<) :: Monad m => (a -> m b) -> m a -> m b +f =<< x = x >>= f + +-- | Conditional execution of 'Applicative' expressions. For example, +-- +-- > when debug (putStrLn "Debugging") +-- +-- will output the string @Debugging@ if the Boolean value @debug@ +-- is 'True', and otherwise do nothing. +when :: (Applicative f) => Bool -> f () -> f () +{-# INLINABLE when #-} +{-# SPECIALISE when :: Bool -> IO () -> IO () #-} +{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} +when p s = if p then s else pure () + +-- | Evaluate each action in the sequence from left to right, +-- and collect the results. +sequence :: Monad m => [m a] -> m [a] +{-# INLINE sequence #-} +sequence = mapM id +-- Note: [sequence and mapM] + +-- | @'mapM' f@ is equivalent to @'sequence' . 'map' f at . +mapM :: Monad m => (a -> m b) -> [a] -> m [b] +{-# INLINE mapM #-} +mapM f as = foldr k (return []) as + where + k a r = do { x <- f a; xs <- r; return (x:xs) } + +{- +Note: [sequence and mapM] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Originally, we defined + +mapM f = sequence . map f + +This relied on list fusion to produce efficient code for mapM, and led to +excessive allocation in cryptarithm2. Defining + +sequence = mapM id + +relies only on inlining a tiny function (id) and beta reduction, which tends to +be a more reliable aspect of simplification. Indeed, this does not lead to +similar problems in nofib. +-} + +-- | Promote a function to a monad. +liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r +liftM f m1 = do { x1 <- m1; return (f x1) } + +-- | Promote a function to a monad, scanning the monadic arguments from +-- left to right. For example, +-- +-- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] +-- > liftM2 (+) (Just 1) Nothing = Nothing +-- +liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r +liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) } +-- Caution: since this may be used for `liftA2`, we can't use the obvious +-- definition of liftM2 = liftA2. + +-- | Promote a function to a monad, scanning the monadic arguments from +-- left to right (cf. 'liftM2'). +liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r +liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) } + +-- | Promote a function to a monad, scanning the monadic arguments from +-- left to right (cf. 'liftM2'). +liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r +liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) } + +-- | Promote a function to a monad, scanning the monadic arguments from +-- left to right (cf. 'liftM2'). +liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r +liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) } + +{-# INLINABLE liftM #-} +{-# SPECIALISE liftM :: (a1->r) -> IO a1 -> IO r #-} +{-# SPECIALISE liftM :: (a1->r) -> Maybe a1 -> Maybe r #-} +{-# INLINABLE liftM2 #-} +{-# SPECIALISE liftM2 :: (a1->a2->r) -> IO a1 -> IO a2 -> IO r #-} +{-# SPECIALISE liftM2 :: (a1->a2->r) -> Maybe a1 -> Maybe a2 -> Maybe r #-} +{-# INLINABLE liftM3 #-} +{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} +{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} +{-# INLINABLE liftM4 #-} +{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO r #-} +{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe r #-} +{-# INLINABLE liftM5 #-} +{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO a5 -> IO r #-} +{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe a5 -> Maybe r #-} + +{- | In many situations, the 'liftM' operations can be replaced by uses of +'ap', which promotes function application. + +> return f `ap` x1 `ap` ... `ap` xn + +is equivalent to + +> liftMn f x1 x2 ... xn + +-} + +ap :: (Monad m) => m (a -> b) -> m a -> m b +ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } +-- Since many Applicative instances define (<*>) = ap, we +-- cannot define ap = (<*>) +{-# INLINABLE ap #-} +{-# SPECIALISE ap :: IO (a -> b) -> IO a -> IO b #-} +{-# SPECIALISE ap :: Maybe (a -> b) -> Maybe a -> Maybe b #-} + +-- instances for Prelude types + +-- | @since 2.01 +instance Functor ((->) r) where + fmap = (.) + +-- | @since 2.01 +instance Applicative ((->) r) where + pure = const + (<*>) f g x = f x (g x) + liftA2 q f g x = q (f x) (g x) + +-- | @since 2.01 +instance Monad ((->) r) where + f >>= k = \ r -> k (f r) r + +-- | @since 4.15 +instance Functor Solo where + fmap f (MkSolo a) = MkSolo (f a) + + -- Being strict in the `Solo` argument here seems most consistent + -- with the concept behind `Solo`: always strict in the wrapper and lazy + -- in the contents. + x <$ MkSolo _ = MkSolo x + +-- | @since 2.01 +instance Functor ((,) a) where + fmap f (x,y) = (x, f y) + +-- | @since 2.01 +instance Functor Maybe where + fmap _ Nothing = Nothing + fmap f (Just a) = Just (f a) + +-- | @since 2.01 +instance Applicative Maybe where + pure = Just + + Just f <*> m = fmap f m + Nothing <*> _m = Nothing + + liftA2 f (Just x) (Just y) = Just (f x y) + liftA2 _ _ _ = Nothing + + Just _m1 *> m2 = m2 + Nothing *> _m2 = Nothing + +-- | @since 2.01 +instance Monad Maybe where + (Just x) >>= k = k x + Nothing >>= _ = Nothing + + (>>) = (*>) + +-- | @since 2.01 +instance Functor [] where + {-# INLINE fmap #-} + fmap = map + +-- See Note: [List comprehensions and inlining] +-- | @since 2.01 +instance Applicative [] where + {-# INLINE pure #-} + pure x = [x] + {-# INLINE (<*>) #-} + fs <*> xs = [f x | f <- fs, x <- xs] + {-# INLINE liftA2 #-} + liftA2 f xs ys = [f x y | x <- xs, y <- ys] + {-# INLINE (*>) #-} + xs *> ys = [y | _ <- xs, y <- ys] + +-- See Note: [List comprehensions and inlining] +-- | @since 2.01 +instance Monad [] where + {-# INLINE (>>=) #-} + xs >>= f = [y | x <- xs, y <- f x] + {-# INLINE (>>) #-} + (>>) = (*>) + +-- | Combines lists by concatenation, starting from the empty list. +-- +-- @since 2.01 +instance Alternative [] where + empty = [] + (<|>) = (++) +-- | @since 4.9.0.0 +instance Functor NonEmpty where + fmap f ~(a :| as) = f a :| fmap f as + b <$ ~(_ :| as) = b :| (b <$ as) + +-- | @since 4.9.0.0 +instance Applicative NonEmpty where + pure a = a :| [] + (<*>) = ap + liftA2 = liftM2 + +-- | @since 4.9.0.0 +instance Monad NonEmpty where + ~(a :| as) >>= f = b :| (bs ++ bs') + where b :| bs = f a + bs' = as >>= toList . f + toList ~(c :| cs) = c : cs + +-- | A monoid on applicative functors. +-- +-- If defined, 'some' and 'many' should be the least solutions +-- of the equations: +-- +-- * @'some' v = (:) 'Prelude.<$>' v '<*>' 'many' v@ +-- +-- * @'many' v = 'some' v '<|>' 'pure' []@ +class Applicative f => Alternative f where + -- | The identity of '<|>' + empty :: f a + -- | An associative binary operation + (<|>) :: f a -> f a -> f a + + -- | One or more. + some :: f a -> f [a] + some v = some_v + where + many_v = some_v <|> pure [] + some_v = liftA2 (:) v many_v + + -- | Zero or more. + many :: f a -> f [a] + many v = many_v + where + many_v = some_v <|> pure [] + some_v = liftA2 (:) v many_v + + +-- | Picks the leftmost 'Just' value, or, alternatively, 'Nothing'. +-- +-- @since 2.01 +instance Alternative Maybe where + empty = Nothing + Nothing <|> r = r + l <|> _ = l + +-- ----------------------------------------------------------------------------- +-- The MonadPlus class definition + +-- | Monads that also support choice and failure. +class (Alternative m, Monad m) => MonadPlus m where + -- | The identity of 'mplus'. It should also satisfy the equations + -- + -- > mzero >>= f = mzero + -- > v >> mzero = mzero + -- + -- The default definition is + -- + -- @ + -- mzero = 'empty' + -- @ + mzero :: m a + mzero = empty + + -- | An associative operation. The default definition is + -- + -- @ + -- mplus = ('<|>') + -- @ + mplus :: m a -> m a -> m a + mplus = (<|>) + +-- | Picks the leftmost 'Just' value, or, alternatively, 'Nothing'. +-- +-- @since 2.01 +instance MonadPlus Maybe + +-- | Combines lists by concatenation, starting from the empty list. +-- +-- @since 2.01 +instance MonadPlus [] + +---------------------------------------------- +-- Functor/Applicative/Monad instances for IO +---------------------------------------------- + +-- | @since 2.01 +instance Functor IO where + fmap f x = x >>= (pure . f) + +-- | @since 2.01 +instance Applicative IO where + {-# INLINE pure #-} + {-# INLINE (*>) #-} + {-# INLINE liftA2 #-} + pure = returnIO + (*>) = thenIO + (<*>) = ap + liftA2 = liftM2 + +-- | @since 2.01 +instance Monad IO where + {-# INLINE (>>) #-} + {-# INLINE (>>=) #-} + (>>) = (*>) + (>>=) = bindIO + +-- | Takes the first non-throwing 'IO' action\'s result. +-- 'empty' throws an exception. +-- +-- @since 4.9.0.0 +instance Alternative IO where + empty = failIO "mzero" + (<|>) = mplusIO + +-- | Takes the first non-throwing 'IO' action\'s result. +-- 'mzero' throws an exception. +-- +-- @since 4.9.0.0 +instance MonadPlus IO + +returnIO :: a -> IO a +returnIO x = IO (\ s -> (# s, x #)) + +bindIO :: IO a -> (a -> IO b) -> IO b +bindIO (IO m) k = IO (\ s -> case m s of (# new_s, a #) -> unIO (k a) new_s) + +thenIO :: IO a -> IO b -> IO b +thenIO (IO m) k = IO (\ s -> case m s of (# new_s, _ #) -> unIO k new_s) + +-- Note that it is import that we do not SOURCE import this as +-- its demand signature encodes knowledge of its bottoming +-- behavior, which can expose useful simplifications. See +-- #16588. +failIO :: String -> IO a +failIO s = IO (raiseIO# (mkUserError s)) + +unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #)) +unIO (IO a) = a + ===================================== libraries/base/GHC/Base/List.hs ===================================== @@ -0,0 +1,233 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE MagicHash #-} + +-- -Wno-orphans is needed for things like: +-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_HADDOCK not-home #-} + +module GHC.Base.List + ( foldr + , build + , augment + , map + , mapFB + , (++) + ) where + +import GHC.CString +import GHC.Base.FunOps ((.)) +import GHC.Prim (coerce) + +infixr 5 ++ + +-- | 'foldr', applied to a binary operator, a starting value (typically +-- the right-identity of the operator), and a list, reduces the list +-- using the binary operator, from right to left: +-- +-- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) + +foldr :: (a -> b -> b) -> b -> [a] -> b +-- foldr _ z [] = z +-- foldr f z (x:xs) = f x (foldr f z xs) +{-# INLINE [0] foldr #-} +-- Inline only in the final stage, after the foldr/cons rule has had a chance +-- Also note that we inline it when it has *two* parameters, which are the +-- ones we are keen about specialising! +foldr k z = go + where + go [] = z + go (y:ys) = y `k` go ys + +-- | A list producer that can be fused with 'foldr'. +-- This function is merely +-- +-- > build g = g (:) [] +-- +-- but GHC's simplifier will transform an expression of the form +-- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@, +-- which avoids producing an intermediate list. + +build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] +{-# INLINE [1] build #-} + -- The INLINE is important, even though build is tiny, + -- because it prevents [] getting inlined in the version that + -- appears in the interface file. If [] *is* inlined, it + -- won't match with [] appearing in rules in an importing module. + -- + -- The "1" says to inline in phase 1 + +build g = g (:) [] + +-- | A list producer that can be fused with 'foldr'. +-- This function is merely +-- +-- > augment g xs = g (:) xs +-- +-- but GHC's simplifier will transform an expression of the form +-- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to +-- @g k ('foldr' k z xs)@, which avoids producing an intermediate list. + +augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a] +{-# INLINE [1] augment #-} +augment g xs = g (:) xs + +{-# RULES +"fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) . + foldr k z (build g) = g k z + +"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . + foldr k z (augment g xs) = g k (foldr k z xs) + +"foldr/id" foldr (:) [] = \x -> x +"foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys + -- Only activate this from phase 1, because that's + -- when we disable the rule that expands (++) into foldr + +-- The foldr/cons rule looks nice, but it can give disastrously +-- bloated code when compiling +-- array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] +-- i.e. when there are very very long literal lists +-- So I've disabled it for now. We could have special cases +-- for short lists, I suppose. +-- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs) + +"foldr/single" forall k z x. foldr k z [x] = k x z +"foldr/nil" forall k z. foldr k z [] = z + +"foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) . + foldr k z (x:build g) = k x (g k z) + +"augment/build" forall (g::forall b. (a->b->b) -> b -> b) + (h::forall b. (a->b->b) -> b -> b) . + augment g (build h) = build (\c n -> g c (h c n)) +"augment/nil" forall (g::forall b. (a->b->b) -> b -> b) . + augment g [] = build g + #-} + +-- This rule is true, but not (I think) useful: +-- augment g (augment h t) = augment (\cn -> g c (h c n)) t + +---------------------------------------------- +-- map +---------------------------------------------- + +-- | \(\mathcal{O}(n)\). 'map' @f xs@ is the list obtained by applying @f@ to +-- each element of @xs@, i.e., +-- +-- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn] +-- > map f [x1, x2, ...] == [f x1, f x2, ...] +-- +-- >>> map (+1) [1, 2, 3] +-- [2,3,4] +map :: (a -> b) -> [a] -> [b] +{-# NOINLINE [0] map #-} + -- We want the RULEs "map" and "map/coerce" to fire first. + -- map is recursive, so won't inline anyway, + -- but saying so is more explicit, and silences warnings +map _ [] = [] +map f (x:xs) = f x : map f xs + +-- Note eta expanded +mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst +{-# INLINE [0] mapFB #-} -- See Note [Inline FB functions] in GHC.List +mapFB c f = \x ys -> c (f x) ys + +{- Note [The rules for map] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The rules for map work like this. + +* Up to (but not including) phase 1, we use the "map" rule to + rewrite all saturated applications of map with its build/fold + form, hoping for fusion to happen. + + In phase 1 and 0, we switch off that rule, inline build, and + switch on the "mapList" rule, which rewrites the foldr/mapFB + thing back into plain map. + + It's important that these two rules aren't both active at once + (along with build's unfolding) else we'd get an infinite loop + in the rules. Hence the activation control below. + +* This same pattern is followed by many other functions: + e.g. append, filter, iterate, repeat, etc. in GHC.List + + See also Note [Inline FB functions] in GHC.List + +* The "mapFB" rule optimises compositions of map + +* The "mapFB/id" rule gets rid of 'map id' calls. + You might think that (mapFB c id) will turn into c simply + when mapFB is inlined; but before that happens the "mapList" + rule turns + (foldr (mapFB (:) id) [] a + back into + map id + Which is not very clever. + +* Any similarity to the Functor laws for [] is expected. +-} + +{-# RULES +"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) +"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f +"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g) +"mapFB/id" forall c. mapFB c (\x -> x) = c + #-} + +-- See Breitner, Eisenberg, Peyton Jones, and Weirich, "Safe Zero-cost +-- Coercions for Haskell", section 6.5: +-- http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf + +{-# RULES "map/coerce" [1] map coerce = coerce #-} +-- See Note [Getting the map/coerce RULE to work] in GHC.Core.SimpleOpt + +---------------------------------------------- +-- append +---------------------------------------------- + +-- | Append two lists, i.e., +-- +-- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] +-- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] +-- +-- If the first list is not finite, the result is the first list. +-- +-- WARNING: This function takes linear time in the number of elements of the +-- first list. + +(++) :: [a] -> [a] -> [a] +{-# NOINLINE [2] (++) #-} + -- Give time for the RULEs for (++) to fire in InitialPhase + -- It's recursive, so won't inline anyway, + -- but saying so is more explicit +(++) [] ys = ys +(++) (x:xs) ys = x : xs ++ ys + +{-# RULES +"++/literal" forall x. (++) (unpackCString# x) = unpackAppendCString# x +"++/literal_utf8" forall x. (++) (unpackCStringUtf8# x) = unpackAppendCStringUtf8# x #-} + +{-# RULES +"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys + #-} + +-- Rules for C strings (the functions themselves are now in GHC.CString) +{-# RULES +"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) +"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a +"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n +"unpack-append-nil" forall a . unpackAppendCString# a [] = unpackCString# a + +"unpack-utf8" [~1] forall a . unpackCStringUtf8# a = build (unpackFoldrCStringUtf8# a) +"unpack-list-utf8" [1] forall a . unpackFoldrCStringUtf8# a (:) [] = unpackCStringUtf8# a +"unpack-append-utf8" forall a n . unpackFoldrCStringUtf8# a (:) n = unpackAppendCStringUtf8# a n +"unpack-append-nil-utf8" forall a . unpackAppendCStringUtf8# a [] = unpackCStringUtf8# a + +-- There's a built-in rule (in GHC.Core.Op.ConstantFold) for +-- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n + +-- See also the Note [String literals in GHC] in CString.hs + + #-} ===================================== libraries/base/GHC/Base/NonEmpty.hs ===================================== @@ -0,0 +1,32 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_HADDOCK not-home #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Base.NonEmpty +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- The 'NonEmpty' type. +-- +----------------------------------------------------------------------------- + +module GHC.Base.NonEmpty + ( NonEmpty(..) + ) where + +import GHC.Classes + +infixr 5 :| + +-- | Non-empty (and non-strict) list type. +-- +-- @since 4.9.0.0 +data NonEmpty a = a :| [a] + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + ) ===================================== libraries/base/GHC/Base/Semigroup.hs ===================================== @@ -0,0 +1,325 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE EmptyDataDeriving #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE Unsafe #-} + +-- -Wno-orphans is needed for things like: +-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_HADDOCK not-home #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Base.Semigroup +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- 'Monoid' and 'Semigroup' classes. +-- +----------------------------------------------------------------------------- + +module GHC.Base.Semigroup + ( Semigroup(..) + , Monoid(..) + ) where + +import GHC.Types +import GHC.Maybe +import GHC.Base.List (foldr, map, (++)) +import GHC.Base.NonEmpty +import GHC.Tuple (Solo (MkSolo)) -- Note [Depend on GHC.Tuple] +import {-# SOURCE #-} GHC.Real (Integral) +import {-# SOURCE #-} Data.Semigroup.Internal ( stimesDefault + , stimesMaybe + , stimesList + , stimesIdempotentMonoid + ) + +infixr 6 <> + +-- | The class of semigroups (types with an associative binary operation). +-- +-- Instances should satisfy the following: +-- +-- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ +-- +-- You can alternatively define `sconcat` instead of (`<>`), in which case the +-- laws are: +-- +-- [Unit]: @'sconcat' ('pure' x) = x@ +-- [Multiplication]: @'sconcat' ('join' xss) = 'sconcat' ('fmap' 'sconcat' xss)@ +-- +-- @since 4.9.0.0 +class Semigroup a where + -- | An associative operation. + -- + -- >>> [1,2,3] <> [4,5,6] + -- [1,2,3,4,5,6] + (<>) :: a -> a -> a + a <> b = sconcat (a :| [ b ]) + + -- | Reduce a non-empty list with '<>' + -- + -- The default definition should be sufficient, but this can be + -- overridden for efficiency. + -- + -- >>> import Data.List.NonEmpty (NonEmpty (..)) + -- >>> sconcat $ "Hello" :| [" ", "Haskell", "!"] + -- "Hello Haskell!" + sconcat :: NonEmpty a -> a + sconcat (a :| as) = go a as where + go b (c:cs) = b <> go c cs + go b [] = b + + -- | Repeat a value @n@ times. + -- + -- Given that this works on a 'Semigroup' it is allowed to fail if + -- you request 0 or fewer repetitions, and the default definition + -- will do so. + -- + -- By making this a member of the class, idempotent semigroups + -- and monoids can upgrade this to execute in \(\mathcal{O}(1)\) by + -- picking @stimes = 'Data.Semigroup.stimesIdempotent'@ or @stimes = + -- 'stimesIdempotentMonoid'@ respectively. + -- + -- >>> stimes 4 [1] + -- [1,1,1,1] + stimes :: Integral b => b -> a -> a + stimes = stimesDefault + + {-# MINIMAL (<>) | sconcat #-} + +-- | The class of monoids (types with an associative binary operation that +-- has an identity). Instances should satisfy the following: +-- +-- [Right identity] @x '<>' 'mempty' = x@ +-- [Left identity] @'mempty' '<>' x = x@ +-- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law) +-- [Concatenation] @'mconcat' = 'foldr' ('<>') 'mempty'@ +-- +-- You can alternatively define `mconcat` instead of `mempty`, in which case the +-- laws are: +-- +-- [Unit]: @'mconcat' ('pure' x) = x@ +-- [Multiplication]: @'mconcat' ('join' xss) = 'mconcat' ('fmap' 'mconcat' xss)@ +-- [Subclass]: @'mconcat' ('toList' xs) = 'sconcat' xs@ +-- +-- The method names refer to the monoid of lists under concatenation, +-- but there are many other instances. +-- +-- Some types can be viewed as a monoid in more than one way, +-- e.g. both addition and multiplication on numbers. +-- In such cases we often define @newtype at s and make those instances +-- of 'Monoid', e.g. 'Data.Semigroup.Sum' and 'Data.Semigroup.Product'. +-- +-- __NOTE__: 'Semigroup' is a superclass of 'Monoid' since /base-4.11.0.0/. +class Semigroup a => Monoid a where + -- | Identity of 'mappend' + -- + -- >>> "Hello world" <> mempty + -- "Hello world" + mempty :: a + mempty = mconcat [] + {-# INLINE mempty #-} + + -- | An associative operation + -- + -- __NOTE__: This method is redundant and has the default + -- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/. + -- Should it be implemented manually, since 'mappend' is a synonym for + -- ('<>'), it is expected that the two functions are defined the same + -- way. In a future GHC release 'mappend' will be removed from 'Monoid'. + mappend :: a -> a -> a + mappend = (<>) + {-# INLINE mappend #-} + + -- | Fold a list using the monoid. + -- + -- For most types, the default definition for 'mconcat' will be + -- used, but the function is included in the class definition so + -- that an optimized version can be provided for specific types. + -- + -- >>> mconcat ["Hello", " ", "Haskell", "!"] + -- "Hello Haskell!" + mconcat :: [a] -> a + mconcat = foldr mappend mempty + {-# INLINE mconcat #-} + -- INLINE in the hope of fusion with mconcat's argument (see !4890) + + {-# MINIMAL mempty | mconcat #-} + +-- | @since 4.9.0.0 +instance Semigroup [a] where + (<>) = (++) + {-# INLINE (<>) #-} + + stimes = stimesList + +-- | @since 2.01 +instance Monoid [a] where + {-# INLINE mempty #-} + mempty = [] + {-# INLINE mconcat #-} + mconcat xss = [x | xs <- xss, x <- xs] +-- See Note: [List comprehensions and inlining] + + +{- +Note: [List comprehensions and inlining] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The list monad operations are traditionally described in terms of concatMap: + +xs >>= f = concatMap f xs + +Similarly, mconcat for lists is just concat. Here in Base, however, we don't +have concatMap, and we'll refrain from adding it here so it won't have to be +hidden in imports. Instead, we use GHC's list comprehension desugaring +mechanism to define mconcat and the Applicative and Monad instances for lists. +We mark them INLINE because the inliner is not generally too keen to inline +build forms such as the ones these desugar to without our insistence. Defining +these using list comprehensions instead of foldr has an additional potential +benefit, as described in compiler/GHC/HsToCore/ListComp.hs: if optimizations +needed to make foldr/build forms efficient are turned off, we'll get reasonably +efficient translations anyway. +-} + +-- | @since 4.9.0.0 +instance Semigroup (NonEmpty a) where + (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) + +-- | @since 4.9.0.0 +instance Semigroup b => Semigroup (a -> b) where + f <> g = \x -> f x <> g x + stimes n f e = stimes n (f e) + +-- | @since 2.01 +instance Monoid b => Monoid (a -> b) where + mempty _ = mempty + -- If `b` has a specialised mconcat, use that, rather than the default + -- mconcat, which can be much less efficient. Inline in the hope that + -- it may result in list fusion. + mconcat = \fs x -> mconcat (map (\f -> f x) fs) + {-# INLINE mconcat #-} + +-- | @since 4.9.0.0 +instance Semigroup () where + _ <> _ = () + sconcat _ = () + stimes _ _ = () + +-- | @since 2.01 +instance Monoid () where + -- Should it be strict? + mempty = () + mconcat _ = () + +-- | @since 4.15 +instance Semigroup a => Semigroup (Solo a) where + MkSolo a <> MkSolo b = MkSolo (a <> b) + stimes n (MkSolo a) = MkSolo (stimes n a) + +-- | @since 4.15 +instance Monoid a => Monoid (Solo a) where + mempty = MkSolo mempty + +-- | @since 4.9.0.0 +instance (Semigroup a, Semigroup b) => Semigroup (a, b) where + (a,b) <> (a',b') = (a<>a',b<>b') + stimes n (a,b) = (stimes n a, stimes n b) + +-- | @since 2.01 +instance (Monoid a, Monoid b) => Monoid (a,b) where + mempty = (mempty, mempty) + +-- | @since 4.9.0.0 +instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where + (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') + stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c) + +-- | @since 2.01 +instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where + mempty = (mempty, mempty, mempty) + +-- | @since 4.9.0.0 +instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) + => Semigroup (a, b, c, d) where + (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') + stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d) + +-- | @since 2.01 +instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where + mempty = (mempty, mempty, mempty, mempty) + +-- | @since 4.9.0.0 +instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) + => Semigroup (a, b, c, d, e) where + (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') + stimes n (a,b,c,d,e) = + (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e) + +-- | @since 2.01 +instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => + Monoid (a,b,c,d,e) where + mempty = (mempty, mempty, mempty, mempty, mempty) + + +-- | @since 4.9.0.0 +instance Semigroup Ordering where + LT <> _ = LT + EQ <> y = y + GT <> _ = GT + + stimes = stimesIdempotentMonoid + +-- lexicographical ordering +-- | @since 2.01 +instance Monoid Ordering where + mempty = EQ + +-- | @since 4.9.0.0 +instance Semigroup a => Semigroup (Maybe a) where + Nothing <> b = b + a <> Nothing = a + Just a <> Just b = Just (a <> b) + + stimes = stimesMaybe + +-- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to +-- : \"Any semigroup @S@ may be +-- turned into a monoid simply by adjoining an element @e@ not in @S@ +-- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S at .\" +-- +-- /Since 4.11.0/: constraint on inner @a@ value generalised from +-- 'Monoid' to 'Semigroup'. +-- +-- @since 2.01 +instance Semigroup a => Monoid (Maybe a) where + mempty = Nothing + +-- | @since 4.10.0.0 +instance Semigroup a => Semigroup (IO a) where + -- Ideally we would define this as: + -- (<>) = liftA2 (<>) + -- but this would incur an import cycle. + IO f <> IO g = IO (\s0 -> + case f s0 of + (# s1, x #) -> + case g s1 of + (# s2, y #) -> (# s2, x <> y #)) + +-- | @since 4.9.0.0 +instance Monoid a => Monoid (IO a) where + mempty = IO (\s -> (# s, mempty #) ) + ===================================== libraries/base/GHC/Base.hs-boot → libraries/base/GHC/Base/Semigroup.hs-boot ===================================== @@ -1,9 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-} -module GHC.Base (Maybe, Semigroup, Monoid) where +module GHC.Base.Semigroup (Semigroup, Monoid) where -import GHC.Maybe (Maybe) -import GHC.Types () +import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base class Semigroup a class Monoid a + ===================================== libraries/base/GHC/Base/String.hs ===================================== @@ -0,0 +1,42 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} + +-- -Wno-orphans is needed for things like: +-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 +{-# OPTIONS_GHC -Wno-orphans #-} + +module GHC.Base.String + ( String + , unsafeChr + , ord + , eqString + ) where + +import GHC.Types (Char(..), Int(..), Bool(..)) +import GHC.Classes (Eq(..), (&&)) +import GHC.Prim (chr#, ord#) + +-- | A 'String' is a list of characters. String constants in Haskell are values +-- of type 'String'. +-- +-- See "Data.List" for operations on lists. +type String = [Char] + +unsafeChr :: Int -> Char +unsafeChr (I# i#) = C# (chr# i#) + +-- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'. +ord :: Char -> Int +ord (C# c#) = I# (ord# c#) + +-- | This 'String' equality predicate is used when desugaring +-- pattern-matches against strings. +eqString :: String -> String -> Bool +eqString [] [] = True +eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 +eqString _ _ = False + +{-# RULES "eqString" (==) = eqString #-} +-- eqString also has a BuiltInRule in GHC.Core.Opt.ConstantFold: +-- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2 + ===================================== libraries/base/GHC/Base/Void.hs ===================================== @@ -0,0 +1,50 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE EmptyDataDeriving #-} + +module GHC.Base.Void + ( Void + , absurd + , vacuous + ) where + +import GHC.Classes +import GHC.Base.Functor +import GHC.Base.Semigroup + +-- | Uninhabited data type +-- +-- @since 4.8.0.0 +data Void deriving + ( Eq -- ^ @since 4.8.0.0 + , Ord -- ^ @since 4.8.0.0 + ) + +-- | @since 4.9.0.0 +instance Semigroup Void where + a <> _ = a + stimes _ a = a + +-- | Since 'Void' values logically don't exist, this witnesses the +-- logical reasoning tool of \"ex falso quodlibet\". +-- +-- >>> let x :: Either Void Int; x = Right 5 +-- >>> :{ +-- case x of +-- Right r -> r +-- Left l -> absurd l +-- :} +-- 5 +-- +-- @since 4.8.0.0 +absurd :: Void -> a +absurd a = case a of {} + +-- | If 'Void' is uninhabited then any 'Functor' that holds only +-- values of type 'Void' is holding no values. +-- It is implemented in terms of @fmap absurd at . +-- +-- @since 4.8.0.0 +vacuous :: Functor f => f Void -> f a +vacuous = fmap absurd + ===================================== libraries/base/base.cabal ===================================== @@ -192,6 +192,13 @@ Library GHC.Arr GHC.ArrayArray GHC.Base + GHC.Base.FunOps + GHC.Base.Functor + GHC.Base.List + GHC.Base.NonEmpty + GHC.Base.Semigroup + GHC.Base.String + GHC.Base.Void GHC.Bits GHC.ByteOrder GHC.Char ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elem` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acba4af8b8259a9f43655170cda3607aed10bb01...67252ef1ef1c18a5d6b0a2d4e9f910a56c248eef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acba4af8b8259a9f43655170cda3607aed10bb01...67252ef1ef1c18a5d6b0a2d4e9f910a56c248eef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 20:55:02 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 16:55:02 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 71 commits: JS: refactor jsSaturate to return a saturated JStat (#23328) Message-ID: <6467e2263b1f7_9760a3611a24863773@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - a5b2dfde by Ben Gamari at 2023-05-19T14:02:19-04:00 compiler: Make OccSet opaque - - - - - 9b8f248e by Ben Gamari at 2023-05-19T14:05:02-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 921e16a2 by Ben Gamari at 2023-05-19T16:20:45-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 7d867970 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Introduce Data.Enum - - - - - ff1cad5e by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Num.Integer - - - - - a7f28b69 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Num - - - - - f3ebcea3 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Num.Natural - - - - - 24b47ae7 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Introduce Data.Show - - - - - 747ebcb9 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Float - - - - - 5c7718b1 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Real - - - - - 6189abc9 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/IOEnv.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c720b42c7c679c913bdb197d44ef4b5e92ff9e15...6189abc9c62bc6100f89ebb98ed17ef503357a81 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c720b42c7c679c913bdb197d44ef4b5e92ff9e15...6189abc9c62bc6100f89ebb98ed17ef503357a81 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 20:56:50 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 16:56:50 -0400 Subject: [Git][ghc/ghc][wip/split-ghc-base] 9 commits: base: Introduce Data.Enum Message-ID: <6467e29231710_9760a36afc5546380dd@gitlab.mail> Ben Gamari pushed to branch wip/split-ghc-base at Glasgow Haskell Compiler / GHC Commits: 7d867970 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Introduce Data.Enum - - - - - ff1cad5e by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Num.Integer - - - - - a7f28b69 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Num - - - - - f3ebcea3 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Num.Natural - - - - - 24b47ae7 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Introduce Data.Show - - - - - 747ebcb9 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Float - - - - - 5c7718b1 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Add export list to GHC.Real - - - - - 6189abc9 by Ben Gamari at 2023-05-19T16:20:52-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 84a92fad by Ben Gamari at 2023-05-19T16:56:04-04:00 base: Break up GHC.Base - - - - - 21 changed files: - compiler/GHC/Builtin/Names.hs - + libraries/base/Data/Enum.hs - libraries/base/Data/Semigroup/Internal.hs-boot - + libraries/base/Data/Show.hs - libraries/base/GHC/Base.hs - + libraries/base/GHC/Base/FunOps.hs - + libraries/base/GHC/Base/Functor.hs - + libraries/base/GHC/Base/List.hs - + libraries/base/GHC/Base/NonEmpty.hs - + libraries/base/GHC/Base/Semigroup.hs - libraries/base/GHC/Base.hs-boot → libraries/base/GHC/Base/Semigroup.hs-boot - + libraries/base/GHC/Base/String.hs - + libraries/base/GHC/Base/Void.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/tests/interface-stability/base-exports.stdout Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -549,7 +549,10 @@ pRELUDE = mkBaseModule_ pRELUDE_NAME gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_GENERICS, gHC_MAGIC, gHC_MAGIC_DICT, - gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM, + gHC_CLASSES, gHC_PRIMOPWRAPPERS, + gHC_BASE, gHC_BASE_FUNOPS, gHC_BASE_FUNCTOR, gHC_BASE_LIST, gHC_BASE_NONEMPTY, + gHC_BASE_SEMIGROUP, gHC_BASE_STRING, gHC_BASE_VOID, + gHC_ENUM, gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING, gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_NUM_INTEGER, gHC_NUM_NATURAL, gHC_NUM_BIGNAT, @@ -574,7 +577,14 @@ gHC_CSTRING = mkPrimModule (fsLit "GHC.CString") gHC_CLASSES = mkPrimModule (fsLit "GHC.Classes") gHC_PRIMOPWRAPPERS = mkPrimModule (fsLit "GHC.PrimopWrappers") -gHC_BASE = mkBaseModule (fsLit "GHC.Base") +gHC_BASE = mkBaseModule (fsLit "GHC.Base") +gHC_BASE_FUNOPS = mkBaseModule (fsLit "GHC.Base.FunOps") +gHC_BASE_FUNCTOR = mkBaseModule (fsLit "GHC.Base.Functor") +gHC_BASE_LIST = mkBaseModule (fsLit "GHC.Base.List") +gHC_BASE_NONEMPTY = mkBaseModule (fsLit "GHC.Base.NonEmpty") +gHC_BASE_SEMIGROUP = mkBaseModule (fsLit "GHC.Base.Semigroup") +gHC_BASE_STRING = mkBaseModule (fsLit "GHC.Base.String") +gHC_BASE_VOID = mkBaseModule (fsLit "GHC.Base.Void") gHC_ENUM = mkBaseModule (fsLit "GHC.Enum") gHC_GHCI = mkBaseModule (fsLit "GHC.GHCi") gHC_GHCI_HELPERS= mkBaseModule (fsLit "GHC.GHCi.Helpers") @@ -786,7 +796,7 @@ fromListN_RDR = nameRdrName fromListNName toList_RDR = nameRdrName toListName compose_RDR :: RdrName -compose_RDR = varQual_RDR gHC_BASE (fsLit ".") +compose_RDR = varQual_RDR gHC_BASE_FUNOPS (fsLit ".") not_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, and_RDR, range_RDR, inRange_RDR, index_RDR, @@ -915,10 +925,10 @@ fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR, foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR, mappend_RDR :: RdrName fmap_RDR = nameRdrName fmapName -replace_RDR = varQual_RDR gHC_BASE (fsLit "<$") +replace_RDR = varQual_RDR gHC_BASE_FUNCTOR (fsLit "<$") pure_RDR = nameRdrName pureAName ap_RDR = nameRdrName apAName -liftA2_RDR = varQual_RDR gHC_BASE (fsLit "liftA2") +liftA2_RDR = varQual_RDR gHC_BASE_FUNCTOR (fsLit "liftA2") foldable_foldr_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldr") foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") null_RDR = varQual_RDR dATA_FOLDABLE (fsLit "null") @@ -972,7 +982,7 @@ leftDataConName = dcQual dATA_EITHER (fsLit "Left") leftDataConKey rightDataConName = dcQual dATA_EITHER (fsLit "Right") rightDataConKey voidTyConName :: Name -voidTyConName = tcQual gHC_BASE (fsLit "Void") voidTyConKey +voidTyConName = tcQual gHC_BASE_VOID (fsLit "Void") voidTyConKey -- Generics (types) v1TyConName, u1TyConName, par1TyConName, rec1TyConName, @@ -1054,7 +1064,7 @@ unpackCStringName, unpackCStringFoldrName, unpackCStringAppendName, unpackCStringAppendUtf8Name, eqStringName, cstringLengthName :: Name cstringLengthName = varQual gHC_CSTRING (fsLit "cstringLength#") cstringLengthIdKey -eqStringName = varQual gHC_BASE (fsLit "eqString") eqStringIdKey +eqStringName = varQual gHC_BASE_STRING (fsLit "eqString") eqStringIdKey unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey unpackCStringAppendName = varQual gHC_CSTRING (fsLit "unpackAppendCString#") unpackCStringAppendIdKey @@ -1075,15 +1085,15 @@ eqClassName = clsQual gHC_CLASSES (fsLit "Eq") eqClassKey eqName = varQual gHC_CLASSES (fsLit "==") eqClassOpKey ordClassName = clsQual gHC_CLASSES (fsLit "Ord") ordClassKey geName = varQual gHC_CLASSES (fsLit ">=") geClassOpKey -functorClassName = clsQual gHC_BASE (fsLit "Functor") functorClassKey -fmapName = varQual gHC_BASE (fsLit "fmap") fmapClassOpKey +functorClassName = clsQual gHC_BASE_FUNCTOR (fsLit "Functor") functorClassKey +fmapName = varQual gHC_BASE_FUNCTOR (fsLit "fmap") fmapClassOpKey -- Class Monad monadClassName, thenMName, bindMName, returnMName :: Name -monadClassName = clsQual gHC_BASE (fsLit "Monad") monadClassKey -thenMName = varQual gHC_BASE (fsLit ">>") thenMClassOpKey -bindMName = varQual gHC_BASE (fsLit ">>=") bindMClassOpKey -returnMName = varQual gHC_BASE (fsLit "return") returnMClassOpKey +monadClassName = clsQual gHC_BASE_FUNCTOR (fsLit "Monad") monadClassKey +thenMName = varQual gHC_BASE_FUNCTOR (fsLit ">>") thenMClassOpKey +bindMName = varQual gHC_BASE_FUNCTOR (fsLit ">>=") bindMClassOpKey +returnMName = varQual gHC_BASE_FUNCTOR (fsLit "return") returnMClassOpKey -- Class MonadFail monadFailClassName, failMName :: Name @@ -1092,10 +1102,10 @@ failMName = varQual mONAD_FAIL (fsLit "fail") failMClassOpKey -- Class Applicative applicativeClassName, pureAName, apAName, thenAName :: Name -applicativeClassName = clsQual gHC_BASE (fsLit "Applicative") applicativeClassKey -apAName = varQual gHC_BASE (fsLit "<*>") apAClassOpKey -pureAName = varQual gHC_BASE (fsLit "pure") pureAClassOpKey -thenAName = varQual gHC_BASE (fsLit "*>") thenAClassOpKey +applicativeClassName = clsQual gHC_BASE_FUNCTOR (fsLit "Applicative") applicativeClassKey +apAName = varQual gHC_BASE_FUNCTOR (fsLit "<*>") apAClassOpKey +pureAName = varQual gHC_BASE_FUNCTOR (fsLit "pure") pureAClassOpKey +thenAName = varQual gHC_BASE_FUNCTOR (fsLit "*>") thenAClassOpKey -- Classes (Foldable, Traversable) foldableClassName, traversableClassName :: Name @@ -1104,20 +1114,20 @@ traversableClassName = clsQual dATA_TRAVERSABLE (fsLit "Traversable") trave -- Classes (Semigroup, Monoid) semigroupClassName, sappendName :: Name -semigroupClassName = clsQual gHC_BASE (fsLit "Semigroup") semigroupClassKey -sappendName = varQual gHC_BASE (fsLit "<>") sappendClassOpKey +semigroupClassName = clsQual gHC_BASE_SEMIGROUP (fsLit "Semigroup") semigroupClassKey +sappendName = varQual gHC_BASE_SEMIGROUP (fsLit "<>") sappendClassOpKey monoidClassName, memptyName, mappendName, mconcatName :: Name -monoidClassName = clsQual gHC_BASE (fsLit "Monoid") monoidClassKey -memptyName = varQual gHC_BASE (fsLit "mempty") memptyClassOpKey -mappendName = varQual gHC_BASE (fsLit "mappend") mappendClassOpKey -mconcatName = varQual gHC_BASE (fsLit "mconcat") mconcatClassOpKey +monoidClassName = clsQual gHC_BASE_SEMIGROUP (fsLit "Monoid") monoidClassKey +memptyName = varQual gHC_BASE_SEMIGROUP (fsLit "mempty") memptyClassOpKey +mappendName = varQual gHC_BASE_SEMIGROUP (fsLit "mappend") mappendClassOpKey +mconcatName = varQual gHC_BASE_SEMIGROUP (fsLit "mconcat") mconcatClassOpKey -- AMP additions joinMName, alternativeClassName :: Name -joinMName = varQual gHC_BASE (fsLit "join") joinMIdKey +joinMName = varQual gHC_BASE_FUNCTOR (fsLit "join") joinMIdKey alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey -- @@ -1138,13 +1148,13 @@ considerAccessibleName = varQual gHC_EXTS (fsLit "considerAccessible") considerA fromStringName, otherwiseIdName, foldrName, buildName, augmentName, mapName, appendName, assertName, dollarName :: Name -dollarName = varQual gHC_BASE (fsLit "$") dollarIdKey +dollarName = varQual gHC_BASE_FUNOPS (fsLit "$") dollarIdKey otherwiseIdName = varQual gHC_BASE (fsLit "otherwise") otherwiseIdKey -foldrName = varQual gHC_BASE (fsLit "foldr") foldrIdKey -buildName = varQual gHC_BASE (fsLit "build") buildIdKey -augmentName = varQual gHC_BASE (fsLit "augment") augmentIdKey -mapName = varQual gHC_BASE (fsLit "map") mapIdKey -appendName = varQual gHC_BASE (fsLit "++") appendIdKey +foldrName = varQual gHC_BASE_LIST (fsLit "foldr") foldrIdKey +buildName = varQual gHC_BASE_LIST (fsLit "build") buildIdKey +augmentName = varQual gHC_BASE_LIST (fsLit "augment") augmentIdKey +mapName = varQual gHC_BASE_LIST (fsLit "map") mapIdKey +appendName = varQual gHC_BASE_LIST (fsLit "++") appendIdKey assertName = varQual gHC_BASE (fsLit "assert") assertIdKey fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey @@ -1431,7 +1441,7 @@ withDictClassName :: Name withDictClassName = clsQual gHC_MAGIC_DICT (fsLit "WithDict") withDictClassKey nonEmptyTyConName :: Name -nonEmptyTyConName = tcQual gHC_BASE (fsLit "NonEmpty") nonEmptyTyConKey +nonEmptyTyConName = tcQual gHC_BASE_NONEMPTY (fsLit "NonEmpty") nonEmptyTyConKey -- Custom type errors errorMessageTypeErrorFamName @@ -1546,10 +1556,10 @@ ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName, failIOName :: Name ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey ioDataConName = dcQual gHC_TYPES (fsLit "IO") ioDataConKey -thenIOName = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey -bindIOName = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey -returnIOName = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey -failIOName = varQual gHC_IO (fsLit "failIO") failIOIdKey +thenIOName = varQual gHC_BASE_FUNCTOR (fsLit "thenIO") thenIOIdKey +bindIOName = varQual gHC_BASE_FUNCTOR (fsLit "bindIO") bindIOIdKey +returnIOName = varQual gHC_BASE_FUNCTOR (fsLit "returnIO") returnIOIdKey +failIOName = varQual gHC_BASE_FUNCTOR (fsLit "failIO") failIOIdKey -- IO things printName :: Name ===================================== libraries/base/Data/Enum.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum ===================================== libraries/base/Data/Semigroup/Internal.hs-boot ===================================== @@ -3,7 +3,8 @@ module Data.Semigroup.Internal where import {-# SOURCE #-} GHC.Real (Integral) -import {-# SOURCE #-} GHC.Base (Semigroup,Monoid,Maybe) +import {-# SOURCE #-} GHC.Base.Semigroup (Semigroup,Monoid) +import GHC.Maybe (Maybe) import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a ===================================== libraries/base/Data/Show.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Show +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Show' class. +-- +----------------------------------------------------------------------------- + +module Data.Show + ( Show(..) + -- * 'ShowS' + , ShowS + , shows + , showChar, showString, showMultiLineString + , showParen, showCommaSpace, showSpace + , showLitChar, showLitString + ) where + +import GHC.Show + ===================================== libraries/base/GHC/Base.hs ===================================== @@ -75,9 +75,6 @@ Other Prelude modules are much easier with fewer complex dependencies. {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} --- -Wno-orphans is needed for things like: --- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 -{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- @@ -97,20 +94,24 @@ Other Prelude modules are much easier with fewer complex dependencies. #include "MachDeps.h" module GHC.Base - ( - module GHC.Base, - module GHC.Classes, - module GHC.CString, - module GHC.Magic, - module GHC.Magic.Dict, - module GHC.Types, - module GHC.Prim, -- Re-export GHC.Prim, GHC.Prim.Ext, - module GHC.Prim.Ext, -- GHC.Prim.PtrEq and [boot] GHC.Err - module GHC.Prim.PtrEq, -- to avoid lots of people having to - module GHC.Err, -- import these modules explicitly - module GHC.Maybe - ) - where + ( module GHC.Base + , module GHC.Base.FunOps + , module GHC.Base.Functor + , module GHC.Base.List + , module GHC.Base.NonEmpty + , module GHC.Base.Semigroup + , module GHC.Base.String + , module GHC.Base.Void + , module GHC.Classes + , module GHC.CString + , module GHC.Magic + , module GHC.Magic.Dict , module GHC.Types + , module GHC.Prim -- Re-export GHC.Prim, GHC.Prim.Ext, + , module GHC.Prim.Ext -- GHC.Prim.PtrEq and [boot] GHC.Err + , module GHC.Prim.PtrEq -- to avoid lots of people having to + , module GHC.Err -- import these modules explicitly + , module GHC.Maybe + ) where import GHC.Types import GHC.Classes @@ -122,31 +123,20 @@ import GHC.Prim.Ext import GHC.Prim.PtrEq import GHC.Err import GHC.Maybe -import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO) -import GHC.Tuple (Solo (MkSolo)) -- Note [Depend on GHC.Tuple] import GHC.Num.Integer () -- Note [Depend on GHC.Num.Integer] --- for 'class Semigroup' -import {-# SOURCE #-} GHC.Real (Integral) -import {-# SOURCE #-} Data.Semigroup.Internal ( stimesDefault - , stimesMaybe - , stimesList - , stimesIdempotentMonoid - ) +import GHC.Base.FunOps +import GHC.Base.Functor +import GHC.Base.List +import GHC.Base.NonEmpty +import GHC.Base.Semigroup +import GHC.Base.String +import GHC.Base.Void -- $setup -- >>> import GHC.Num -infixr 9 . -infixr 5 ++ -infixl 4 <$ -infixl 1 >>, >>= -infixr 1 =<< -infixr 0 $, $! - -infixl 4 <*>, <*, *>, <**> - default () -- Double isn't available yet {- @@ -191,1296 +181,12 @@ data Char = C# Char# type String = [Char] data Int = I# Int# data () = () -data [] a = MkNil not True = False (&&) True True = True otherwise = True - -build = errorWithoutStackTrace "urk" -foldr = errorWithoutStackTrace "urk" #endif --- | Uninhabited data type --- --- @since 4.8.0.0 -data Void deriving - ( Eq -- ^ @since 4.8.0.0 - , Ord -- ^ @since 4.8.0.0 - ) - --- | Since 'Void' values logically don't exist, this witnesses the --- logical reasoning tool of \"ex falso quodlibet\". --- --- >>> let x :: Either Void Int; x = Right 5 --- >>> :{ --- case x of --- Right r -> r --- Left l -> absurd l --- :} --- 5 --- --- @since 4.8.0.0 -absurd :: Void -> a -absurd a = case a of {} - --- | If 'Void' is uninhabited then any 'Functor' that holds only --- values of type 'Void' is holding no values. --- It is implemented in terms of @fmap absurd at . --- --- @since 4.8.0.0 -vacuous :: Functor f => f Void -> f a -vacuous = fmap absurd - -infixr 6 <> - --- | The class of semigroups (types with an associative binary operation). --- --- Instances should satisfy the following: --- --- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ --- --- You can alternatively define `sconcat` instead of (`<>`), in which case the --- laws are: --- --- [Unit]: @'sconcat' ('pure' x) = x@ --- [Multiplication]: @'sconcat' ('join' xss) = 'sconcat' ('fmap' 'sconcat' xss)@ --- --- @since 4.9.0.0 -class Semigroup a where - -- | An associative operation. - -- - -- >>> [1,2,3] <> [4,5,6] - -- [1,2,3,4,5,6] - (<>) :: a -> a -> a - a <> b = sconcat (a :| [ b ]) - - -- | Reduce a non-empty list with '<>' - -- - -- The default definition should be sufficient, but this can be - -- overridden for efficiency. - -- - -- >>> import Data.List.NonEmpty (NonEmpty (..)) - -- >>> sconcat $ "Hello" :| [" ", "Haskell", "!"] - -- "Hello Haskell!" - sconcat :: NonEmpty a -> a - sconcat (a :| as) = go a as where - go b (c:cs) = b <> go c cs - go b [] = b - - -- | Repeat a value @n@ times. - -- - -- Given that this works on a 'Semigroup' it is allowed to fail if - -- you request 0 or fewer repetitions, and the default definition - -- will do so. - -- - -- By making this a member of the class, idempotent semigroups - -- and monoids can upgrade this to execute in \(\mathcal{O}(1)\) by - -- picking @stimes = 'Data.Semigroup.stimesIdempotent'@ or @stimes = - -- 'stimesIdempotentMonoid'@ respectively. - -- - -- >>> stimes 4 [1] - -- [1,1,1,1] - stimes :: Integral b => b -> a -> a - stimes = stimesDefault - - {-# MINIMAL (<>) | sconcat #-} - - --- | The class of monoids (types with an associative binary operation that --- has an identity). Instances should satisfy the following: --- --- [Right identity] @x '<>' 'mempty' = x@ --- [Left identity] @'mempty' '<>' x = x@ --- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law) --- [Concatenation] @'mconcat' = 'foldr' ('<>') 'mempty'@ --- --- You can alternatively define `mconcat` instead of `mempty`, in which case the --- laws are: --- --- [Unit]: @'mconcat' ('pure' x) = x@ --- [Multiplication]: @'mconcat' ('join' xss) = 'mconcat' ('fmap' 'mconcat' xss)@ --- [Subclass]: @'mconcat' ('toList' xs) = 'sconcat' xs@ --- --- The method names refer to the monoid of lists under concatenation, --- but there are many other instances. --- --- Some types can be viewed as a monoid in more than one way, --- e.g. both addition and multiplication on numbers. --- In such cases we often define @newtype at s and make those instances --- of 'Monoid', e.g. 'Data.Semigroup.Sum' and 'Data.Semigroup.Product'. --- --- __NOTE__: 'Semigroup' is a superclass of 'Monoid' since /base-4.11.0.0/. -class Semigroup a => Monoid a where - -- | Identity of 'mappend' - -- - -- >>> "Hello world" <> mempty - -- "Hello world" - mempty :: a - mempty = mconcat [] - {-# INLINE mempty #-} - - -- | An associative operation - -- - -- __NOTE__: This method is redundant and has the default - -- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/. - -- Should it be implemented manually, since 'mappend' is a synonym for - -- ('<>'), it is expected that the two functions are defined the same - -- way. In a future GHC release 'mappend' will be removed from 'Monoid'. - mappend :: a -> a -> a - mappend = (<>) - {-# INLINE mappend #-} - - -- | Fold a list using the monoid. - -- - -- For most types, the default definition for 'mconcat' will be - -- used, but the function is included in the class definition so - -- that an optimized version can be provided for specific types. - -- - -- >>> mconcat ["Hello", " ", "Haskell", "!"] - -- "Hello Haskell!" - mconcat :: [a] -> a - mconcat = foldr mappend mempty - {-# INLINE mconcat #-} - -- INLINE in the hope of fusion with mconcat's argument (see !4890) - - {-# MINIMAL mempty | mconcat #-} - --- | @since 4.9.0.0 -instance Semigroup [a] where - (<>) = (++) - {-# INLINE (<>) #-} - - stimes = stimesList - --- | @since 2.01 -instance Monoid [a] where - {-# INLINE mempty #-} - mempty = [] - {-# INLINE mconcat #-} - mconcat xss = [x | xs <- xss, x <- xs] --- See Note: [List comprehensions and inlining] - --- | @since 4.9.0.0 -instance Semigroup Void where - a <> _ = a - stimes _ a = a - -{- -Note: [List comprehensions and inlining] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The list monad operations are traditionally described in terms of concatMap: - -xs >>= f = concatMap f xs - -Similarly, mconcat for lists is just concat. Here in Base, however, we don't -have concatMap, and we'll refrain from adding it here so it won't have to be -hidden in imports. Instead, we use GHC's list comprehension desugaring -mechanism to define mconcat and the Applicative and Monad instances for lists. -We mark them INLINE because the inliner is not generally too keen to inline -build forms such as the ones these desugar to without our insistence. Defining -these using list comprehensions instead of foldr has an additional potential -benefit, as described in compiler/GHC/HsToCore/ListComp.hs: if optimizations -needed to make foldr/build forms efficient are turned off, we'll get reasonably -efficient translations anyway. --} - --- | @since 4.9.0.0 -instance Semigroup (NonEmpty a) where - (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) - --- | @since 4.9.0.0 -instance Semigroup b => Semigroup (a -> b) where - f <> g = \x -> f x <> g x - stimes n f e = stimes n (f e) - --- | @since 2.01 -instance Monoid b => Monoid (a -> b) where - mempty _ = mempty - -- If `b` has a specialised mconcat, use that, rather than the default - -- mconcat, which can be much less efficient. Inline in the hope that - -- it may result in list fusion. - mconcat = \fs x -> mconcat $ map (\f -> f x) fs - {-# INLINE mconcat #-} - --- | @since 4.9.0.0 -instance Semigroup () where - _ <> _ = () - sconcat _ = () - stimes _ _ = () - --- | @since 2.01 -instance Monoid () where - -- Should it be strict? - mempty = () - mconcat _ = () - --- | @since 4.15 -instance Semigroup a => Semigroup (Solo a) where - MkSolo a <> MkSolo b = MkSolo (a <> b) - stimes n (MkSolo a) = MkSolo (stimes n a) - --- | @since 4.15 -instance Monoid a => Monoid (Solo a) where - mempty = MkSolo mempty - --- | @since 4.9.0.0 -instance (Semigroup a, Semigroup b) => Semigroup (a, b) where - (a,b) <> (a',b') = (a<>a',b<>b') - stimes n (a,b) = (stimes n a, stimes n b) - --- | @since 2.01 -instance (Monoid a, Monoid b) => Monoid (a,b) where - mempty = (mempty, mempty) - --- | @since 4.9.0.0 -instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where - (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') - stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c) - --- | @since 2.01 -instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where - mempty = (mempty, mempty, mempty) - --- | @since 4.9.0.0 -instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) - => Semigroup (a, b, c, d) where - (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') - stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d) - --- | @since 2.01 -instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where - mempty = (mempty, mempty, mempty, mempty) - --- | @since 4.9.0.0 -instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) - => Semigroup (a, b, c, d, e) where - (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') - stimes n (a,b,c,d,e) = - (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e) - --- | @since 2.01 -instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => - Monoid (a,b,c,d,e) where - mempty = (mempty, mempty, mempty, mempty, mempty) - - --- | @since 4.9.0.0 -instance Semigroup Ordering where - LT <> _ = LT - EQ <> y = y - GT <> _ = GT - - stimes = stimesIdempotentMonoid - --- lexicographical ordering --- | @since 2.01 -instance Monoid Ordering where - mempty = EQ - --- | @since 4.9.0.0 -instance Semigroup a => Semigroup (Maybe a) where - Nothing <> b = b - a <> Nothing = a - Just a <> Just b = Just (a <> b) - - stimes = stimesMaybe - --- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to --- : \"Any semigroup @S@ may be --- turned into a monoid simply by adjoining an element @e@ not in @S@ --- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S at .\" --- --- /Since 4.11.0/: constraint on inner @a@ value generalised from --- 'Monoid' to 'Semigroup'. --- --- @since 2.01 -instance Semigroup a => Monoid (Maybe a) where - mempty = Nothing - --- | @since 4.15 -instance Applicative Solo where - pure = MkSolo - - -- Note: we really want to match strictly here. This lets us write, - -- for example, - -- - -- forceSpine :: Foldable f => f a -> () - -- forceSpine xs - -- | MkSolo r <- traverse_ MkSolo xs - -- = r - MkSolo f <*> MkSolo x = MkSolo (f x) - liftA2 f (MkSolo x) (MkSolo y) = MkSolo (f x y) - --- | For tuples, the 'Monoid' constraint on @a@ determines --- how the first values merge. --- For example, 'String's concatenate: --- --- > ("hello ", (+15)) <*> ("world!", 2002) --- > ("hello world!",2017) --- --- @since 2.01 -instance Monoid a => Applicative ((,) a) where - pure x = (mempty, x) - (u, f) <*> (v, x) = (u <> v, f x) - liftA2 f (u, x) (v, y) = (u <> v, f x y) - --- | @since 4.15 -instance Monad Solo where - MkSolo x >>= f = f x - --- | @since 4.9.0.0 -instance Monoid a => Monad ((,) a) where - (u, a) >>= k = case k a of (v, b) -> (u <> v, b) - --- | @since 4.14.0.0 -instance Functor ((,,) a b) where - fmap f (a, b, c) = (a, b, f c) - --- | @since 4.14.0.0 -instance (Monoid a, Monoid b) => Applicative ((,,) a b) where - pure x = (mempty, mempty, x) - (a, b, f) <*> (a', b', x) = (a <> a', b <> b', f x) - --- | @since 4.14.0.0 -instance (Monoid a, Monoid b) => Monad ((,,) a b) where - (u, v, a) >>= k = case k a of (u', v', b) -> (u <> u', v <> v', b) - --- | @since 4.14.0.0 -instance Functor ((,,,) a b c) where - fmap f (a, b, c, d) = (a, b, c, f d) - --- | @since 4.14.0.0 -instance (Monoid a, Monoid b, Monoid c) => Applicative ((,,,) a b c) where - pure x = (mempty, mempty, mempty, x) - (a, b, c, f) <*> (a', b', c', x) = (a <> a', b <> b', c <> c', f x) - --- | @since 4.14.0.0 -instance (Monoid a, Monoid b, Monoid c) => Monad ((,,,) a b c) where - (u, v, w, a) >>= k = case k a of (u', v', w', b) -> (u <> u', v <> v', w <> w', b) - --- | @since 4.18.0.0 -instance Functor ((,,,,) a b c d) where - fmap f (a, b, c, d, e) = (a, b, c, d, f e) - --- | @since 4.18.0.0 -instance Functor ((,,,,,) a b c d e) where - fmap fun (a, b, c, d, e, f) = (a, b, c, d, e, fun f) - --- | @since 4.18.0.0 -instance Functor ((,,,,,,) a b c d e f) where - fmap fun (a, b, c, d, e, f, g) = (a, b, c, d, e, f, fun g) - --- | @since 4.10.0.0 -instance Semigroup a => Semigroup (IO a) where - (<>) = liftA2 (<>) - --- | @since 4.9.0.0 -instance Monoid a => Monoid (IO a) where - mempty = pure mempty - -{- | A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@ -lets you apply any function from @(a -> b)@ to turn an @f a@ into an @f b@, preserving the -structure of @f at . Furthermore @f@ needs to adhere to the following: - -[Identity] @'fmap' 'id' == 'id'@ -[Composition] @'fmap' (f . g) == 'fmap' f . 'fmap' g@ - -Note, that the second law follows from the free theorem of the type 'fmap' and -the first law, so you need only check that the former condition holds. -See or - -for an explanation. --} - -class Functor f where - -- | 'fmap' is used to apply a function of type @(a -> b)@ to a value of type @f a@, - -- where f is a functor, to produce a value of type @f b at . - -- Note that for any type constructor with more than one parameter (e.g., `Either`), - -- only the last type parameter can be modified with `fmap` (e.g., `b` in `Either a b`). - -- - -- Some type constructors with two parameters or more have a @'Data.Bifunctor'@ instance that allows - -- both the last and the penultimate parameters to be mapped over. - -- - -- ==== __Examples__ - -- - -- Convert from a @'Data.Maybe.Maybe' Int@ to a @Maybe String@ - -- using 'Prelude.show': - -- - -- >>> fmap show Nothing - -- Nothing - -- >>> fmap show (Just 3) - -- Just "3" - -- - -- Convert from an @'Data.Either.Either' Int Int@ to an - -- @Either Int String@ using 'Prelude.show': - -- - -- >>> fmap show (Left 17) - -- Left 17 - -- >>> fmap show (Right 17) - -- Right "17" - -- - -- Double each element of a list: - -- - -- >>> fmap (*2) [1,2,3] - -- [2,4,6] - -- - -- Apply 'Prelude.even' to the second element of a pair: - -- - -- >>> fmap even (2,2) - -- (2,True) - -- - -- It may seem surprising that the function is only applied to the last element of the tuple - -- compared to the list example above which applies it to every element in the list. - -- To understand, remember that tuples are type constructors with multiple type parameters: - -- a tuple of 3 elements @(a,b,c)@ can also be written @(,,) a b c@ and its @Functor@ instance - -- is defined for @Functor ((,,) a b)@ (i.e., only the third parameter is free to be mapped over - -- with @fmap@). - -- - -- It explains why @fmap@ can be used with tuples containing values of different types as in the - -- following example: - -- - -- >>> fmap even ("hello", 1.0, 4) - -- ("hello",1.0,True) - - fmap :: (a -> b) -> f a -> f b - - -- | Replace all locations in the input with the same value. - -- The default definition is @'fmap' . 'const'@, but this may be - -- overridden with a more efficient version. - -- - -- ==== __Examples__ - -- - -- Perform a computation with 'Maybe' and replace the result with a - -- constant value if it is 'Just': - -- - -- >>> 'a' <$ Just 2 - -- Just 'a' - -- >>> 'a' <$ Nothing - -- Nothing - (<$) :: a -> f b -> f a - (<$) = fmap . const - --- | A functor with application, providing operations to --- --- * embed pure expressions ('pure'), and --- --- * sequence computations and combine their results ('<*>' and 'liftA2'). --- --- A minimal complete definition must include implementations of 'pure' --- and of either '<*>' or 'liftA2'. If it defines both, then they must behave --- the same as their default definitions: --- --- @('<*>') = 'liftA2' 'id'@ --- --- @'liftA2' f x y = f 'Prelude.<$>' x '<*>' y@ --- --- Further, any definition must satisfy the following: --- --- [Identity] --- --- @'pure' 'id' '<*>' v = v@ --- --- [Composition] --- --- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ --- --- [Homomorphism] --- --- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ --- --- [Interchange] --- --- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ --- --- --- The other methods have the following default definitions, which may --- be overridden with equivalent specialized implementations: --- --- * @u '*>' v = ('id' '<$' u) '<*>' v@ --- --- * @u '<*' v = 'liftA2' 'const' u v@ --- --- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy --- --- * @'fmap' f x = 'pure' f '<*>' x@ --- --- --- It may be useful to note that supposing --- --- @forall x y. p (q x y) = f x . g y@ --- --- it follows from the above that --- --- @'liftA2' p ('liftA2' q u v) = 'liftA2' f u . 'liftA2' g v@ --- --- --- If @f@ is also a 'Monad', it should satisfy --- --- * @'pure' = 'return'@ --- --- * @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ --- --- * @('*>') = ('>>')@ --- --- (which implies that 'pure' and '<*>' satisfy the applicative functor laws). - -class Functor f => Applicative f where - {-# MINIMAL pure, ((<*>) | liftA2) #-} - -- | Lift a value. - pure :: a -> f a - - -- | Sequential application. - -- - -- A few functors support an implementation of '<*>' that is more - -- efficient than the default one. - -- - -- ==== __Example__ - -- Used in combination with @('<$>')@, @('<*>')@ can be used to build a record. - -- - -- >>> data MyState = MyState {arg1 :: Foo, arg2 :: Bar, arg3 :: Baz} - -- - -- >>> produceFoo :: Applicative f => f Foo - -- - -- >>> produceBar :: Applicative f => f Bar - -- >>> produceBaz :: Applicative f => f Baz - -- - -- >>> mkState :: Applicative f => f MyState - -- >>> mkState = MyState <$> produceFoo <*> produceBar <*> produceBaz - (<*>) :: f (a -> b) -> f a -> f b - (<*>) = liftA2 id - - -- | Lift a binary function to actions. - -- - -- Some functors support an implementation of 'liftA2' that is more - -- efficient than the default one. In particular, if 'fmap' is an - -- expensive operation, it is likely better to use 'liftA2' than to - -- 'fmap' over the structure and then use '<*>'. - -- - -- This became a typeclass method in 4.10.0.0. Prior to that, it was - -- a function defined in terms of '<*>' and 'fmap'. - -- - -- ==== __Example__ - -- >>> liftA2 (,) (Just 3) (Just 5) - -- Just (3,5) - - liftA2 :: (a -> b -> c) -> f a -> f b -> f c - liftA2 f x = (<*>) (fmap f x) - - -- | Sequence actions, discarding the value of the first argument. - -- - -- ==== __Examples__ - -- If used in conjunction with the Applicative instance for 'Maybe', - -- you can chain Maybe computations, with a possible "early return" - -- in case of 'Nothing'. - -- - -- >>> Just 2 *> Just 3 - -- Just 3 - -- - -- >>> Nothing *> Just 3 - -- Nothing - -- - -- Of course a more interesting use case would be to have effectful - -- computations instead of just returning pure values. - -- - -- >>> import Data.Char - -- >>> import Text.ParserCombinators.ReadP - -- >>> let p = string "my name is " *> munch1 isAlpha <* eof - -- >>> readP_to_S p "my name is Simon" - -- [("Simon","")] - - (*>) :: f a -> f b -> f b - a1 *> a2 = (id <$ a1) <*> a2 - - -- This is essentially the same as liftA2 (flip const), but if the - -- Functor instance has an optimized (<$), it may be better to use - -- that instead. Before liftA2 became a method, this definition - -- was strictly better, but now it depends on the functor. For a - -- functor supporting a sharing-enhancing (<$), this definition - -- may reduce allocation by preventing a1 from ever being fully - -- realized. In an implementation with a boring (<$) but an optimizing - -- liftA2, it would likely be better to define (*>) using liftA2. - - -- | Sequence actions, discarding the value of the second argument. - -- - (<*) :: f a -> f b -> f a - (<*) = liftA2 const - --- | A variant of '<*>' with the arguments reversed. --- -(<**>) :: Applicative f => f a -> f (a -> b) -> f b -(<**>) = liftA2 (\a f -> f a) --- Don't use $ here, see the note at the top of the page - --- | Lift a function to actions. --- Equivalent to Functor's `fmap` but implemented using only `Applicative`'s methods: --- @'liftA' f a = 'pure' f '<*>' a@ --- --- As such this function may be used to implement a `Functor` instance from an `Applicative` one. --- --- ==== __Examples__ --- Using the Applicative instance for Lists: --- --- >>> liftA (+1) [1, 2] --- [2,3] --- --- Or the Applicative instance for 'Maybe' --- --- >>> liftA (+1) (Just 3) --- Just 4 - -liftA :: Applicative f => (a -> b) -> f a -> f b -liftA f a = pure f <*> a --- Caution: since this may be used for `fmap`, we can't use the obvious --- definition of liftA = fmap. - --- | Lift a ternary function to actions. - -liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d -liftA3 f a b c = liftA2 f a b <*> c - - -{-# INLINABLE liftA #-} -{-# SPECIALISE liftA :: (a1->r) -> IO a1 -> IO r #-} -{-# SPECIALISE liftA :: (a1->r) -> Maybe a1 -> Maybe r #-} -{-# INLINABLE liftA3 #-} -{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} -{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> - Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} - --- | The 'join' function is the conventional monad join operator. It --- is used to remove one level of monadic structure, projecting its --- bound argument into the outer level. --- --- --- \'@'join' bss@\' can be understood as the @do@ expression --- --- @ --- do bs <- bss --- bs --- @ --- --- ==== __Examples__ --- --- A common use of 'join' is to run an 'IO' computation returned from --- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions --- can't perform 'IO' directly. Recall that --- --- @ --- 'GHC.Conc.atomically' :: STM a -> IO a --- @ --- --- is used to run 'GHC.Conc.STM' transactions atomically. So, by --- specializing the types of 'GHC.Conc.atomically' and 'join' to --- --- @ --- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b) --- 'join' :: IO (IO b) -> IO b --- @ --- --- we can compose them as --- --- @ --- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b --- @ --- --- to run an 'GHC.Conc.STM' transaction and the 'IO' action it --- returns. -join :: (Monad m) => m (m a) -> m a -join x = x >>= id - -{- | The 'Monad' class defines the basic operations over a /monad/, -a concept from a branch of mathematics known as /category theory/. -From the perspective of a Haskell programmer, however, it is best to -think of a monad as an /abstract datatype/ of actions. -Haskell's @do@ expressions provide a convenient syntax for writing -monadic expressions. - -Instances of 'Monad' should satisfy the following: - -[Left identity] @'return' a '>>=' k = k a@ -[Right identity] @m '>>=' 'return' = m@ -[Associativity] @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ - -Furthermore, the 'Monad' and 'Applicative' operations should relate as follows: - -* @'pure' = 'return'@ -* @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ - -The above laws imply: - -* @'fmap' f xs = xs '>>=' 'return' . f@ -* @('>>') = ('*>')@ - -and that 'pure' and ('<*>') satisfy the applicative functor laws. - -The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' -defined in the "Prelude" satisfy these laws. --} -class Applicative m => Monad m where - -- | Sequentially compose two actions, passing any value produced - -- by the first as an argument to the second. - -- - -- \'@as '>>=' bs@\' can be understood as the @do@ expression - -- - -- @ - -- do a <- as - -- bs a - -- @ - (>>=) :: forall a b. m a -> (a -> m b) -> m b - - -- | Sequentially compose two actions, discarding any value produced - -- by the first, like sequencing operators (such as the semicolon) - -- in imperative languages. - -- - -- \'@as '>>' bs@\' can be understood as the @do@ expression - -- - -- @ - -- do as - -- bs - -- @ - (>>) :: forall a b. m a -> m b -> m b - m >> k = m >>= \_ -> k -- See Note [Recursive bindings for Applicative/Monad] - {-# INLINE (>>) #-} - - -- | Inject a value into the monadic type. - return :: a -> m a - return = pure - -{- Note [Recursive bindings for Applicative/Monad] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The original Applicative/Monad proposal stated that after -implementation, the designated implementation of (>>) would become - - (>>) :: forall a b. m a -> m b -> m b - (>>) = (*>) - -by default. You might be inclined to change this to reflect the stated -proposal, but you really shouldn't! Why? Because people tend to define -such instances the /other/ way around: in particular, it is perfectly -legitimate to define an instance of Applicative (*>) in terms of (>>), -which would lead to an infinite loop for the default implementation of -Monad! And people do this in the wild. - -This turned into a nasty bug that was tricky to track down, and rather -than eliminate it everywhere upstream, it's easier to just retain the -original default. - --} - --- | Same as '>>=', but with the arguments interchanged. -{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-} -(=<<) :: Monad m => (a -> m b) -> m a -> m b -f =<< x = x >>= f - --- | Conditional execution of 'Applicative' expressions. For example, --- --- > when debug (putStrLn "Debugging") --- --- will output the string @Debugging@ if the Boolean value @debug@ --- is 'True', and otherwise do nothing. -when :: (Applicative f) => Bool -> f () -> f () -{-# INLINABLE when #-} -{-# SPECIALISE when :: Bool -> IO () -> IO () #-} -{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} -when p s = if p then s else pure () - --- | Evaluate each action in the sequence from left to right, --- and collect the results. -sequence :: Monad m => [m a] -> m [a] -{-# INLINE sequence #-} -sequence = mapM id --- Note: [sequence and mapM] - --- | @'mapM' f@ is equivalent to @'sequence' . 'map' f at . -mapM :: Monad m => (a -> m b) -> [a] -> m [b] -{-# INLINE mapM #-} -mapM f as = foldr k (return []) as - where - k a r = do { x <- f a; xs <- r; return (x:xs) } - -{- -Note: [sequence and mapM] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Originally, we defined - -mapM f = sequence . map f - -This relied on list fusion to produce efficient code for mapM, and led to -excessive allocation in cryptarithm2. Defining - -sequence = mapM id - -relies only on inlining a tiny function (id) and beta reduction, which tends to -be a more reliable aspect of simplification. Indeed, this does not lead to -similar problems in nofib. --} - --- | Promote a function to a monad. -liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r -liftM f m1 = do { x1 <- m1; return (f x1) } - --- | Promote a function to a monad, scanning the monadic arguments from --- left to right. For example, --- --- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] --- > liftM2 (+) (Just 1) Nothing = Nothing --- -liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r -liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) } --- Caution: since this may be used for `liftA2`, we can't use the obvious --- definition of liftM2 = liftA2. - --- | Promote a function to a monad, scanning the monadic arguments from --- left to right (cf. 'liftM2'). -liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r -liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) } - --- | Promote a function to a monad, scanning the monadic arguments from --- left to right (cf. 'liftM2'). -liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r -liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) } - --- | Promote a function to a monad, scanning the monadic arguments from --- left to right (cf. 'liftM2'). -liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r -liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) } - -{-# INLINABLE liftM #-} -{-# SPECIALISE liftM :: (a1->r) -> IO a1 -> IO r #-} -{-# SPECIALISE liftM :: (a1->r) -> Maybe a1 -> Maybe r #-} -{-# INLINABLE liftM2 #-} -{-# SPECIALISE liftM2 :: (a1->a2->r) -> IO a1 -> IO a2 -> IO r #-} -{-# SPECIALISE liftM2 :: (a1->a2->r) -> Maybe a1 -> Maybe a2 -> Maybe r #-} -{-# INLINABLE liftM3 #-} -{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} -{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} -{-# INLINABLE liftM4 #-} -{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO r #-} -{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe r #-} -{-# INLINABLE liftM5 #-} -{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO a5 -> IO r #-} -{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe a5 -> Maybe r #-} - -{- | In many situations, the 'liftM' operations can be replaced by uses of -'ap', which promotes function application. - -> return f `ap` x1 `ap` ... `ap` xn - -is equivalent to - -> liftMn f x1 x2 ... xn - --} - -ap :: (Monad m) => m (a -> b) -> m a -> m b -ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } --- Since many Applicative instances define (<*>) = ap, we --- cannot define ap = (<*>) -{-# INLINABLE ap #-} -{-# SPECIALISE ap :: IO (a -> b) -> IO a -> IO b #-} -{-# SPECIALISE ap :: Maybe (a -> b) -> Maybe a -> Maybe b #-} - --- instances for Prelude types - --- | @since 2.01 -instance Functor ((->) r) where - fmap = (.) - --- | @since 2.01 -instance Applicative ((->) r) where - pure = const - (<*>) f g x = f x (g x) - liftA2 q f g x = q (f x) (g x) - --- | @since 2.01 -instance Monad ((->) r) where - f >>= k = \ r -> k (f r) r - --- | @since 4.15 -instance Functor Solo where - fmap f (MkSolo a) = MkSolo (f a) - - -- Being strict in the `Solo` argument here seems most consistent - -- with the concept behind `Solo`: always strict in the wrapper and lazy - -- in the contents. - x <$ MkSolo _ = MkSolo x - --- | @since 2.01 -instance Functor ((,) a) where - fmap f (x,y) = (x, f y) - --- | @since 2.01 -instance Functor Maybe where - fmap _ Nothing = Nothing - fmap f (Just a) = Just (f a) - --- | @since 2.01 -instance Applicative Maybe where - pure = Just - - Just f <*> m = fmap f m - Nothing <*> _m = Nothing - - liftA2 f (Just x) (Just y) = Just (f x y) - liftA2 _ _ _ = Nothing - - Just _m1 *> m2 = m2 - Nothing *> _m2 = Nothing - --- | @since 2.01 -instance Monad Maybe where - (Just x) >>= k = k x - Nothing >>= _ = Nothing - - (>>) = (*>) - --- ----------------------------------------------------------------------------- --- The Alternative class definition - -infixl 3 <|> - --- | A monoid on applicative functors. --- --- If defined, 'some' and 'many' should be the least solutions --- of the equations: --- --- * @'some' v = (:) 'Prelude.<$>' v '<*>' 'many' v@ --- --- * @'many' v = 'some' v '<|>' 'pure' []@ -class Applicative f => Alternative f where - -- | The identity of '<|>' - empty :: f a - -- | An associative binary operation - (<|>) :: f a -> f a -> f a - - -- | One or more. - some :: f a -> f [a] - some v = some_v - where - many_v = some_v <|> pure [] - some_v = liftA2 (:) v many_v - - -- | Zero or more. - many :: f a -> f [a] - many v = many_v - where - many_v = some_v <|> pure [] - some_v = liftA2 (:) v many_v - - --- | Picks the leftmost 'Just' value, or, alternatively, 'Nothing'. --- --- @since 2.01 -instance Alternative Maybe where - empty = Nothing - Nothing <|> r = r - l <|> _ = l - --- ----------------------------------------------------------------------------- --- The MonadPlus class definition - --- | Monads that also support choice and failure. -class (Alternative m, Monad m) => MonadPlus m where - -- | The identity of 'mplus'. It should also satisfy the equations - -- - -- > mzero >>= f = mzero - -- > v >> mzero = mzero - -- - -- The default definition is - -- - -- @ - -- mzero = 'empty' - -- @ - mzero :: m a - mzero = empty - - -- | An associative operation. The default definition is - -- - -- @ - -- mplus = ('<|>') - -- @ - mplus :: m a -> m a -> m a - mplus = (<|>) - --- | Picks the leftmost 'Just' value, or, alternatively, 'Nothing'. --- --- @since 2.01 -instance MonadPlus Maybe - ---------------------------------------------- --- The non-empty list type - -infixr 5 :| - --- | Non-empty (and non-strict) list type. --- --- @since 4.9.0.0 -data NonEmpty a = a :| [a] - deriving ( Eq -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - ) - --- | @since 4.9.0.0 -instance Functor NonEmpty where - fmap f ~(a :| as) = f a :| fmap f as - b <$ ~(_ :| as) = b :| (b <$ as) - --- | @since 4.9.0.0 -instance Applicative NonEmpty where - pure a = a :| [] - (<*>) = ap - liftA2 = liftM2 - --- | @since 4.9.0.0 -instance Monad NonEmpty where - ~(a :| as) >>= f = b :| (bs ++ bs') - where b :| bs = f a - bs' = as >>= toList . f - toList ~(c :| cs) = c : cs - ----------------------------------------------- --- The list type - --- | @since 2.01 -instance Functor [] where - {-# INLINE fmap #-} - fmap = map - --- See Note: [List comprehensions and inlining] --- | @since 2.01 -instance Applicative [] where - {-# INLINE pure #-} - pure x = [x] - {-# INLINE (<*>) #-} - fs <*> xs = [f x | f <- fs, x <- xs] - {-# INLINE liftA2 #-} - liftA2 f xs ys = [f x y | x <- xs, y <- ys] - {-# INLINE (*>) #-} - xs *> ys = [y | _ <- xs, y <- ys] - --- See Note: [List comprehensions and inlining] --- | @since 2.01 -instance Monad [] where - {-# INLINE (>>=) #-} - xs >>= f = [y | x <- xs, y <- f x] - {-# INLINE (>>) #-} - (>>) = (*>) - --- | Combines lists by concatenation, starting from the empty list. --- --- @since 2.01 -instance Alternative [] where - empty = [] - (<|>) = (++) - --- | Combines lists by concatenation, starting from the empty list. --- --- @since 2.01 -instance MonadPlus [] - -{- -A few list functions that appear here because they are used here. -The rest of the prelude list functions are in GHC.List. --} - ----------------------------------------------- --- foldr/build/augment ----------------------------------------------- - --- | 'foldr', applied to a binary operator, a starting value (typically --- the right-identity of the operator), and a list, reduces the list --- using the binary operator, from right to left: --- --- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) - -foldr :: (a -> b -> b) -> b -> [a] -> b --- foldr _ z [] = z --- foldr f z (x:xs) = f x (foldr f z xs) -{-# INLINE [0] foldr #-} --- Inline only in the final stage, after the foldr/cons rule has had a chance --- Also note that we inline it when it has *two* parameters, which are the --- ones we are keen about specialising! -foldr k z = go - where - go [] = z - go (y:ys) = y `k` go ys - --- | A list producer that can be fused with 'foldr'. --- This function is merely --- --- > build g = g (:) [] --- --- but GHC's simplifier will transform an expression of the form --- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@, --- which avoids producing an intermediate list. - -build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] -{-# INLINE [1] build #-} - -- The INLINE is important, even though build is tiny, - -- because it prevents [] getting inlined in the version that - -- appears in the interface file. If [] *is* inlined, it - -- won't match with [] appearing in rules in an importing module. - -- - -- The "1" says to inline in phase 1 - -build g = g (:) [] - --- | A list producer that can be fused with 'foldr'. --- This function is merely --- --- > augment g xs = g (:) xs --- --- but GHC's simplifier will transform an expression of the form --- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to --- @g k ('foldr' k z xs)@, which avoids producing an intermediate list. - -augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a] -{-# INLINE [1] augment #-} -augment g xs = g (:) xs - -{-# RULES -"fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) . - foldr k z (build g) = g k z - -"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . - foldr k z (augment g xs) = g k (foldr k z xs) - -"foldr/id" foldr (:) [] = \x -> x -"foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys - -- Only activate this from phase 1, because that's - -- when we disable the rule that expands (++) into foldr - --- The foldr/cons rule looks nice, but it can give disastrously --- bloated code when compiling --- array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] --- i.e. when there are very very long literal lists --- So I've disabled it for now. We could have special cases --- for short lists, I suppose. --- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs) - -"foldr/single" forall k z x. foldr k z [x] = k x z -"foldr/nil" forall k z. foldr k z [] = z - -"foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) . - foldr k z (x:build g) = k x (g k z) - -"augment/build" forall (g::forall b. (a->b->b) -> b -> b) - (h::forall b. (a->b->b) -> b -> b) . - augment g (build h) = build (\c n -> g c (h c n)) -"augment/nil" forall (g::forall b. (a->b->b) -> b -> b) . - augment g [] = build g - #-} - --- This rule is true, but not (I think) useful: --- augment g (augment h t) = augment (\cn -> g c (h c n)) t - ----------------------------------------------- --- map ----------------------------------------------- - --- | \(\mathcal{O}(n)\). 'map' @f xs@ is the list obtained by applying @f@ to --- each element of @xs@, i.e., --- --- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn] --- > map f [x1, x2, ...] == [f x1, f x2, ...] --- --- >>> map (+1) [1, 2, 3] --- [2,3,4] -map :: (a -> b) -> [a] -> [b] -{-# NOINLINE [0] map #-} - -- We want the RULEs "map" and "map/coerce" to fire first. - -- map is recursive, so won't inline anyway, - -- but saying so is more explicit, and silences warnings -map _ [] = [] -map f (x:xs) = f x : map f xs - --- Note eta expanded -mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst -{-# INLINE [0] mapFB #-} -- See Note [Inline FB functions] in GHC.List -mapFB c f = \x ys -> c (f x) ys - -{- Note [The rules for map] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The rules for map work like this. - -* Up to (but not including) phase 1, we use the "map" rule to - rewrite all saturated applications of map with its build/fold - form, hoping for fusion to happen. - - In phase 1 and 0, we switch off that rule, inline build, and - switch on the "mapList" rule, which rewrites the foldr/mapFB - thing back into plain map. - - It's important that these two rules aren't both active at once - (along with build's unfolding) else we'd get an infinite loop - in the rules. Hence the activation control below. - -* This same pattern is followed by many other functions: - e.g. append, filter, iterate, repeat, etc. in GHC.List - - See also Note [Inline FB functions] in GHC.List - -* The "mapFB" rule optimises compositions of map - -* The "mapFB/id" rule gets rid of 'map id' calls. - You might think that (mapFB c id) will turn into c simply - when mapFB is inlined; but before that happens the "mapList" - rule turns - (foldr (mapFB (:) id) [] a - back into - map id - Which is not very clever. - -* Any similarity to the Functor laws for [] is expected. --} - -{-# RULES -"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) -"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f -"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g) -"mapFB/id" forall c. mapFB c (\x -> x) = c - #-} - --- See Breitner, Eisenberg, Peyton Jones, and Weirich, "Safe Zero-cost --- Coercions for Haskell", section 6.5: --- http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf - -{-# RULES "map/coerce" [1] map coerce = coerce #-} --- See Note [Getting the map/coerce RULE to work] in GHC.Core.SimpleOpt - ----------------------------------------------- --- append ----------------------------------------------- - --- | Append two lists, i.e., --- --- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] --- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] --- --- If the first list is not finite, the result is the first list. --- --- WARNING: This function takes linear time in the number of elements of the --- first list. - -(++) :: [a] -> [a] -> [a] -{-# NOINLINE [2] (++) #-} - -- Give time for the RULEs for (++) to fire in InitialPhase - -- It's recursive, so won't inline anyway, - -- but saying so is more explicit -(++) [] ys = ys -(++) (x:xs) ys = x : xs ++ ys - -{-# RULES -"++/literal" forall x. (++) (unpackCString# x) = unpackAppendCString# x -"++/literal_utf8" forall x. (++) (unpackCStringUtf8# x) = unpackAppendCStringUtf8# x #-} - -{-# RULES -"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys - #-} - - -- |'otherwise' is defined as the value 'True'. It helps to make -- guards more readable. eg. -- @@ -1489,35 +195,6 @@ The rules for map work like this. otherwise :: Bool otherwise = True ----------------------------------------------- --- Type Char and String ----------------------------------------------- - --- | A 'String' is a list of characters. String constants in Haskell are values --- of type 'String'. --- --- See "Data.List" for operations on lists. -type String = [Char] - -unsafeChr :: Int -> Char -unsafeChr (I# i#) = C# (chr# i#) - --- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'. -ord :: Char -> Int -ord (C# c#) = I# (ord# c#) - --- | This 'String' equality predicate is used when desugaring --- pattern-matches against strings. -eqString :: String -> String -> Bool -eqString [] [] = True -eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 -eqString _ _ = False - -{-# RULES "eqString" (==) = eqString #-} --- eqString also has a BuiltInRule in GHC.Core.Opt.ConstantFold: --- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2 - - ---------------------------------------------- -- 'Int' related definitions ---------------------------------------------- @@ -1536,16 +213,6 @@ minInt = I# (-0x8000000000000000#) maxInt = I# 0x7FFFFFFFFFFFFFFF# #endif ----------------------------------------------- --- The function type ----------------------------------------------- - --- | Identity function. --- --- > id x = x -id :: a -> a -id x = x - -- Assertion function. This simply ignores its boolean argument. -- The compiler may rewrite it to @('assertError' line)@. @@ -1574,112 +241,7 @@ breakpointCond :: Bool -> a -> a breakpointCond _ r = r data Opaque = forall a. O a --- | @const x y@ always evaluates to @x@, ignoring its second argument. --- --- >>> const 42 "hello" --- 42 --- --- >>> map (const 42) [0..3] --- [42,42,42,42] -const :: a -> b -> a -const x _ = x - --- | Function composition. -{-# INLINE (.) #-} --- Make sure it has TWO args only on the left, so that it inlines --- when applied to two functions, even if there is no final argument -(.) :: (b -> c) -> (a -> b) -> a -> c -(.) f g = \x -> f (g x) - --- | @'flip' f@ takes its (first) two arguments in the reverse order of @f at . --- --- >>> flip (++) "hello" "world" --- "worldhello" -flip :: (a -> b -> c) -> b -> a -> c -flip f x y = f y x - --- Note: Before base-4.19, ($) was not representation polymorphic --- in both type parameters but only in the return type. --- The generalization forced a change to the implementation, --- changing its laziness, affecting expressions like (($) undefined): before --- base-4.19 the expression (($) undefined) `seq` () was equivalent to --- (\x -> undefined x) `seq` () and thus would just evaluate to (), but now --- it is equivalent to undefined `seq` () which diverges. - -{- | @($)@ is the __function application__ operator. - -Applying @($)@ to a function @f@ and an argument @x@ gives the same result as applying @f@ to @x@ directly. The definition is akin to this: - -@ -($) :: (a -> b) -> a -> b -($) f x = f x -@ - -On the face of it, this may appear pointless! But it's actually one of the most useful and important operators in Haskell. - -The order of operations is very different between @($)@ and normal function application. Normal function application has precedence 10 - higher than any operator - and associates to the left. So these two definitions are equivalent: - -@ -expr = min 5 1 + 5 -expr = ((min 5) 1) + 5 -@ - -@($)@ has precedence 0 (the lowest) and associates to the right, so these are equivalent: - -@ -expr = min 5 $ 1 + 5 -expr = (min 5) (1 + 5) -@ - -=== Uses -A common use cases of @($)@ is to avoid parentheses in complex expressions. - -For example, instead of using nested parentheses in the following - Haskell function: - -@ --- | Sum numbers in a string: strSum "100 5 -7" == 98 -strSum :: 'String' -> 'Int' -strSum s = 'sum' ('Data.Maybe.mapMaybe' 'Text.Read.readMaybe' ('words' s)) -@ - -we can deploy the function application operator: - -@ --- | Sum numbers in a string: strSum "100 5 -7" == 98 -strSum :: 'String' -> 'Int' -strSum s = 'sum' '$' 'Data.Maybe.mapMaybe' 'Text.Read.readMaybe' '$' 'words' s -@ - -@($)@ is also used as a section (a partially applied operator), in order to indicate that we wish to apply some yet-unspecified function to a given value. For example, to apply the argument @5@ to a list of functions: - -@ -applyFive :: [Int] -applyFive = map ($ 5) [(+1), (2^)] ->>> [6, 32] -@ - -=== Technical Remark (Representation Polymorphism) - -@($)@ is fully representation-polymorphic. This allows it to also be used with arguments of unlifted and even unboxed kinds, such as unboxed integers: - -@ -fastMod :: Int -> Int -> Int -fastMod (I# x) (I# m) = I# $ remInt# x m -@ --} -{-# INLINE ($) #-} -($) :: forall repa repb (a :: TYPE repa) (b :: TYPE repb). (a -> b) -> a -> b -($) f = f - --- | Strict (call-by-value) application operator. It takes a function and an --- argument, evaluates the argument to weak head normal form (WHNF), then calls --- the function with that value. - -($!) :: forall r a (b :: TYPE r). (a -> b) -> a -> b -{-# INLINE ($!) #-} -f $! x = let !vx = x in f vx -- see #2273 -- | @'until' p f@ yields the result of applying @f@ until @p@ holds. until :: (a -> Bool) -> (a -> a) -> a -> a @@ -1688,70 +250,6 @@ until p f = go go x | p x = x | otherwise = go (f x) --- | 'asTypeOf' is a type-restricted version of 'const'. It is usually --- used as an infix operator, and its typing forces its first argument --- (which is usually overloaded) to have the same type as the second. -asTypeOf :: a -> a -> a -asTypeOf = const - ----------------------------------------------- --- Functor/Applicative/Monad instances for IO ----------------------------------------------- - --- | @since 2.01 -instance Functor IO where - fmap f x = x >>= (pure . f) - --- | @since 2.01 -instance Applicative IO where - {-# INLINE pure #-} - {-# INLINE (*>) #-} - {-# INLINE liftA2 #-} - pure = returnIO - (*>) = thenIO - (<*>) = ap - liftA2 = liftM2 - --- | @since 2.01 -instance Monad IO where - {-# INLINE (>>) #-} - {-# INLINE (>>=) #-} - (>>) = (*>) - (>>=) = bindIO - --- | Takes the first non-throwing 'IO' action\'s result. --- 'empty' throws an exception. --- --- @since 4.9.0.0 -instance Alternative IO where - empty = failIO "mzero" - (<|>) = mplusIO - --- | Takes the first non-throwing 'IO' action\'s result. --- 'mzero' throws an exception. --- --- @since 4.9.0.0 -instance MonadPlus IO - -returnIO :: a -> IO a -returnIO x = IO (\ s -> (# s, x #)) - -bindIO :: IO a -> (a -> IO b) -> IO b -bindIO (IO m) k = IO (\ s -> case m s of (# new_s, a #) -> unIO (k a) new_s) - -thenIO :: IO a -> IO b -> IO b -thenIO (IO m) k = IO (\ s -> case m s of (# new_s, _ #) -> unIO k new_s) - --- Note that it is import that we do not SOURCE import this as --- its demand signature encodes knowledge of its bottoming --- behavior, which can expose useful simplifications. See --- #16588. -failIO :: String -> IO a -failIO s = IO (raiseIO# (mkUserError s)) - -unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #)) -unIO (IO a) = a - {- | Returns the tag of a constructor application; this function is used by the deriving code for Eq, Ord and Enum. @@ -1918,21 +416,3 @@ a `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = negateInt# (a <# 0#) iShiftRL# :: Int# -> Int# -> Int# a `iShiftRL#` b = (a `uncheckedIShiftRL#` b) `andI#` shift_mask WORD_SIZE_IN_BITS# b --- Rules for C strings (the functions themselves are now in GHC.CString) -{-# RULES -"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) -"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a -"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n -"unpack-append-nil" forall a . unpackAppendCString# a [] = unpackCString# a - -"unpack-utf8" [~1] forall a . unpackCStringUtf8# a = build (unpackFoldrCStringUtf8# a) -"unpack-list-utf8" [1] forall a . unpackFoldrCStringUtf8# a (:) [] = unpackCStringUtf8# a -"unpack-append-utf8" forall a n . unpackFoldrCStringUtf8# a (:) n = unpackAppendCStringUtf8# a n -"unpack-append-nil-utf8" forall a . unpackAppendCStringUtf8# a [] = unpackCStringUtf8# a - --- There's a built-in rule (in GHC.Core.Op.ConstantFold) for --- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n - --- See also the Note [String literals in GHC] in CString.hs - - #-} ===================================== libraries/base/GHC/Base/FunOps.hs ===================================== @@ -0,0 +1,140 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} + +module GHC.Base.FunOps + ( id + , const + , (.) + , flip + , ($) + , ($!) + , asTypeOf + ) where + +import GHC.Types + +infixr 9 . +infixr 0 $, $! + +-- | Identity function. +-- +-- > id x = x +id :: a -> a +id x = x + +-- | @const x y@ always evaluates to @x@, ignoring its second argument. +-- +-- >>> const 42 "hello" +-- 42 +-- +-- >>> map (const 42) [0..3] +-- [42,42,42,42] +const :: a -> b -> a +const x _ = x + +-- | Function composition. +{-# INLINE (.) #-} +-- Make sure it has TWO args only on the left, so that it inlines +-- when applied to two functions, even if there is no final argument +(.) :: (b -> c) -> (a -> b) -> a -> c +(.) f g = \x -> f (g x) + +-- | @'flip' f@ takes its (first) two arguments in the reverse order of @f at . +-- +-- >>> flip (++) "hello" "world" +-- "worldhello" +flip :: (a -> b -> c) -> b -> a -> c +flip f x y = f y x + +-- Note: Before base-4.19, ($) was not representation polymorphic +-- in both type parameters but only in the return type. +-- The generalization forced a change to the implementation, +-- changing its laziness, affecting expressions like (($) undefined): before +-- base-4.19 the expression (($) undefined) `seq` () was equivalent to +-- (\x -> undefined x) `seq` () and thus would just evaluate to (), but now +-- it is equivalent to undefined `seq` () which diverges. + +{- | @($)@ is the __function application__ operator. + +Applying @($)@ to a function @f@ and an argument @x@ gives the same result as applying @f@ to @x@ directly. The definition is akin to this: + +@ +($) :: (a -> b) -> a -> b +($) f x = f x +@ + +On the face of it, this may appear pointless! But it's actually one of the most useful and important operators in Haskell. + +The order of operations is very different between @($)@ and normal function application. Normal function application has precedence 10 - higher than any operator - and associates to the left. So these two definitions are equivalent: + +@ +expr = min 5 1 + 5 +expr = ((min 5) 1) + 5 +@ + +@($)@ has precedence 0 (the lowest) and associates to the right, so these are equivalent: + +@ +expr = min 5 $ 1 + 5 +expr = (min 5) (1 + 5) +@ + +=== Uses + +A common use cases of @($)@ is to avoid parentheses in complex expressions. + +For example, instead of using nested parentheses in the following + Haskell function: + +@ +-- | Sum numbers in a string: strSum "100 5 -7" == 98 +strSum :: 'String' -> 'Int' +strSum s = 'sum' ('Data.Maybe.mapMaybe' 'Text.Read.readMaybe' ('words' s)) +@ + +we can deploy the function application operator: + +@ +-- | Sum numbers in a string: strSum "100 5 -7" == 98 +strSum :: 'String' -> 'Int' +strSum s = 'sum' '$' 'Data.Maybe.mapMaybe' 'Text.Read.readMaybe' '$' 'words' s +@ + +@($)@ is also used as a section (a partially applied operator), in order to indicate that we wish to apply some yet-unspecified function to a given value. For example, to apply the argument @5@ to a list of functions: + +@ +applyFive :: [Int] +applyFive = map ($ 5) [(+1), (2^)] +>>> [6, 32] +@ + +=== Technical Remark (Representation Polymorphism) + +@($)@ is fully representation-polymorphic. This allows it to also be used with arguments of unlifted and even unboxed kinds, such as unboxed integers: + +@ +fastMod :: Int -> Int -> Int +fastMod (I# x) (I# m) = I# $ remInt# x m +@ +-} +{-# INLINE ($) #-} +($) :: forall repa repb (a :: TYPE repa) (b :: TYPE repb). (a -> b) -> a -> b +($) f = f + +-- | Strict (call-by-value) application operator. It takes a function and an +-- argument, evaluates the argument to weak head normal form (WHNF), then calls +-- the function with that value. + +($!) :: forall r a (b :: TYPE r). (a -> b) -> a -> b +{-# INLINE ($!) #-} +f $! x = let !vx = x in f vx -- see #2273 + +-- | 'asTypeOf' is a type-restricted version of 'const'. It is usually +-- used as an infix operator, and its typing forces its first argument +-- (which is usually overloaded) to have the same type as the second. +asTypeOf :: a -> a -> a +asTypeOf = const + ===================================== libraries/base/GHC/Base/Functor.hs ===================================== @@ -0,0 +1,883 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE RankNTypes #-} + +{-# OPTIONS_HADDOCK not-home #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Base.Functor +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- The functor class hierarchy. +-- +----------------------------------------------------------------------------- + +module GHC.Base.Functor + ( Functor(..) + , Applicative(..) + , Monad(..) + , liftA + , liftA3 + , join + , when + , sequence + , mapM + , liftM + , liftM2 + , liftM3 + , liftM4 + , liftM5 + , ap + , (<**>) + , (=<<) + -- * Alternative + , Alternative(..) + , MonadPlus(..) + -- * 'IO' helpers + , returnIO + , bindIO + , thenIO + , failIO + , unIO + ) where + +import GHC.Types (Bool, IO(..)) +import GHC.Prim (State#, RealWorld, raiseIO#) +import GHC.Tuple (Solo(..)) + +import GHC.Base.FunOps (const, id, (.)) +import GHC.Base.List +import GHC.Base.NonEmpty (NonEmpty(..)) +import GHC.Base.Semigroup (Monoid(mempty), Semigroup((<>))) +import GHC.Base.String (String) +import GHC.Maybe (Maybe(..)) + +import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO) + +default () -- Double isn't available yet + +infixl 4 <$ +infixl 1 >>, >>= +infixr 1 =<< +infixl 4 <*>, <*, *>, <**> +infixl 3 <|> + +{- | A type @f@ is a Functor if it provides a function @fmap@ which, given any types @a@ and @b@ +lets you apply any function from @(a -> b)@ to turn an @f a@ into an @f b@, preserving the +structure of @f at . Furthermore @f@ needs to adhere to the following: + +[Identity] @'fmap' 'id' == 'id'@ +[Composition] @'fmap' (f . g) == 'fmap' f . 'fmap' g@ + +Note, that the second law follows from the free theorem of the type 'fmap' and +the first law, so you need only check that the former condition holds. +See or + +for an explanation. +-} + +class Functor f where + -- | 'fmap' is used to apply a function of type @(a -> b)@ to a value of type @f a@, + -- where f is a functor, to produce a value of type @f b at . + -- Note that for any type constructor with more than one parameter (e.g., `Either`), + -- only the last type parameter can be modified with `fmap` (e.g., `b` in `Either a b`). + -- + -- Some type constructors with two parameters or more have a @'Data.Bifunctor'@ instance that allows + -- both the last and the penultimate parameters to be mapped over. + -- + -- ==== __Examples__ + -- + -- Convert from a @'Data.Maybe.Maybe' Int@ to a @Maybe String@ + -- using 'Prelude.show': + -- + -- >>> fmap show Nothing + -- Nothing + -- >>> fmap show (Just 3) + -- Just "3" + -- + -- Convert from an @'Data.Either.Either' Int Int@ to an + -- @Either Int String@ using 'Prelude.show': + -- + -- >>> fmap show (Left 17) + -- Left 17 + -- >>> fmap show (Right 17) + -- Right "17" + -- + -- Double each element of a list: + -- + -- >>> fmap (*2) [1,2,3] + -- [2,4,6] + -- + -- Apply 'Prelude.even' to the second element of a pair: + -- + -- >>> fmap even (2,2) + -- (2,True) + -- + -- It may seem surprising that the function is only applied to the last element of the tuple + -- compared to the list example above which applies it to every element in the list. + -- To understand, remember that tuples are type constructors with multiple type parameters: + -- a tuple of 3 elements @(a,b,c)@ can also be written @(,,) a b c@ and its @Functor@ instance + -- is defined for @Functor ((,,) a b)@ (i.e., only the third parameter is free to be mapped over + -- with @fmap@). + -- + -- It explains why @fmap@ can be used with tuples containing values of different types as in the + -- following example: + -- + -- >>> fmap even ("hello", 1.0, 4) + -- ("hello",1.0,True) + + fmap :: (a -> b) -> f a -> f b + + -- | Replace all locations in the input with the same value. + -- The default definition is @'fmap' . 'const'@, but this may be + -- overridden with a more efficient version. + -- + -- ==== __Examples__ + -- + -- Perform a computation with 'Maybe' and replace the result with a + -- constant value if it is 'Just': + -- + -- >>> 'a' <$ Just 2 + -- Just 'a' + -- >>> 'a' <$ Nothing + -- Nothing + (<$) :: a -> f b -> f a + (<$) = fmap . const + +-- | A functor with application, providing operations to +-- +-- * embed pure expressions ('pure'), and +-- +-- * sequence computations and combine their results ('<*>' and 'liftA2'). +-- +-- A minimal complete definition must include implementations of 'pure' +-- and of either '<*>' or 'liftA2'. If it defines both, then they must behave +-- the same as their default definitions: +-- +-- @('<*>') = 'liftA2' 'id'@ +-- +-- @'liftA2' f x y = f 'Prelude.<$>' x '<*>' y@ +-- +-- Further, any definition must satisfy the following: +-- +-- [Identity] +-- +-- @'pure' 'id' '<*>' v = v@ +-- +-- [Composition] +-- +-- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ +-- +-- [Homomorphism] +-- +-- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ +-- +-- [Interchange] +-- +-- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ +-- +-- +-- The other methods have the following default definitions, which may +-- be overridden with equivalent specialized implementations: +-- +-- * @u '*>' v = ('id' '<$' u) '<*>' v@ +-- +-- * @u '<*' v = 'liftA2' 'const' u v@ +-- +-- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy +-- +-- * @'fmap' f x = 'pure' f '<*>' x@ +-- +-- +-- It may be useful to note that supposing +-- +-- @forall x y. p (q x y) = f x . g y@ +-- +-- it follows from the above that +-- +-- @'liftA2' p ('liftA2' q u v) = 'liftA2' f u . 'liftA2' g v@ +-- +-- +-- If @f@ is also a 'Monad', it should satisfy +-- +-- * @'pure' = 'return'@ +-- +-- * @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ +-- +-- * @('*>') = ('>>')@ +-- +-- (which implies that 'pure' and '<*>' satisfy the applicative functor laws). + +class Functor f => Applicative f where + {-# MINIMAL pure, ((<*>) | liftA2) #-} + -- | Lift a value. + pure :: a -> f a + + -- | Sequential application. + -- + -- A few functors support an implementation of '<*>' that is more + -- efficient than the default one. + -- + -- ==== __Example__ + -- Used in combination with @('<$>')@, @('<*>')@ can be used to build a record. + -- + -- >>> data MyState = MyState {arg1 :: Foo, arg2 :: Bar, arg3 :: Baz} + -- + -- >>> produceFoo :: Applicative f => f Foo + -- + -- >>> produceBar :: Applicative f => f Bar + -- >>> produceBaz :: Applicative f => f Baz + -- + -- >>> mkState :: Applicative f => f MyState + -- >>> mkState = MyState <$> produceFoo <*> produceBar <*> produceBaz + (<*>) :: f (a -> b) -> f a -> f b + (<*>) = liftA2 id + + -- | Lift a binary function to actions. + -- + -- Some functors support an implementation of 'liftA2' that is more + -- efficient than the default one. In particular, if 'fmap' is an + -- expensive operation, it is likely better to use 'liftA2' than to + -- 'fmap' over the structure and then use '<*>'. + -- + -- This became a typeclass method in 4.10.0.0. Prior to that, it was + -- a function defined in terms of '<*>' and 'fmap'. + -- + -- ==== __Example__ + -- >>> liftA2 (,) (Just 3) (Just 5) + -- Just (3,5) + + liftA2 :: (a -> b -> c) -> f a -> f b -> f c + liftA2 f x = (<*>) (fmap f x) + + -- | Sequence actions, discarding the value of the first argument. + -- + -- ==== __Examples__ + -- If used in conjunction with the Applicative instance for 'Maybe', + -- you can chain Maybe computations, with a possible "early return" + -- in case of 'Nothing'. + -- + -- >>> Just 2 *> Just 3 + -- Just 3 + -- + -- >>> Nothing *> Just 3 + -- Nothing + -- + -- Of course a more interesting use case would be to have effectful + -- computations instead of just returning pure values. + -- + -- >>> import Data.Char + -- >>> import Text.ParserCombinators.ReadP + -- >>> let p = string "my name is " *> munch1 isAlpha <* eof + -- >>> readP_to_S p "my name is Simon" + -- [("Simon","")] + + (*>) :: f a -> f b -> f b + a1 *> a2 = (id <$ a1) <*> a2 + + -- This is essentially the same as liftA2 (flip const), but if the + -- Functor instance has an optimized (<$), it may be better to use + -- that instead. Before liftA2 became a method, this definition + -- was strictly better, but now it depends on the functor. For a + -- functor supporting a sharing-enhancing (<$), this definition + -- may reduce allocation by preventing a1 from ever being fully + -- realized. In an implementation with a boring (<$) but an optimizing + -- liftA2, it would likely be better to define (*>) using liftA2. + + -- | Sequence actions, discarding the value of the second argument. + -- + (<*) :: f a -> f b -> f a + (<*) = liftA2 const + +{- | The 'Monad' class defines the basic operations over a /monad/, +a concept from a branch of mathematics known as /category theory/. +From the perspective of a Haskell programmer, however, it is best to +think of a monad as an /abstract datatype/ of actions. +Haskell's @do@ expressions provide a convenient syntax for writing +monadic expressions. + +Instances of 'Monad' should satisfy the following: + +[Left identity] @'return' a '>>=' k = k a@ +[Right identity] @m '>>=' 'return' = m@ +[Associativity] @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ + +Furthermore, the 'Monad' and 'Applicative' operations should relate as follows: + +* @'pure' = 'return'@ +* @m1 '<*>' m2 = m1 '>>=' (\\x1 -> m2 '>>=' (\\x2 -> 'return' (x1 x2)))@ + +The above laws imply: + +* @'fmap' f xs = xs '>>=' 'return' . f@ +* @('>>') = ('*>')@ + +and that 'pure' and ('<*>') satisfy the applicative functor laws. + +The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' +defined in the "Prelude" satisfy these laws. +-} +class Applicative m => Monad m where + -- | Sequentially compose two actions, passing any value produced + -- by the first as an argument to the second. + -- + -- \'@as '>>=' bs@\' can be understood as the @do@ expression + -- + -- @ + -- do a <- as + -- bs a + -- @ + (>>=) :: forall a b. m a -> (a -> m b) -> m b + + -- | Sequentially compose two actions, discarding any value produced + -- by the first, like sequencing operators (such as the semicolon) + -- in imperative languages. + -- + -- \'@as '>>' bs@\' can be understood as the @do@ expression + -- + -- @ + -- do as + -- bs + -- @ + (>>) :: forall a b. m a -> m b -> m b + m >> k = m >>= \_ -> k -- See Note [Recursive bindings for Applicative/Monad] + {-# INLINE (>>) #-} + + -- | Inject a value into the monadic type. + return :: a -> m a + return = pure + +-- | @since 4.15 +instance Applicative Solo where + pure = MkSolo + + -- Note: we really want to match strictly here. This lets us write, + -- for example, + -- + -- forceSpine :: Foldable f => f a -> () + -- forceSpine xs + -- | MkSolo r <- traverse_ MkSolo xs + -- = r + MkSolo f <*> MkSolo x = MkSolo (f x) + liftA2 f (MkSolo x) (MkSolo y) = MkSolo (f x y) + +-- | For tuples, the 'Monoid' constraint on @a@ determines +-- how the first values merge. +-- For example, 'String's concatenate: +-- +-- > ("hello ", (+15)) <*> ("world!", 2002) +-- > ("hello world!",2017) +-- +-- @since 2.01 +instance Monoid a => Applicative ((,) a) where + pure x = (mempty, x) + (u, f) <*> (v, x) = (u <> v, f x) + liftA2 f (u, x) (v, y) = (u <> v, f x y) + +-- | @since 4.15 +instance Monad Solo where + MkSolo x >>= f = f x + +-- | @since 4.9.0.0 +instance Monoid a => Monad ((,) a) where + (u, a) >>= k = case k a of (v, b) -> (u <> v, b) + +-- | @since 4.14.0.0 +instance Functor ((,,) a b) where + fmap f (a, b, c) = (a, b, f c) + +-- | @since 4.14.0.0 +instance (Monoid a, Monoid b) => Applicative ((,,) a b) where + pure x = (mempty, mempty, x) + (a, b, f) <*> (a', b', x) = (a <> a', b <> b', f x) + +-- | @since 4.14.0.0 +instance (Monoid a, Monoid b) => Monad ((,,) a b) where + (u, v, a) >>= k = case k a of (u', v', b) -> (u <> u', v <> v', b) + +-- | @since 4.14.0.0 +instance Functor ((,,,) a b c) where + fmap f (a, b, c, d) = (a, b, c, f d) + +-- | @since 4.14.0.0 +instance (Monoid a, Monoid b, Monoid c) => Applicative ((,,,) a b c) where + pure x = (mempty, mempty, mempty, x) + (a, b, c, f) <*> (a', b', c', x) = (a <> a', b <> b', c <> c', f x) + +-- | @since 4.14.0.0 +instance (Monoid a, Monoid b, Monoid c) => Monad ((,,,) a b c) where + (u, v, w, a) >>= k = case k a of (u', v', w', b) -> (u <> u', v <> v', w <> w', b) + +-- | @since 4.18.0.0 +instance Functor ((,,,,) a b c d) where + fmap f (a, b, c, d, e) = (a, b, c, d, f e) + +-- | @since 4.18.0.0 +instance Functor ((,,,,,) a b c d e) where + fmap fun (a, b, c, d, e, f) = (a, b, c, d, e, fun f) + +-- | @since 4.18.0.0 +instance Functor ((,,,,,,) a b c d e f) where + fmap fun (a, b, c, d, e, f, g) = (a, b, c, d, e, f, fun g) + +-- | A variant of '<*>' with the arguments reversed. +-- +(<**>) :: Applicative f => f a -> f (a -> b) -> f b +(<**>) = liftA2 (\a f -> f a) +-- Don't use $ here, see the note at the top of the page + +-- | Lift a function to actions. +-- Equivalent to Functor's `fmap` but implemented using only `Applicative`'s methods: +-- @'liftA' f a = 'pure' f '<*>' a@ +-- +-- As such this function may be used to implement a `Functor` instance from an `Applicative` one. +-- +-- ==== __Examples__ +-- Using the Applicative instance for Lists: +-- +-- >>> liftA (+1) [1, 2] +-- [2,3] +-- +-- Or the Applicative instance for 'Maybe' +-- +-- >>> liftA (+1) (Just 3) +-- Just 4 + +liftA :: Applicative f => (a -> b) -> f a -> f b +liftA f a = pure f <*> a +-- Caution: since this may be used for `fmap`, we can't use the obvious +-- definition of liftA = fmap. + +-- | Lift a ternary function to actions. + +liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d +liftA3 f a b c = liftA2 f a b <*> c + + +{-# INLINABLE liftA #-} +{-# SPECIALISE liftA :: (a1->r) -> IO a1 -> IO r #-} +{-# SPECIALISE liftA :: (a1->r) -> Maybe a1 -> Maybe r #-} +{-# INLINABLE liftA3 #-} +{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} +{-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> + Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} + +-- | The 'join' function is the conventional monad join operator. It +-- is used to remove one level of monadic structure, projecting its +-- bound argument into the outer level. +-- +-- +-- \'@'join' bss@\' can be understood as the @do@ expression +-- +-- @ +-- do bs <- bss +-- bs +-- @ +-- +-- ==== __Examples__ +-- +-- A common use of 'join' is to run an 'IO' computation returned from +-- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions +-- can't perform 'IO' directly. Recall that +-- +-- @ +-- 'GHC.Conc.atomically' :: STM a -> IO a +-- @ +-- +-- is used to run 'GHC.Conc.STM' transactions atomically. So, by +-- specializing the types of 'GHC.Conc.atomically' and 'join' to +-- +-- @ +-- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b) +-- 'join' :: IO (IO b) -> IO b +-- @ +-- +-- we can compose them as +-- +-- @ +-- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b +-- @ +-- +-- to run an 'GHC.Conc.STM' transaction and the 'IO' action it +-- returns. +join :: (Monad m) => m (m a) -> m a +join x = x >>= id + + +{- Note [Recursive bindings for Applicative/Monad] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The original Applicative/Monad proposal stated that after +implementation, the designated implementation of (>>) would become + + (>>) :: forall a b. m a -> m b -> m b + (>>) = (*>) + +by default. You might be inclined to change this to reflect the stated +proposal, but you really shouldn't! Why? Because people tend to define +such instances the /other/ way around: in particular, it is perfectly +legitimate to define an instance of Applicative (*>) in terms of (>>), +which would lead to an infinite loop for the default implementation of +Monad! And people do this in the wild. + +This turned into a nasty bug that was tricky to track down, and rather +than eliminate it everywhere upstream, it's easier to just retain the +original default. + +-} + +-- | Same as '>>=', but with the arguments interchanged. +{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-} +(=<<) :: Monad m => (a -> m b) -> m a -> m b +f =<< x = x >>= f + +-- | Conditional execution of 'Applicative' expressions. For example, +-- +-- > when debug (putStrLn "Debugging") +-- +-- will output the string @Debugging@ if the Boolean value @debug@ +-- is 'True', and otherwise do nothing. +when :: (Applicative f) => Bool -> f () -> f () +{-# INLINABLE when #-} +{-# SPECIALISE when :: Bool -> IO () -> IO () #-} +{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} +when p s = if p then s else pure () + +-- | Evaluate each action in the sequence from left to right, +-- and collect the results. +sequence :: Monad m => [m a] -> m [a] +{-# INLINE sequence #-} +sequence = mapM id +-- Note: [sequence and mapM] + +-- | @'mapM' f@ is equivalent to @'sequence' . 'map' f at . +mapM :: Monad m => (a -> m b) -> [a] -> m [b] +{-# INLINE mapM #-} +mapM f as = foldr k (return []) as + where + k a r = do { x <- f a; xs <- r; return (x:xs) } + +{- +Note: [sequence and mapM] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Originally, we defined + +mapM f = sequence . map f + +This relied on list fusion to produce efficient code for mapM, and led to +excessive allocation in cryptarithm2. Defining + +sequence = mapM id + +relies only on inlining a tiny function (id) and beta reduction, which tends to +be a more reliable aspect of simplification. Indeed, this does not lead to +similar problems in nofib. +-} + +-- | Promote a function to a monad. +liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r +liftM f m1 = do { x1 <- m1; return (f x1) } + +-- | Promote a function to a monad, scanning the monadic arguments from +-- left to right. For example, +-- +-- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] +-- > liftM2 (+) (Just 1) Nothing = Nothing +-- +liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r +liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) } +-- Caution: since this may be used for `liftA2`, we can't use the obvious +-- definition of liftM2 = liftA2. + +-- | Promote a function to a monad, scanning the monadic arguments from +-- left to right (cf. 'liftM2'). +liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r +liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) } + +-- | Promote a function to a monad, scanning the monadic arguments from +-- left to right (cf. 'liftM2'). +liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r +liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) } + +-- | Promote a function to a monad, scanning the monadic arguments from +-- left to right (cf. 'liftM2'). +liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r +liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) } + +{-# INLINABLE liftM #-} +{-# SPECIALISE liftM :: (a1->r) -> IO a1 -> IO r #-} +{-# SPECIALISE liftM :: (a1->r) -> Maybe a1 -> Maybe r #-} +{-# INLINABLE liftM2 #-} +{-# SPECIALISE liftM2 :: (a1->a2->r) -> IO a1 -> IO a2 -> IO r #-} +{-# SPECIALISE liftM2 :: (a1->a2->r) -> Maybe a1 -> Maybe a2 -> Maybe r #-} +{-# INLINABLE liftM3 #-} +{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> IO a1 -> IO a2 -> IO a3 -> IO r #-} +{-# SPECIALISE liftM3 :: (a1->a2->a3->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} +{-# INLINABLE liftM4 #-} +{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO r #-} +{-# SPECIALISE liftM4 :: (a1->a2->a3->a4->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe r #-} +{-# INLINABLE liftM5 #-} +{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> IO a1 -> IO a2 -> IO a3 -> IO a4 -> IO a5 -> IO r #-} +{-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe a5 -> Maybe r #-} + +{- | In many situations, the 'liftM' operations can be replaced by uses of +'ap', which promotes function application. + +> return f `ap` x1 `ap` ... `ap` xn + +is equivalent to + +> liftMn f x1 x2 ... xn + +-} + +ap :: (Monad m) => m (a -> b) -> m a -> m b +ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } +-- Since many Applicative instances define (<*>) = ap, we +-- cannot define ap = (<*>) +{-# INLINABLE ap #-} +{-# SPECIALISE ap :: IO (a -> b) -> IO a -> IO b #-} +{-# SPECIALISE ap :: Maybe (a -> b) -> Maybe a -> Maybe b #-} + +-- instances for Prelude types + +-- | @since 2.01 +instance Functor ((->) r) where + fmap = (.) + +-- | @since 2.01 +instance Applicative ((->) r) where + pure = const + (<*>) f g x = f x (g x) + liftA2 q f g x = q (f x) (g x) + +-- | @since 2.01 +instance Monad ((->) r) where + f >>= k = \ r -> k (f r) r + +-- | @since 4.15 +instance Functor Solo where + fmap f (MkSolo a) = MkSolo (f a) + + -- Being strict in the `Solo` argument here seems most consistent + -- with the concept behind `Solo`: always strict in the wrapper and lazy + -- in the contents. + x <$ MkSolo _ = MkSolo x + +-- | @since 2.01 +instance Functor ((,) a) where + fmap f (x,y) = (x, f y) + +-- | @since 2.01 +instance Functor Maybe where + fmap _ Nothing = Nothing + fmap f (Just a) = Just (f a) + +-- | @since 2.01 +instance Applicative Maybe where + pure = Just + + Just f <*> m = fmap f m + Nothing <*> _m = Nothing + + liftA2 f (Just x) (Just y) = Just (f x y) + liftA2 _ _ _ = Nothing + + Just _m1 *> m2 = m2 + Nothing *> _m2 = Nothing + +-- | @since 2.01 +instance Monad Maybe where + (Just x) >>= k = k x + Nothing >>= _ = Nothing + + (>>) = (*>) + +-- | @since 2.01 +instance Functor [] where + {-# INLINE fmap #-} + fmap = map + +-- See Note: [List comprehensions and inlining] +-- | @since 2.01 +instance Applicative [] where + {-# INLINE pure #-} + pure x = [x] + {-# INLINE (<*>) #-} + fs <*> xs = [f x | f <- fs, x <- xs] + {-# INLINE liftA2 #-} + liftA2 f xs ys = [f x y | x <- xs, y <- ys] + {-# INLINE (*>) #-} + xs *> ys = [y | _ <- xs, y <- ys] + +-- See Note: [List comprehensions and inlining] +-- | @since 2.01 +instance Monad [] where + {-# INLINE (>>=) #-} + xs >>= f = [y | x <- xs, y <- f x] + {-# INLINE (>>) #-} + (>>) = (*>) + +-- | Combines lists by concatenation, starting from the empty list. +-- +-- @since 2.01 +instance Alternative [] where + empty = [] + (<|>) = (++) +-- | @since 4.9.0.0 +instance Functor NonEmpty where + fmap f ~(a :| as) = f a :| fmap f as + b <$ ~(_ :| as) = b :| (b <$ as) + +-- | @since 4.9.0.0 +instance Applicative NonEmpty where + pure a = a :| [] + (<*>) = ap + liftA2 = liftM2 + +-- | @since 4.9.0.0 +instance Monad NonEmpty where + ~(a :| as) >>= f = b :| (bs ++ bs') + where b :| bs = f a + bs' = as >>= toList . f + toList ~(c :| cs) = c : cs + +-- | A monoid on applicative functors. +-- +-- If defined, 'some' and 'many' should be the least solutions +-- of the equations: +-- +-- * @'some' v = (:) 'Prelude.<$>' v '<*>' 'many' v@ +-- +-- * @'many' v = 'some' v '<|>' 'pure' []@ +class Applicative f => Alternative f where + -- | The identity of '<|>' + empty :: f a + -- | An associative binary operation + (<|>) :: f a -> f a -> f a + + -- | One or more. + some :: f a -> f [a] + some v = some_v + where + many_v = some_v <|> pure [] + some_v = liftA2 (:) v many_v + + -- | Zero or more. + many :: f a -> f [a] + many v = many_v + where + many_v = some_v <|> pure [] + some_v = liftA2 (:) v many_v + + +-- | Picks the leftmost 'Just' value, or, alternatively, 'Nothing'. +-- +-- @since 2.01 +instance Alternative Maybe where + empty = Nothing + Nothing <|> r = r + l <|> _ = l + +-- ----------------------------------------------------------------------------- +-- The MonadPlus class definition + +-- | Monads that also support choice and failure. +class (Alternative m, Monad m) => MonadPlus m where + -- | The identity of 'mplus'. It should also satisfy the equations + -- + -- > mzero >>= f = mzero + -- > v >> mzero = mzero + -- + -- The default definition is + -- + -- @ + -- mzero = 'empty' + -- @ + mzero :: m a + mzero = empty + + -- | An associative operation. The default definition is + -- + -- @ + -- mplus = ('<|>') + -- @ + mplus :: m a -> m a -> m a + mplus = (<|>) + +-- | Picks the leftmost 'Just' value, or, alternatively, 'Nothing'. +-- +-- @since 2.01 +instance MonadPlus Maybe + +-- | Combines lists by concatenation, starting from the empty list. +-- +-- @since 2.01 +instance MonadPlus [] + +---------------------------------------------- +-- Functor/Applicative/Monad instances for IO +---------------------------------------------- + +-- | @since 2.01 +instance Functor IO where + fmap f x = x >>= (pure . f) + +-- | @since 2.01 +instance Applicative IO where + {-# INLINE pure #-} + {-# INLINE (*>) #-} + {-# INLINE liftA2 #-} + pure = returnIO + (*>) = thenIO + (<*>) = ap + liftA2 = liftM2 + +-- | @since 2.01 +instance Monad IO where + {-# INLINE (>>) #-} + {-# INLINE (>>=) #-} + (>>) = (*>) + (>>=) = bindIO + +-- | Takes the first non-throwing 'IO' action\'s result. +-- 'empty' throws an exception. +-- +-- @since 4.9.0.0 +instance Alternative IO where + empty = failIO "mzero" + (<|>) = mplusIO + +-- | Takes the first non-throwing 'IO' action\'s result. +-- 'mzero' throws an exception. +-- +-- @since 4.9.0.0 +instance MonadPlus IO + +returnIO :: a -> IO a +returnIO x = IO (\ s -> (# s, x #)) + +bindIO :: IO a -> (a -> IO b) -> IO b +bindIO (IO m) k = IO (\ s -> case m s of (# new_s, a #) -> unIO (k a) new_s) + +thenIO :: IO a -> IO b -> IO b +thenIO (IO m) k = IO (\ s -> case m s of (# new_s, _ #) -> unIO k new_s) + +-- Note that it is import that we do not SOURCE import this as +-- its demand signature encodes knowledge of its bottoming +-- behavior, which can expose useful simplifications. See +-- #16588. +failIO :: String -> IO a +failIO s = IO (raiseIO# (mkUserError s)) + +unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #)) +unIO (IO a) = a + ===================================== libraries/base/GHC/Base/List.hs ===================================== @@ -0,0 +1,233 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE MagicHash #-} + +-- -Wno-orphans is needed for things like: +-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_HADDOCK not-home #-} + +module GHC.Base.List + ( foldr + , build + , augment + , map + , mapFB + , (++) + ) where + +import GHC.CString +import GHC.Base.FunOps ((.)) +import GHC.Prim (coerce) + +infixr 5 ++ + +-- | 'foldr', applied to a binary operator, a starting value (typically +-- the right-identity of the operator), and a list, reduces the list +-- using the binary operator, from right to left: +-- +-- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) + +foldr :: (a -> b -> b) -> b -> [a] -> b +-- foldr _ z [] = z +-- foldr f z (x:xs) = f x (foldr f z xs) +{-# INLINE [0] foldr #-} +-- Inline only in the final stage, after the foldr/cons rule has had a chance +-- Also note that we inline it when it has *two* parameters, which are the +-- ones we are keen about specialising! +foldr k z = go + where + go [] = z + go (y:ys) = y `k` go ys + +-- | A list producer that can be fused with 'foldr'. +-- This function is merely +-- +-- > build g = g (:) [] +-- +-- but GHC's simplifier will transform an expression of the form +-- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@, +-- which avoids producing an intermediate list. + +build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] +{-# INLINE [1] build #-} + -- The INLINE is important, even though build is tiny, + -- because it prevents [] getting inlined in the version that + -- appears in the interface file. If [] *is* inlined, it + -- won't match with [] appearing in rules in an importing module. + -- + -- The "1" says to inline in phase 1 + +build g = g (:) [] + +-- | A list producer that can be fused with 'foldr'. +-- This function is merely +-- +-- > augment g xs = g (:) xs +-- +-- but GHC's simplifier will transform an expression of the form +-- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to +-- @g k ('foldr' k z xs)@, which avoids producing an intermediate list. + +augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a] +{-# INLINE [1] augment #-} +augment g xs = g (:) xs + +{-# RULES +"fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) . + foldr k z (build g) = g k z + +"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . + foldr k z (augment g xs) = g k (foldr k z xs) + +"foldr/id" foldr (:) [] = \x -> x +"foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys + -- Only activate this from phase 1, because that's + -- when we disable the rule that expands (++) into foldr + +-- The foldr/cons rule looks nice, but it can give disastrously +-- bloated code when compiling +-- array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] +-- i.e. when there are very very long literal lists +-- So I've disabled it for now. We could have special cases +-- for short lists, I suppose. +-- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs) + +"foldr/single" forall k z x. foldr k z [x] = k x z +"foldr/nil" forall k z. foldr k z [] = z + +"foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) . + foldr k z (x:build g) = k x (g k z) + +"augment/build" forall (g::forall b. (a->b->b) -> b -> b) + (h::forall b. (a->b->b) -> b -> b) . + augment g (build h) = build (\c n -> g c (h c n)) +"augment/nil" forall (g::forall b. (a->b->b) -> b -> b) . + augment g [] = build g + #-} + +-- This rule is true, but not (I think) useful: +-- augment g (augment h t) = augment (\cn -> g c (h c n)) t + +---------------------------------------------- +-- map +---------------------------------------------- + +-- | \(\mathcal{O}(n)\). 'map' @f xs@ is the list obtained by applying @f@ to +-- each element of @xs@, i.e., +-- +-- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn] +-- > map f [x1, x2, ...] == [f x1, f x2, ...] +-- +-- >>> map (+1) [1, 2, 3] +-- [2,3,4] +map :: (a -> b) -> [a] -> [b] +{-# NOINLINE [0] map #-} + -- We want the RULEs "map" and "map/coerce" to fire first. + -- map is recursive, so won't inline anyway, + -- but saying so is more explicit, and silences warnings +map _ [] = [] +map f (x:xs) = f x : map f xs + +-- Note eta expanded +mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst +{-# INLINE [0] mapFB #-} -- See Note [Inline FB functions] in GHC.List +mapFB c f = \x ys -> c (f x) ys + +{- Note [The rules for map] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The rules for map work like this. + +* Up to (but not including) phase 1, we use the "map" rule to + rewrite all saturated applications of map with its build/fold + form, hoping for fusion to happen. + + In phase 1 and 0, we switch off that rule, inline build, and + switch on the "mapList" rule, which rewrites the foldr/mapFB + thing back into plain map. + + It's important that these two rules aren't both active at once + (along with build's unfolding) else we'd get an infinite loop + in the rules. Hence the activation control below. + +* This same pattern is followed by many other functions: + e.g. append, filter, iterate, repeat, etc. in GHC.List + + See also Note [Inline FB functions] in GHC.List + +* The "mapFB" rule optimises compositions of map + +* The "mapFB/id" rule gets rid of 'map id' calls. + You might think that (mapFB c id) will turn into c simply + when mapFB is inlined; but before that happens the "mapList" + rule turns + (foldr (mapFB (:) id) [] a + back into + map id + Which is not very clever. + +* Any similarity to the Functor laws for [] is expected. +-} + +{-# RULES +"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) +"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f +"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g) +"mapFB/id" forall c. mapFB c (\x -> x) = c + #-} + +-- See Breitner, Eisenberg, Peyton Jones, and Weirich, "Safe Zero-cost +-- Coercions for Haskell", section 6.5: +-- http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf + +{-# RULES "map/coerce" [1] map coerce = coerce #-} +-- See Note [Getting the map/coerce RULE to work] in GHC.Core.SimpleOpt + +---------------------------------------------- +-- append +---------------------------------------------- + +-- | Append two lists, i.e., +-- +-- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] +-- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] +-- +-- If the first list is not finite, the result is the first list. +-- +-- WARNING: This function takes linear time in the number of elements of the +-- first list. + +(++) :: [a] -> [a] -> [a] +{-# NOINLINE [2] (++) #-} + -- Give time for the RULEs for (++) to fire in InitialPhase + -- It's recursive, so won't inline anyway, + -- but saying so is more explicit +(++) [] ys = ys +(++) (x:xs) ys = x : xs ++ ys + +{-# RULES +"++/literal" forall x. (++) (unpackCString# x) = unpackAppendCString# x +"++/literal_utf8" forall x. (++) (unpackCStringUtf8# x) = unpackAppendCStringUtf8# x #-} + +{-# RULES +"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys + #-} + +-- Rules for C strings (the functions themselves are now in GHC.CString) +{-# RULES +"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) +"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a +"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n +"unpack-append-nil" forall a . unpackAppendCString# a [] = unpackCString# a + +"unpack-utf8" [~1] forall a . unpackCStringUtf8# a = build (unpackFoldrCStringUtf8# a) +"unpack-list-utf8" [1] forall a . unpackFoldrCStringUtf8# a (:) [] = unpackCStringUtf8# a +"unpack-append-utf8" forall a n . unpackFoldrCStringUtf8# a (:) n = unpackAppendCStringUtf8# a n +"unpack-append-nil-utf8" forall a . unpackAppendCStringUtf8# a [] = unpackCStringUtf8# a + +-- There's a built-in rule (in GHC.Core.Op.ConstantFold) for +-- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n + +-- See also the Note [String literals in GHC] in CString.hs + + #-} ===================================== libraries/base/GHC/Base/NonEmpty.hs ===================================== @@ -0,0 +1,32 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_HADDOCK not-home #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Base.NonEmpty +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- The 'NonEmpty' type. +-- +----------------------------------------------------------------------------- + +module GHC.Base.NonEmpty + ( NonEmpty(..) + ) where + +import GHC.Classes + +infixr 5 :| + +-- | Non-empty (and non-strict) list type. +-- +-- @since 4.9.0.0 +data NonEmpty a = a :| [a] + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + ) ===================================== libraries/base/GHC/Base/Semigroup.hs ===================================== @@ -0,0 +1,325 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE EmptyDataDeriving #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE Unsafe #-} + +-- -Wno-orphans is needed for things like: +-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_HADDOCK not-home #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Base.Semigroup +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- 'Monoid' and 'Semigroup' classes. +-- +----------------------------------------------------------------------------- + +module GHC.Base.Semigroup + ( Semigroup(..) + , Monoid(..) + ) where + +import GHC.Types +import GHC.Maybe +import GHC.Base.List (foldr, map, (++)) +import GHC.Base.NonEmpty +import GHC.Tuple (Solo (MkSolo)) -- Note [Depend on GHC.Tuple] +import {-# SOURCE #-} GHC.Real (Integral) +import {-# SOURCE #-} Data.Semigroup.Internal ( stimesDefault + , stimesMaybe + , stimesList + , stimesIdempotentMonoid + ) + +infixr 6 <> + +-- | The class of semigroups (types with an associative binary operation). +-- +-- Instances should satisfy the following: +-- +-- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ +-- +-- You can alternatively define `sconcat` instead of (`<>`), in which case the +-- laws are: +-- +-- [Unit]: @'sconcat' ('pure' x) = x@ +-- [Multiplication]: @'sconcat' ('join' xss) = 'sconcat' ('fmap' 'sconcat' xss)@ +-- +-- @since 4.9.0.0 +class Semigroup a where + -- | An associative operation. + -- + -- >>> [1,2,3] <> [4,5,6] + -- [1,2,3,4,5,6] + (<>) :: a -> a -> a + a <> b = sconcat (a :| [ b ]) + + -- | Reduce a non-empty list with '<>' + -- + -- The default definition should be sufficient, but this can be + -- overridden for efficiency. + -- + -- >>> import Data.List.NonEmpty (NonEmpty (..)) + -- >>> sconcat $ "Hello" :| [" ", "Haskell", "!"] + -- "Hello Haskell!" + sconcat :: NonEmpty a -> a + sconcat (a :| as) = go a as where + go b (c:cs) = b <> go c cs + go b [] = b + + -- | Repeat a value @n@ times. + -- + -- Given that this works on a 'Semigroup' it is allowed to fail if + -- you request 0 or fewer repetitions, and the default definition + -- will do so. + -- + -- By making this a member of the class, idempotent semigroups + -- and monoids can upgrade this to execute in \(\mathcal{O}(1)\) by + -- picking @stimes = 'Data.Semigroup.stimesIdempotent'@ or @stimes = + -- 'stimesIdempotentMonoid'@ respectively. + -- + -- >>> stimes 4 [1] + -- [1,1,1,1] + stimes :: Integral b => b -> a -> a + stimes = stimesDefault + + {-# MINIMAL (<>) | sconcat #-} + +-- | The class of monoids (types with an associative binary operation that +-- has an identity). Instances should satisfy the following: +-- +-- [Right identity] @x '<>' 'mempty' = x@ +-- [Left identity] @'mempty' '<>' x = x@ +-- [Associativity] @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law) +-- [Concatenation] @'mconcat' = 'foldr' ('<>') 'mempty'@ +-- +-- You can alternatively define `mconcat` instead of `mempty`, in which case the +-- laws are: +-- +-- [Unit]: @'mconcat' ('pure' x) = x@ +-- [Multiplication]: @'mconcat' ('join' xss) = 'mconcat' ('fmap' 'mconcat' xss)@ +-- [Subclass]: @'mconcat' ('toList' xs) = 'sconcat' xs@ +-- +-- The method names refer to the monoid of lists under concatenation, +-- but there are many other instances. +-- +-- Some types can be viewed as a monoid in more than one way, +-- e.g. both addition and multiplication on numbers. +-- In such cases we often define @newtype at s and make those instances +-- of 'Monoid', e.g. 'Data.Semigroup.Sum' and 'Data.Semigroup.Product'. +-- +-- __NOTE__: 'Semigroup' is a superclass of 'Monoid' since /base-4.11.0.0/. +class Semigroup a => Monoid a where + -- | Identity of 'mappend' + -- + -- >>> "Hello world" <> mempty + -- "Hello world" + mempty :: a + mempty = mconcat [] + {-# INLINE mempty #-} + + -- | An associative operation + -- + -- __NOTE__: This method is redundant and has the default + -- implementation @'mappend' = ('<>')@ since /base-4.11.0.0/. + -- Should it be implemented manually, since 'mappend' is a synonym for + -- ('<>'), it is expected that the two functions are defined the same + -- way. In a future GHC release 'mappend' will be removed from 'Monoid'. + mappend :: a -> a -> a + mappend = (<>) + {-# INLINE mappend #-} + + -- | Fold a list using the monoid. + -- + -- For most types, the default definition for 'mconcat' will be + -- used, but the function is included in the class definition so + -- that an optimized version can be provided for specific types. + -- + -- >>> mconcat ["Hello", " ", "Haskell", "!"] + -- "Hello Haskell!" + mconcat :: [a] -> a + mconcat = foldr mappend mempty + {-# INLINE mconcat #-} + -- INLINE in the hope of fusion with mconcat's argument (see !4890) + + {-# MINIMAL mempty | mconcat #-} + +-- | @since 4.9.0.0 +instance Semigroup [a] where + (<>) = (++) + {-# INLINE (<>) #-} + + stimes = stimesList + +-- | @since 2.01 +instance Monoid [a] where + {-# INLINE mempty #-} + mempty = [] + {-# INLINE mconcat #-} + mconcat xss = [x | xs <- xss, x <- xs] +-- See Note: [List comprehensions and inlining] + + +{- +Note: [List comprehensions and inlining] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The list monad operations are traditionally described in terms of concatMap: + +xs >>= f = concatMap f xs + +Similarly, mconcat for lists is just concat. Here in Base, however, we don't +have concatMap, and we'll refrain from adding it here so it won't have to be +hidden in imports. Instead, we use GHC's list comprehension desugaring +mechanism to define mconcat and the Applicative and Monad instances for lists. +We mark them INLINE because the inliner is not generally too keen to inline +build forms such as the ones these desugar to without our insistence. Defining +these using list comprehensions instead of foldr has an additional potential +benefit, as described in compiler/GHC/HsToCore/ListComp.hs: if optimizations +needed to make foldr/build forms efficient are turned off, we'll get reasonably +efficient translations anyway. +-} + +-- | @since 4.9.0.0 +instance Semigroup (NonEmpty a) where + (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) + +-- | @since 4.9.0.0 +instance Semigroup b => Semigroup (a -> b) where + f <> g = \x -> f x <> g x + stimes n f e = stimes n (f e) + +-- | @since 2.01 +instance Monoid b => Monoid (a -> b) where + mempty _ = mempty + -- If `b` has a specialised mconcat, use that, rather than the default + -- mconcat, which can be much less efficient. Inline in the hope that + -- it may result in list fusion. + mconcat = \fs x -> mconcat (map (\f -> f x) fs) + {-# INLINE mconcat #-} + +-- | @since 4.9.0.0 +instance Semigroup () where + _ <> _ = () + sconcat _ = () + stimes _ _ = () + +-- | @since 2.01 +instance Monoid () where + -- Should it be strict? + mempty = () + mconcat _ = () + +-- | @since 4.15 +instance Semigroup a => Semigroup (Solo a) where + MkSolo a <> MkSolo b = MkSolo (a <> b) + stimes n (MkSolo a) = MkSolo (stimes n a) + +-- | @since 4.15 +instance Monoid a => Monoid (Solo a) where + mempty = MkSolo mempty + +-- | @since 4.9.0.0 +instance (Semigroup a, Semigroup b) => Semigroup (a, b) where + (a,b) <> (a',b') = (a<>a',b<>b') + stimes n (a,b) = (stimes n a, stimes n b) + +-- | @since 2.01 +instance (Monoid a, Monoid b) => Monoid (a,b) where + mempty = (mempty, mempty) + +-- | @since 4.9.0.0 +instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where + (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') + stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c) + +-- | @since 2.01 +instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where + mempty = (mempty, mempty, mempty) + +-- | @since 4.9.0.0 +instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) + => Semigroup (a, b, c, d) where + (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') + stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d) + +-- | @since 2.01 +instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where + mempty = (mempty, mempty, mempty, mempty) + +-- | @since 4.9.0.0 +instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) + => Semigroup (a, b, c, d, e) where + (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') + stimes n (a,b,c,d,e) = + (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e) + +-- | @since 2.01 +instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => + Monoid (a,b,c,d,e) where + mempty = (mempty, mempty, mempty, mempty, mempty) + + +-- | @since 4.9.0.0 +instance Semigroup Ordering where + LT <> _ = LT + EQ <> y = y + GT <> _ = GT + + stimes = stimesIdempotentMonoid + +-- lexicographical ordering +-- | @since 2.01 +instance Monoid Ordering where + mempty = EQ + +-- | @since 4.9.0.0 +instance Semigroup a => Semigroup (Maybe a) where + Nothing <> b = b + a <> Nothing = a + Just a <> Just b = Just (a <> b) + + stimes = stimesMaybe + +-- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to +-- : \"Any semigroup @S@ may be +-- turned into a monoid simply by adjoining an element @e@ not in @S@ +-- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S at .\" +-- +-- /Since 4.11.0/: constraint on inner @a@ value generalised from +-- 'Monoid' to 'Semigroup'. +-- +-- @since 2.01 +instance Semigroup a => Monoid (Maybe a) where + mempty = Nothing + +-- | @since 4.10.0.0 +instance Semigroup a => Semigroup (IO a) where + -- Ideally we would define this as: + -- (<>) = liftA2 (<>) + -- but this would incur an import cycle. + IO f <> IO g = IO (\s0 -> + case f s0 of + (# s1, x #) -> + case g s1 of + (# s2, y #) -> (# s2, x <> y #)) + +-- | @since 4.9.0.0 +instance Monoid a => Monoid (IO a) where + mempty = IO (\s -> (# s, mempty #) ) + ===================================== libraries/base/GHC/Base.hs-boot → libraries/base/GHC/Base/Semigroup.hs-boot ===================================== @@ -1,9 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-} -module GHC.Base (Maybe, Semigroup, Monoid) where +module GHC.Base.Semigroup (Semigroup, Monoid) where -import GHC.Maybe (Maybe) -import GHC.Types () +import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base class Semigroup a class Monoid a + ===================================== libraries/base/GHC/Base/String.hs ===================================== @@ -0,0 +1,42 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} + +-- -Wno-orphans is needed for things like: +-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 +{-# OPTIONS_GHC -Wno-orphans #-} + +module GHC.Base.String + ( String + , unsafeChr + , ord + , eqString + ) where + +import GHC.Types (Char(..), Int(..), Bool(..)) +import GHC.Classes (Eq(..), (&&)) +import GHC.Prim (chr#, ord#) + +-- | A 'String' is a list of characters. String constants in Haskell are values +-- of type 'String'. +-- +-- See "Data.List" for operations on lists. +type String = [Char] + +unsafeChr :: Int -> Char +unsafeChr (I# i#) = C# (chr# i#) + +-- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'. +ord :: Char -> Int +ord (C# c#) = I# (ord# c#) + +-- | This 'String' equality predicate is used when desugaring +-- pattern-matches against strings. +eqString :: String -> String -> Bool +eqString [] [] = True +eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2 +eqString _ _ = False + +{-# RULES "eqString" (==) = eqString #-} +-- eqString also has a BuiltInRule in GHC.Core.Opt.ConstantFold: +-- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2 + ===================================== libraries/base/GHC/Base/Void.hs ===================================== @@ -0,0 +1,50 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE EmptyDataDeriving #-} + +module GHC.Base.Void + ( Void + , absurd + , vacuous + ) where + +import GHC.Classes +import GHC.Base.Functor +import GHC.Base.Semigroup + +-- | Uninhabited data type +-- +-- @since 4.8.0.0 +data Void deriving + ( Eq -- ^ @since 4.8.0.0 + , Ord -- ^ @since 4.8.0.0 + ) + +-- | @since 4.9.0.0 +instance Semigroup Void where + a <> _ = a + stimes _ a = a + +-- | Since 'Void' values logically don't exist, this witnesses the +-- logical reasoning tool of \"ex falso quodlibet\". +-- +-- >>> let x :: Either Void Int; x = Right 5 +-- >>> :{ +-- case x of +-- Right r -> r +-- Left l -> absurd l +-- :} +-- 5 +-- +-- @since 4.8.0.0 +absurd :: Void -> a +absurd a = case a of {} + +-- | If 'Void' is uninhabited then any 'Functor' that holds only +-- values of type 'Void' is holding no values. +-- It is implemented in terms of @fmap absurd at . +-- +-- @since 4.8.0.0 +vacuous :: Functor f => f Void -> f a +vacuous = fmap absurd + ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,109 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int + , int2Float + , word2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorFloat + , ceilingFloat + , truncateFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , eqFloat, gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , powerFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , word2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , eqDouble, gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , powerDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Internal + , stgFloatToWord32 + , stgWord32ToFloat + , stgDoubleToWord64 + , stgWord64ToDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Num.hs ===================================== @@ -18,7 +18,9 @@ module GHC.Num - ( module GHC.Num + ( Num(..) + , subtract + , quotRemInteger , module GHC.Num.Integer , module GHC.Num.Natural -- reexported for backward compatibility ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,68 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + , mkRationalWithExponentBase + , FractionalExponentBase(..) + ) where #include "MachDeps.h" ===================================== libraries/base/base.cabal ===================================== @@ -127,6 +127,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 @@ -151,6 +152,7 @@ Library Data.Proxy Data.Ratio Data.Semigroup + Data.Show Data.STRef Data.STRef.Lazy Data.STRef.Strict @@ -192,6 +194,13 @@ Library GHC.Arr GHC.ArrayArray GHC.Base + GHC.Base.FunOps + GHC.Base.Functor + GHC.Base.List + GHC.Base.NonEmpty + GHC.Base.Semigroup + GHC.Base.String + GHC.Base.Void GHC.Bits GHC.ByteOrder GHC.Char ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -20,7 +20,131 @@ -- -- The 'Integer' type. -module GHC.Num.Integer where +module GHC.Num.Integer + ( Integer(..) + , integerCheck + , integerCheck# + + -- * Useful constants + , integerZero + , integerOne + + -- * Conversion with... + -- ** 'Int' + , integerFromInt# + , integerFromInt + , integerToInt# + , integerToInt + -- ** 'BigNat' + , integerFromBigNat# + , integerFromBigNatNeg# + , integerFromBigNatSign# + , integerToBigNatSign# + , integerToBigNatClamp# + -- ** 'Word' + , integerFromWord# + , integerFromWord + , integerFromWordNeg# + , integerFromWordSign# + , integerToWord# + , integerToWord + -- ** 'Natural' + , integerFromNatural + , integerToNaturalClamp + , integerToNatural + , integerToNaturalThrow + -- ** 'Int64'/'Word64' + , integerFromInt64# + , integerFromWord64# + , integerToInt64# + , integerToWord64# + -- ** Floating-point + , integerDecodeDouble# + , integerEncodeDouble# + , integerEncodeDouble + , integerEncodeFloat# + -- ** 'Addr#' + , integerToAddr# + , integerToAddr + , integerFromAddr# + , integerFromAddr + -- ** Limbs + , integerFromWordList + , integerToMutableByteArray# + , integerToMutableByteArray + , integerFromByteArray# + , integerFromByteArray + + -- * Predicates + , integerIsNegative# + , integerIsNegative + , integerIsZero + , integerIsOne + + -- * Comparison + , integerNe + , integerEq + , integerLe + , integerLt + , integerGt + , integerGe + , integerEq# + , integerNe# + , integerGt# + , integerLe# + , integerLt# + , integerGe# + , integerCompare + + -- * Arithmetic + , integerSub + , integerAdd + , integerMul + , integerNegate + , integerAbs + , integerSignum + , integerSignum# + , integerQuotRem# + , integerQuotRem + , integerQuot + , integerRem + , integerDivMod# + , integerDivMod + , integerDiv + , integerMod + , integerGcd + , integerLcm + , integerSqr + , integerLog2# + , integerLog2 + , integerLogBaseWord# + , integerLogBaseWord + , integerLogBase# + , integerLogBase + , integerIsPowerOf2# + , integerGcde# + , integerGcde + , integerRecipMod# + , integerPowMod# + + -- * Bit operations + , integerPopCount# + , integerBit# + , integerBit + , integerTestBit# + , integerTestBit + , integerShiftR# + , integerShiftR + , integerShiftL# + , integerShiftL + , integerOr + , integerXor + , integerAnd + , integerComplement + + -- * Miscellaneous + , integerSizeInBase# + ) where #include "MachDeps.h" #include "WordSize.h" ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -8,7 +8,109 @@ #include "MachDeps.h" #include "WordSize.h" -module GHC.Num.Natural where +module GHC.Num.Natural + ( Natural(..) + , naturalCheck# + , naturalCheck + + -- * Useful constants + , naturalZero + , naturalOne + + -- * Predicates + , naturalIsZero + , naturalIsOne + , naturalIsPowerOf2# + + -- * Conversion with... + -- ** 'BigNat' + , naturalFromBigNat# + , naturalToBigNat# + -- ** 'Word' + , naturalFromWord# + , naturalFromWord2# + , naturalFromWord + , naturalToWord# + , naturalToWord + , naturalToWordClamp# + , naturalToWordClamp + , naturalToWordMaybe# + -- ** Limbs + , naturalFromWordList + , naturalToMutableByteArray# + , naturalFromByteArray# + -- ** Floating point + , naturalEncodeDouble# + , naturalEncodeFloat# + -- ** 'Addr#' + , naturalToAddr# + , naturalToAddr + , naturalFromAddr# + , naturalFromAddr + + -- * Comparison + , naturalEq# + , naturalEq + , naturalNe# + , naturalNe + , naturalGe# + , naturalGe + , naturalLe# + , naturalLe + , naturalGt# + , naturalGt + , naturalLt# + , naturalLt + , naturalCompare + + -- * Bit operations + , naturalPopCount# + , naturalPopCount + , naturalShiftR# + , naturalShiftR + , naturalShiftL# + , naturalShiftL + , naturalAnd + , naturalAndNot + , naturalOr + , naturalXor + , naturalTestBit# + , naturalTestBit + , naturalBit# + , naturalBit + , naturalSetBit# + , naturalSetBit + , naturalClearBit# + , naturalClearBit + , naturalComplementBit# + , naturalComplementBit + + -- * Arithmetic + , naturalAdd + , naturalSub + , naturalSubThrow + , naturalSubUnsafe + , naturalMul + , naturalSqr + , naturalSignum + , naturalNegate + , naturalQuotRem# + , naturalQuotRem + , naturalQuot + , naturalRem + , naturalGcd + , naturalLcm + , naturalLog2# + , naturalLog2 + , naturalLogBaseWord# + , naturalLogBaseWord + , naturalLogBase# + , naturalLogBase + , naturalPowMod + + -- * Miscellaneous + , naturalSizeInBase# + ) where import GHC.Prim import GHC.Types ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67252ef1ef1c18a5d6b0a2d4e9f910a56c248eef...84a92fad2e13a465b0fc852436e7f52bae5d4093 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67252ef1ef1c18a5d6b0a2d4e9f910a56c248eef...84a92fad2e13a465b0fc852436e7f52bae5d4093 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 21:33:29 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 19 May 2023 17:33:29 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 141 commits: Fix doc typos in libraries/base/GHC Message-ID: <6467eb29b7d08_9760a3bbe34e06504ef@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - 83a093d7 by Apoorv Ingle at 2023-05-19T16:19:52-05:00 Fixes for #18324 HsExpand for HsDo - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9481110439d9f905521848fccd8a6ba1055d97de...83a093d7b84e0c086513656a51093099ce92294a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9481110439d9f905521848fccd8a6ba1055d97de...83a093d7b84e0c086513656a51093099ce92294a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 21:37:09 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 May 2023 17:37:09 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Wibbles Message-ID: <6467ec05c8c8b_9760a23de0594650845@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 6aab8150 by Simon Peyton Jones at 2023-05-19T22:36:53+01:00 Wibbles - - - - - 23 changed files: - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Validity.hs - testsuite/tests/gadt/T3651.hs - testsuite/tests/gadt/T3651.stderr - testsuite/tests/gadt/T7558.hs - testsuite/tests/gadt/T7558.stderr - testsuite/tests/gadt/all.T - testsuite/tests/ghci/scripts/Defer02.stderr - testsuite/tests/indexed-types/should_fail/T13674.stderr - testsuite/tests/pmcheck/should_compile/T12957a.stderr - testsuite/tests/pmcheck/should_compile/T15450.hs - testsuite/tests/pmcheck/should_compile/T15450.stderr - testsuite/tests/typecheck/should_fail/GivenForallLoop.hs - testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr - testsuite/tests/typecheck/should_fail/T14325.hs - testsuite/tests/typecheck/should_fail/T14325.stderr - testsuite/tests/typecheck/should_fail/T20189.hs - testsuite/tests/typecheck/should_fail/T20189.stderr - testsuite/tests/typecheck/should_run/Defer01.hs Changes: ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Prelude import GHC.Core.Type import GHC.Core.Class +import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Types.Var @@ -262,12 +263,11 @@ isIPClass cls = cls `hasKey` ipClassKey -- | Decomposes a predicate if it is an implicit parameter. Does not look in -- superclasses. See also [Local implicit parameters]. -isIPPred_maybe :: Class -> [Type] -> Maybe (FastString, Type) +isIPPred_maybe :: Class -> [Type] -> Maybe (Type, Type) isIPPred_maybe cls tys | isIPClass cls , [t1,t2] <- tys - , Just x <- isStrLitTy t1 - = Just (x,t2) + = Just (t1,t2) | otherwise = Nothing @@ -311,29 +311,29 @@ isIPLikePred :: Type -> Bool -- See Note [Local implicit parameters] isIPLikePred pred = mentions_ip_pred initIPRecTc Nothing pred -mentionsIP :: FastString -> Class -> [Type] -> Bool --- Is (cls tys) an implicit parameter with string `fs`, or +mentionsIP :: Type -> Class -> [Type] -> Bool +-- Is (cls tys) an implicit parameter with key `str_ty`, or -- is any of its superclasses such at thing. -- See Note [Local implicit parameters] -mentionsIP fs cls tys = mentions_ip initIPRecTc (Just fs) cls tys +mentionsIP str_ty cls tys = mentions_ip initIPRecTc (Just str_ty) cls tys -mentions_ip :: RecTcChecker -> Maybe FastString -> Class -> [Type] -> Bool -mentions_ip rec_clss mb_fs cls tys - | Just (fs', _) <- isIPPred_maybe cls tys - = case mb_fs of +mentions_ip :: RecTcChecker -> Maybe Type -> Class -> [Type] -> Bool +mentions_ip rec_clss mb_str_ty cls tys + | Just (str_ty', _) <- isIPPred_maybe cls tys + = case mb_str_ty of Nothing -> True - Just fs -> fs == fs' + Just str_ty -> str_ty `eqType` str_ty' | otherwise - = or [ mentions_ip_pred rec_clss mb_fs (classMethodInstTy sc_sel_id tys) + = or [ mentions_ip_pred rec_clss mb_str_ty (classMethodInstTy sc_sel_id tys) | sc_sel_id <- classSCSelIds cls ] -mentions_ip_pred :: RecTcChecker -> Maybe FastString -> Type -> Bool -mentions_ip_pred rec_clss mb_fs ty +mentions_ip_pred :: RecTcChecker -> Maybe Type -> Type -> Bool +mentions_ip_pred rec_clss mb_str_ty ty | Just (cls, tys) <- getClassPredTys_maybe ty , let tc = classTyCon cls , Just rec_clss' <- if isTupleTyCon tc then Just rec_clss else checkRecTc rec_clss tc - = mentions_ip rec_clss' mb_fs cls tys + = mentions_ip rec_clss' mb_str_ty cls tys | otherwise = False -- Includes things like (D []) where D is -- a Constraint-ranged family; #7785 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1007,7 +1007,7 @@ simplifyAmbiguityCheck ty wanteds ; traceTc "End simplifyAmbiguityCheck }" empty - -- Normally report all errors; but with -XAllowAmbiguousTypes +{- -- Normally report all errors; but with -XAllowAmbiguousTypes -- report only insoluble ones, since they represent genuinely -- inaccessible code ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes @@ -1015,6 +1015,8 @@ simplifyAmbiguityCheck ty wanteds ; unless (allow_ambiguous && not (insolubleWC final_wc)) (discardResult (reportUnsolved final_wc)) ; traceTc "reportUnsolved(ambig) }" empty +-} + ; discardResult (reportUnsolved final_wc) ; return () } ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -212,6 +212,8 @@ in two places: with (?x::ty). See Note [Local implicit parameters] in GHC.Core.Predicate. An important special case is constraint tuples like [G] (% ?x::ty, Eq a ) + Example in #14218. + * Wrinkle (SIP2): we delete dictionaries in inert_dicts, but we don't need to look in inert_solved_dicts. They are never implicit parameters. See Note [Solved dictionaries] in GHC.Tc.Solver.InertSet @@ -347,36 +349,23 @@ I tried treating tuple constraints, such as (% Eq a, Show a %), rather like equality-class constraints (see Note [Solving equality classes]). That is, by eagerly decomposing tuple-constraints into their component (Eq a) and (Show a). -But discarding the tuple Given (which "replacing" does) means that -we may have to reconstruct it for a recursive call, and the optimiser isn't -quite clever enough to figure that out: see #10359 and its test case; and #23398. -This is less pressing for equality classes because they have to be unpacked -strictly, so CSE-ing away the reconstruction works fine. - - -(NC2) Because of this replacement, we don't need do the fancy footwork - of Note [Solving superclass constraints], so the computation of `sc_loc` - in `mk_strict_superclasses` can be simpler. - - For tuple predicates, this matters, because their size can be large, - and we don't want to add a big class to the size of the dictionaries - in the chain. When we get down to a base predicate, we'll include - its size. See #10335 - -And less obviously to: - -* Tuple classes. For reasons described in GHC.Tc.Solver.Types - Note [Shadowing of implicit parameters], we may have a constraint - [W] (?x::Int, C a) - with an exactly-matching Given constraint. We must decompose this - tuple and solve the components separately, otherwise we won't solve - it at all! It is perfectly safe to decompose it, because again the - superclasses invert the instance; e.g. - class (c1, c2) => (% c1, c2 %) - instance (c1, c2) => (% c1, c2 %) - Example in #14218 - -Examples: T5853, T10432, T5315, T9222, T2627b, T3028b +But discarding the tuple Given (which "replacing" does) means that we may +have to reconstruct it for a recursive call. For example + f :: (% Eq a, Show a %) => blah + f x = ....(f x').... +If we decomposed eagerly we'd get + f = \(d : (% Eq a, Show a %)). + let de = fst d + ds = snd d + in ....(f (% de, ds %))... +and the optimiser may not be clever enough to transform (f (% de, ds %)) into +(f d). See #10359 and its test case, and #23398. (This issue is less pressing for +equality classes because they have to be unpacked strictly, so CSE-ing away +the reconstruction works fine. + +So at the moment we don't decompose tuple constraints eagerly; instead we mostly +just treat them like other constraints. There is a bit of special treatment: +search for isCTupleClass. -} solveEqualityDict :: CtEvidence -> Class -> [Type] -> SolverStage Void @@ -912,7 +901,10 @@ matchClassInst dflags inerts clas tys loc -- whether top level, or local quantified constraints. -- See Note [Instance and Given overlap] | not (xopt LangExt.IncoherentInstances dflags) - , not (isCTupleClass clas) -- It is always safe to unpack constraint tuples + , not (isCTupleClass clas) + -- It is always safe to unpack constraint tuples + -- And if we don't do so, we may never solve it at all + -- See Note [Solving tuple constraints] , not (noMatchableGivenDicts inerts loc clas tys) = do { traceTcS "Delaying instance application" $ vcat [ text "Work item:" <+> pprClassPred clas tys ] @@ -938,16 +930,6 @@ matchClassInst dflags inerts clas tys loc where pred = mkClassPred clas tys -{- --- | If a class is "naturally coherent", then we needn't worry at all, in any --- way, about overlapping/incoherent instances. Just solve the thing! --- See Note [Naturally coherent classes] --- See also Note [The equality types story] in GHC.Builtin.Types.Prim. -naturallyCoherentClass :: Class -> Bool -naturallyCoherentClass cls - = isCTupleClass cls || isEqualityClass cls --} - {- Note [Instance and Given overlap] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Example, from the OutsideIn(X) paper: @@ -1027,82 +1009,6 @@ All of this is disgustingly delicate, so to discourage people from writing simplifiable class givens, we warn about signatures that contain them; see GHC.Tc.Validity Note [Simplifiable given constraints]. -Note [Naturally coherent classes] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A few built-in classes are "naturally coherent". This term means that -the "instance" for the class is bidirectional with its superclass(es). -For example, consider (~~), which behaves as if it was defined like -this: - class a ~# b => a ~~ b - instance a ~# b => a ~~ b -(See Note [The equality types story] in GHC.Builtin.Types.Prim.) - -PS: the term "naturally coherent" doesn't really seem helpful. -Perhaps "invertible" or "bidirectional" or something? I left it for -now though. - -For naturally coherent classes: - -(NC1) For Givens, when expanding the superclasses of a naturally coherent class, - we can /replace/ the constraint with its superclasses (which, remember, are - equally powerful) rather than /adding/ them. This can make a huge difference. - Consider T17836, which has a constraint like - forall b,c. a ~ (b,c) => - forall d,e. c ~ (d,e) => - ...etc... - If we just /add/ the superclasses of [G] g1:a ~ (b,c), we'll put - [G] g1:(a~(b,c)) in the inert set and emit [G] g2:a ~# (b,c). That will - kick out g1, and it'll be re-inserted as [G] g1':(b,c)~(b,c) which does - no good to anyone. When the implication is deeply nested, this has - quadratic cost, and no benefit. Just replace! - - Originally I tried this for all naturally-coherent classes, including - tuples. But discarding the tuple Given (which "replacing" does) means that - we may have to reconstruct it for a recursive call, and the optimiser isn't - quite clever enough to figure that out: see #10359 and its test case. - This is less pressing for equality classes because they have to be unpacked - strictly, so CSE-ing away the reconstuction works fine. Hence the use - of isEqualityClass rather than naturallyCoherentClass in canDictCt. - A bit ad-hoc. - -(NC2) Because of this replacement, we don't need do the fancy footwork - of Note [Solving superclass constraints], so the computation of `sc_loc` - in `mk_strict_superclasses` can be simpler. - - For tuple predicates, this matters, because their size can be large, - and we don't want to add a big class to the size of the dictionaries - in the chain. When we get down to a base predicate, we'll include - its size. See #10335 - -(NC3) Faced with [W] t1 ~ t2, it's always OK to reduce it to [W] t1 ~# t2, - without worrying about Note [Instance and Given overlap]. Why? Because - if we had [G] s1 ~ s2, then we'd get the superclass [G] s1 ~# s2, and - so the reduction of the [W] constraint does not risk losing any solutions. - - On the other hand, it can be fatal to /fail/ to reduce such equalities - on the grounds of Note [Instance and Given overlap], because many good - things flow from [W] t1 ~# t2. - -The same reasoning applies to - -* (~~) heqTyCon -* (~) eqTyCon -* Coercible coercibleTyCon - -And less obviously to: - -* Tuple classes. For reasons described in GHC.Tc.Solver.Types - Note [Shadowing of implicit parameters], we may have a constraint - [W] (?x::Int, C a) - with an exactly-matching Given constraint. We must decompose this - tuple and solve the components separately, otherwise we won't solve - it at all! It is perfectly safe to decompose it, because again the - superclasses invert the instance; e.g. - class (c1, c2) => (% c1, c2 %) - instance (c1, c2) => (% c1, c2 %) - Example in #14218 - -Examples: T5853, T10432, T5315, T9222, T2627b, T3028b Note [Local instances and incoherence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2093,10 +1999,14 @@ mk_strict_superclasses fuel rec_clss `App` (evId evar `mkVarApps` (tvs ++ dict_ids)) `mkVarApps` sc_tvs - sc_loc | isCTupleClass cls - = loc -- See (NC2) in Note [Naturally coherent classes] - | otherwise - = loc { ctl_origin = mk_sc_origin (ctLocOrigin loc) } + sc_loc | isCTupleClass cls = loc + | otherwise = loc { ctl_origin = mk_sc_origin (ctLocOrigin loc) } + -- isCTupleClass: we don't want tuples to mess up the size calculations + -- of Note [Solving superclass constraints]. For tuple predicates, this + -- matters, because their size can be large, and we don't want to add a + -- big class to the size of the dictionaries in the chain. When we get + -- down to a base predicate, we'll include its size. See #10335. + -- See Note [Solving tuple constraints] -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance -- for explanation of GivenSCOrigin and Note [Replacement vs keeping] in ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -79,7 +79,6 @@ import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Data.Maybe import GHC.Data.Bag -import GHC.Data.FastString import Data.List.NonEmpty ( NonEmpty(..), (<|) ) import qualified Data.List.NonEmpty as NE @@ -1326,14 +1325,14 @@ delDict (DictCt { di_cls = cls, di_tys = tys }) m delIPDict :: DictCt -> DictMap DictCt -> DictMap DictCt delIPDict dict@(DictCt { di_cls = cls, di_tys = tys }) dict_map - | Just (fs, _) <- isIPPred_maybe cls tys - = filterDicts (doesn't_match fs) dict_map + | Just (str_ty, _) <- isIPPred_maybe cls tys + = filterDicts (doesn't_match str_ty) dict_map | otherwise = pprPanic "delIPDict" (ppr dict) where - doesn't_match :: FastString -> DictCt -> Bool - doesn't_match fs (DictCt { di_cls = cls, di_tys = tys }) - = not (mentionsIP fs cls tys) + doesn't_match :: Type -> DictCt -> Bool + doesn't_match str_ty (DictCt { di_cls = cls, di_tys = tys }) + = not (mentionsIP str_ty cls tys) addDict :: DictCt -> DictMap DictCt -> DictMap DictCt addDict item@(DictCt { di_cls = cls, di_tys = tys }) dm ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -64,8 +64,7 @@ try_inert_irreds :: InertCans -> IrredCt -> TcS (StopOrContinue ()) try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) | let (matching_irreds, others) = findMatchingIrreds (inert_irreds inerts) ev_w - , ((irred_i, swap) : _rest) <- pprTrace "try_inert_irreds" (ppr ev_w $$ ppr matching_irreds) $ - bagToList matching_irreds + , ((irred_i, swap) : _rest) <- bagToList matching_irreds -- See Note [Multiple matching irreds] , let ev_i = irredCtEvidence irred_i ct_i = CIrredCan irred_i ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -233,20 +233,20 @@ so we can take their type variables into account as part of the checkAmbiguity :: UserTypeCtxt -> Type -> TcM () checkAmbiguity ctxt ty | wantAmbiguityCheck ctxt - = do { traceTc "Ambiguity check for" (ppr ty) + = do { traceTc "Ambiguity check for {" (ppr ty) -- Solve the constraints eagerly because an ambiguous type -- can cause a cascade of further errors. Since the free -- tyvars are skolemised, we can safely use tcSimplifyTop ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes ; unless allow_ambiguous $ do { (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $ - captureConstraints $ - tcSubTypeAmbiguity ctxt ty ty - -- See Note [Ambiguity check and deep subsumption] - -- in GHC.Tc.Utils.Unify - ; simplifyAmbiguityCheck ty wanted } + captureConstraints $ + tcSubTypeAmbiguity ctxt ty ty + -- See Note [Ambiguity check and deep subsumption] + -- in GHC.Tc.Utils.Unify + ; simplifyAmbiguityCheck ty wanted } - ; traceTc "Done ambiguity check for" (ppr ty) } + ; traceTc "} Done ambiguity check for" (ppr ty) } | otherwise = return () ===================================== testsuite/tests/gadt/T3651.hs ===================================== @@ -15,12 +15,12 @@ unsafe1 B U = () [G] a ~ () => [G] a ~ Bool => [W] Bool ~ a By the time we get to the Wanted we have: - inert: [G] a ~ Bool (CEqCan) - [G] () ~ Bool (CIrredCan) + inert: [G] a ~# Bool (CEqCan) + [G] () ~# Bool (CIrredCan) work: [W] Bool ~ a -We rewrite with the CEqCan to get [W] Bool ~ (), which is -insoluble, and which we decline to solve from [G] () ~ Bool +We rewrite with the CEqCan to get [W] Bool ~ (); we reduce that +to [W] Bool ~# (). That is insoluble, but we solve it from [G] () ~# Bool -} unsafe2 :: a ~ b => Z b -> Z a -> a ===================================== testsuite/tests/gadt/T3651.stderr ===================================== @@ -1,14 +1,33 @@ -T3651.hs:11:15: error: [GHC-83865] - • Couldn't match type ‘()’ with ‘Bool’ - Expected: a - Actual: () - • In the expression: () +T3651.hs:11:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘unsafe1’: unsafe1 B U = ... + +T3651.hs:11:11: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] + • Inaccessible code in + a pattern with constructor: U :: Z (), in an equation for ‘unsafe1’ + Couldn't match type ‘Bool’ with ‘()’ + • In the pattern: U In an equation for ‘unsafe1’: unsafe1 B U = () -T3651.hs:27:15: error: [GHC-83865] - • Couldn't match type ‘()’ with ‘Bool’ - Expected: a - Actual: () - • In the expression: () +T3651.hs:27:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘unsafe2’: unsafe2 B U = ... + +T3651.hs:27:11: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] + • Inaccessible code in + a pattern with constructor: U :: Z (), in an equation for ‘unsafe2’ + Couldn't match type ‘Bool’ with ‘()’ + • In the pattern: U In an equation for ‘unsafe2’: unsafe2 B U = () + +T3651.hs:30:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘unsafe3’: unsafe3 B U = ... + +T3651.hs:30:11: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] + • Inaccessible code in + a pattern with constructor: U :: Z (), in an equation for ‘unsafe3’ + Couldn't match type ‘Bool’ with ‘()’ + • In the pattern: U + In an equation for ‘unsafe3’: unsafe3 B U = True ===================================== testsuite/tests/gadt/T7558.hs ===================================== @@ -6,3 +6,11 @@ data T a b where f :: T a a -> Bool f (MkT x y) = [x,y] `seq` True + +{- We get + +[G] a ~ Maybe a +[W] a ~ Maybe a + +We can solve the Wanted from the Given +-} \ No newline at end of file ===================================== testsuite/tests/gadt/T7558.stderr ===================================== @@ -1,14 +1,19 @@ -T7558.hs:8:18: error: [GHC-25897] - • Couldn't match expected type ‘a’ with actual type ‘Maybe a’ +T7558.hs:8:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f (MkT x y) = ... + +T7558.hs:8:4: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] + • Inaccessible code in + a pattern with constructor: + MkT :: forall a b. (a ~ Maybe b) => a -> Maybe b -> T a b, + in an equation for ‘f’ + Couldn't match type ‘a’ with ‘Maybe a’ ‘a’ is a rigid type variable bound by the type signature for: f :: forall a. T a a -> Bool at T7558.hs:7:1-18 - • In the expression: y - In the first argument of ‘seq’, namely ‘[x, y]’ - In the expression: [x, y] `seq` True + • In the pattern: MkT x y + In an equation for ‘f’: f (MkT x y) = [x, y] `seq` True • Relevant bindings include - y :: Maybe a (bound at T7558.hs:8:10) - x :: a (bound at T7558.hs:8:8) f :: T a a -> Bool (bound at T7558.hs:8:1) ===================================== testsuite/tests/gadt/all.T ===================================== @@ -93,7 +93,7 @@ test('T2151', normal, compile, ['']) test('T3013', normal, compile, ['']) test('T3163', normal, compile_fail, ['']) test('gadt25', normal, compile, ['']) -test('T3651', normal, compile_fail, ['']) +test('T3651', normal, compile, ['']) test('T3638', normal, compile, ['']) test('gadtSyntax001', normal, compile, ['']) @@ -110,7 +110,7 @@ test('T7293', normal, compile_fail, ['-Werror']) test('T7294', normal, compile, ['']) test('T7321', [], makefile_test, []) test('T7974', normal, compile, ['']) -test('T7558', normal, compile_fail, ['']) +test('T7558', normal, compile, ['']) test('T9380', normal, compile_and_run, ['']) test('T12087', normal, compile_fail, ['']) test('T12468', normal, compile_fail, ['']) ===================================== testsuite/tests/ghci/scripts/Defer02.stderr ===================================== @@ -1,5 +1,5 @@ -Defer01.hs:11:40: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] +Defer01.hs:10:40: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match type ‘Char’ with ‘[Char]’ Expected: String Actual: Char @@ -7,16 +7,16 @@ Defer01.hs:11:40: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] In the second argument of ‘(>>)’, namely ‘putStr ','’ In the expression: putStr "Hello World" >> putStr ',' -Defer01.hs:14:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] +Defer01.hs:13:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘Char’ • In the expression: 'p' In an equation for ‘a’: a = 'p' -Defer01.hs:25:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)] +Defer01.hs:24:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)] Pattern match has inaccessible right hand side In an equation for ‘c’: c (C2 x) = ... -Defer01.hs:25:4: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] +Defer01.hs:24:4: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] • Inaccessible code in a pattern with constructor: C2 :: Bool -> C Bool, in an equation for ‘c’ @@ -24,49 +24,44 @@ Defer01.hs:25:4: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] • In the pattern: C2 x In an equation for ‘c’: c (C2 x) = True -Defer01.hs:31:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] +Defer01.hs:30:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Char -> t’ with actual type ‘Char’ • The function ‘e’ is applied to one value argument, but its type ‘Char’ has none In the expression: e 'q' In an equation for ‘f’: f = e 'q' - • Relevant bindings include f :: t (bound at Defer01.hs:31:1) + • Relevant bindings include f :: t (bound at Defer01.hs:30:1) -Defer01.hs:34:8: warning: [GHC-25897] [-Wdeferred-type-errors (in -Wdefault)] +Defer01.hs:33:8: warning: [GHC-25897] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Char’ with actual type ‘a’ ‘a’ is a rigid type variable bound by the type signature for: h :: forall a. a -> (Char, Char) - at Defer01.hs:33:1-21 + at Defer01.hs:32:1-21 • In the expression: x In the expression: (x, 'c') In an equation for ‘h’: h x = (x, 'c') • Relevant bindings include - x :: a (bound at Defer01.hs:34:3) - h :: a -> (Char, Char) (bound at Defer01.hs:34:1) + x :: a (bound at Defer01.hs:33:3) + h :: a -> (Char, Char) (bound at Defer01.hs:33:1) -Defer01.hs:39:17: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] +Defer01.hs:38:17: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Bool’ with actual type ‘T a’ • In the first argument of ‘not’, namely ‘(K a)’ In the first argument of ‘seq’, namely ‘(not (K a))’ In the expression: seq (not (K a)) () • Relevant bindings include - a :: a (bound at Defer01.hs:39:3) - i :: a -> () (bound at Defer01.hs:39:1) + a :: a (bound at Defer01.hs:38:3) + i :: a -> () (bound at Defer01.hs:38:1) -Defer01.hs:47:7: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match expected type ‘Bool’ with actual type ‘Int’ - • In the expression: x - In an equation for ‘k’: k x = x - -Defer01.hs:50:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] +Defer01.hs:49:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type: IO a0 with actual type: Char -> IO () • Probable cause: ‘putChar’ is applied to too few arguments In the first argument of ‘(>>)’, namely ‘putChar’ In the expression: putChar >> putChar 'p' In an equation for ‘l’: l = putChar >> putChar 'p' -*** Exception: Defer01.hs:11:40: error: [GHC-83865] +*** Exception: Defer01.hs:10:40: error: [GHC-83865] • Couldn't match type ‘Char’ with ‘[Char]’ Expected: String Actual: Char @@ -74,12 +69,12 @@ Defer01.hs:50:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] In the second argument of ‘(>>)’, namely ‘putStr ','’ In the expression: putStr "Hello World" >> putStr ',' (deferred type error) -*** Exception: Defer01.hs:14:5: error: [GHC-83865] +*** Exception: Defer01.hs:13:5: error: [GHC-83865] • Couldn't match expected type ‘Int’ with actual type ‘Char’ • In the expression: 'p' In an equation for ‘a’: a = 'p' (deferred type error) -*** Exception: Defer01.hs:18:9: error: [GHC-39999] +*** Exception: Defer01.hs:17:9: error: [GHC-39999] • No instance for ‘Eq B’ arising from a use of ‘==’ • In the expression: x == x In an equation for ‘b’: b x = x == x @@ -92,43 +87,43 @@ Defer01.hs:50:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • In the first argument of ‘c’, namely ‘(C2 True)’ In the first argument of ‘print’, namely ‘(c (C2 True))’ In the expression: print (c (C2 True)) -*** Exception: Defer01.hs:28:5: error: [GHC-39999] +*** Exception: Defer01.hs:27:5: error: [GHC-39999] • No instance for ‘Num (a -> a)’ arising from the literal ‘1’ (maybe you haven't applied a function to enough arguments?) • In the expression: 1 In an equation for ‘d’: d = 1 (deferred type error) -*** Exception: Defer01.hs:31:5: error: [GHC-83865] +*** Exception: Defer01.hs:30:5: error: [GHC-83865] • Couldn't match expected type ‘Char -> t’ with actual type ‘Char’ • The function ‘e’ is applied to one value argument, but its type ‘Char’ has none In the expression: e 'q' In an equation for ‘f’: f = e 'q' - • Relevant bindings include f :: t (bound at Defer01.hs:31:1) + • Relevant bindings include f :: t (bound at Defer01.hs:30:1) (deferred type error) -*** Exception: Defer01.hs:34:8: error: [GHC-25897] +*** Exception: Defer01.hs:33:8: error: [GHC-25897] • Couldn't match expected type ‘Char’ with actual type ‘a’ ‘a’ is a rigid type variable bound by the type signature for: h :: forall a. a -> (Char, Char) - at Defer01.hs:33:1-21 + at Defer01.hs:32:1-21 • In the expression: x In the expression: (x, 'c') In an equation for ‘h’: h x = (x, 'c') • Relevant bindings include - x :: a (bound at Defer01.hs:34:3) - h :: a -> (Char, Char) (bound at Defer01.hs:34:1) + x :: a (bound at Defer01.hs:33:3) + h :: a -> (Char, Char) (bound at Defer01.hs:33:1) (deferred type error) -*** Exception: Defer01.hs:39:17: error: [GHC-83865] +*** Exception: Defer01.hs:38:17: error: [GHC-83865] • Couldn't match expected type ‘Bool’ with actual type ‘T a’ • In the first argument of ‘not’, namely ‘(K a)’ In the first argument of ‘seq’, namely ‘(not (K a))’ In the expression: seq (not (K a)) () • Relevant bindings include - a :: a (bound at Defer01.hs:39:3) - i :: a -> () (bound at Defer01.hs:39:1) + a :: a (bound at Defer01.hs:38:3) + i :: a -> () (bound at Defer01.hs:38:1) (deferred type error) -*** Exception: Defer01.hs:43:5: error: [GHC-39999] +*** Exception: Defer01.hs:42:5: error: [GHC-39999] • No instance for ‘MyClass a1’ arising from a use of ‘myOp’ • In the expression: myOp 23 In an equation for ‘j’: j = myOp 23 @@ -139,7 +134,7 @@ Defer01.hs:50:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • In the first argument of ‘print’, namely ‘(k 2)’ In the expression: print (k 2) In an equation for ‘it’: it = print (k 2) -*** Exception: Defer01.hs:50:5: error: [GHC-83865] +*** Exception: Defer01.hs:49:5: error: [GHC-83865] • Couldn't match expected type: IO a0 with actual type: Char -> IO () • Probable cause: ‘putChar’ is applied to too few arguments ===================================== testsuite/tests/indexed-types/should_fail/T13674.stderr ===================================== @@ -17,20 +17,3 @@ T13674.hs:56:21: error: [GHC-25897] y :: GF m (bound at T13674.hs:56:17) x :: GF m (bound at T13674.hs:56:6) bar :: GF m -> GF m -> GF m (bound at T13674.hs:56:1) - -T13674.hs:56:31: error: [GHC-25897] - • Couldn't match type ‘m’ with ‘Lcm m m’ - Expected: GF m - Actual: GF (Lcm m m) - ‘m’ is a rigid type variable bound by - the type signature for: - bar :: forall (m :: Nat). KnownNat m => GF m -> GF m -> GF m - at T13674.hs:55:1-44 - • In the first argument of ‘(\\)’, namely ‘foo y x’ - In the first argument of ‘(\\)’, namely ‘foo y x \\ lcmNat @m @m’ - In the second argument of ‘(-)’, namely - ‘foo y x \\ lcmNat @m @m \\ Sub @() (lcmIsIdempotent @m)’ - • Relevant bindings include - y :: GF m (bound at T13674.hs:56:17) - x :: GF m (bound at T13674.hs:56:6) - bar :: GF m -> GF m -> GF m (bound at T13674.hs:56:1) ===================================== testsuite/tests/pmcheck/should_compile/T12957a.stderr ===================================== @@ -11,15 +11,3 @@ T12957a.hs:25:35: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] In a record update at field ‘sFields’, with type constructor ‘S’ and data constructor ‘S’. - -T12957a.hs:25:35: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘B’ with ‘A’ - Expected: Fields A - Actual: Fields B - • In a record update at field ‘list’, - with type constructor ‘Fields’ - and data constructor ‘BFields’. - In the expression: emptyA {list = [a]} - In a record update at field ‘sFields’, - with type constructor ‘S’ - and data constructor ‘S’. ===================================== testsuite/tests/pmcheck/should_compile/T15450.hs ===================================== @@ -1,6 +1,5 @@ {-# LANGUAGE EmptyCase #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -- To avoid rejecting the inaccessible types module T15450 where ===================================== testsuite/tests/pmcheck/should_compile/T15450.stderr ===================================== @@ -1,11 +1,11 @@ -T15450.hs:8:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] +T15450.hs:7:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive In a case alternative: Patterns of type ‘Bool’ not matched: False True -T15450.hs:11:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] +T15450.hs:10:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive In a case alternative: Patterns of type ‘Bool’ not matched: False ===================================== testsuite/tests/typecheck/should_fail/GivenForallLoop.hs ===================================== @@ -1,5 +1,4 @@ {-# LANGUAGE TypeFamilies, ImpredicativeTypes #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -- Allow insoluble signature for loopy module GivenForallLoop where ===================================== testsuite/tests/typecheck/should_fail/GivenForallLoop.stderr ===================================== @@ -1,20 +1,20 @@ -GivenForallLoop.hs:9:11: error: [GHC-25897] +GivenForallLoop.hs:8:11: error: [GHC-25897] • Could not deduce ‘a ~ b’ from the context: a ~ (forall b1. F a b1) bound by the type signature for: loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b - at GivenForallLoop.hs:8:1-42 + at GivenForallLoop.hs:7:1-42 ‘a’ is a rigid type variable bound by the type signature for: loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b - at GivenForallLoop.hs:8:1-42 + at GivenForallLoop.hs:7:1-42 ‘b’ is a rigid type variable bound by the type signature for: loopy :: forall a b. (a ~ (forall b1. F a b1)) => a -> b - at GivenForallLoop.hs:8:1-42 + at GivenForallLoop.hs:7:1-42 • In the expression: x In an equation for ‘loopy’: loopy x = x • Relevant bindings include - x :: a (bound at GivenForallLoop.hs:9:7) - loopy :: a -> b (bound at GivenForallLoop.hs:9:1) + x :: a (bound at GivenForallLoop.hs:8:7) + loopy :: a -> b (bound at GivenForallLoop.hs:8:1) ===================================== testsuite/tests/typecheck/should_fail/T14325.hs ===================================== @@ -9,3 +9,12 @@ foo x = x hm3 :: C (f b) b => b -> f b hm3 x = foo x + +{- Typechecking hm3 +~~~~~~~~~~~~~~~~~~~ +[G] C (f b) b +[G] f b ~# b -- Superclass; but Irred because occurs check +[W] C b (f b) + +So the wanted can't be solved and is reported +-} \ No newline at end of file ===================================== testsuite/tests/typecheck/should_fail/T14325.stderr ===================================== @@ -1,14 +1,9 @@ -T14325.hs:11:9: error: [GHC-25897] - • Couldn't match type ‘b’ with ‘f b’ - arising from a superclass required to satisfy ‘C b (f b)’, - arising from a use of ‘foo’ - ‘b’ is a rigid type variable bound by - the type signature for: - hm3 :: forall (f :: * -> *) b. C (f b) b => b -> f b +T14325.hs:11:9: error: [GHC-39999] + • Could not deduce ‘C b (f b)’ arising from a use of ‘foo’ + from the context: C (f b) b + bound by the type signature for: + hm3 :: forall (f :: * -> *) b. C (f b) b => b -> f b at T14325.hs:10:1-28 • In the expression: foo x In an equation for ‘hm3’: hm3 x = foo x - • Relevant bindings include - x :: b (bound at T14325.hs:11:5) - hm3 :: b -> f b (bound at T14325.hs:11:1) ===================================== testsuite/tests/typecheck/should_fail/T20189.hs ===================================== @@ -1,6 +1,5 @@ {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -- Dodgy: allow the strange (illegal) signature module T20189 where y :: (t ~ (forall x . Show x => x -> IO ())) => t ===================================== testsuite/tests/typecheck/should_fail/T20189.stderr ===================================== @@ -1,12 +1,12 @@ -T20189.hs:7:5: error: [GHC-88464] +T20189.hs:6:5: error: [GHC-88464] • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by the type signature for: y :: forall t. (t ~ (forall x. Show x => x -> IO ())) => t - at T20189.hs:6:1-49 + at T20189.hs:5:1-49 • In an equation for ‘y’: y = _ - • Relevant bindings include y :: t (bound at T20189.hs:7:1) + • Relevant bindings include y :: t (bound at T20189.hs:6:1) Constraints include - t ~ (forall x. Show x => x -> IO ()) (from T20189.hs:6:1-49) - Valid hole fits include y :: t (bound at T20189.hs:7:1) + t ~ (forall x. Show x => x -> IO ()) (from T20189.hs:5:1-49) + Valid hole fits include y :: t (bound at T20189.hs:6:1) ===================================== testsuite/tests/typecheck/should_run/Defer01.hs ===================================== @@ -2,7 +2,6 @@ -- Should compile and run {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -- Allows the strange type for `k` {-# OPTIONS_GHC -fdefer-type-errors #-} module Main where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6aab81509fc261cc986dde5c2c619140ad226667 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6aab81509fc261cc986dde5c2c619140ad226667 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 21:51:32 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 May 2023 17:51:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23156 Message-ID: <6467ef64c28f1_9760a3611a24865156@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23156 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23156 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 22:00:37 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 19 May 2023 18:00:37 -0400 Subject: [Git][ghc/ghc][wip/expand-do] Fixes #18324 #23147 Message-ID: <6467f185adc1c_9760a35e48240653514@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: d202a5fb by Apoorv Ingle at 2023-05-19T16:56:09-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Basic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d202a5fb9bcf2db58d26f1c964c4f39ad86795f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d202a5fb9bcf2db58d26f1c964c4f39ad86795f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 22:51:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 18:51:59 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <6467fd8f71a59_9760a3611a24865833d@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 49697450 by Ben Gamari at 2023-05-19T18:51:52-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 11 changed files: - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -146,8 +146,10 @@ pprTyThingHdr = pprTyThing showToHeader pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing = case parents thing of + -- If there are no parents print everything. [] -> print_it (const True) thing - thing':rest -> let ss = map getOccName rest in print_it (`elem` ss) thing' + -- If `thing` has a parent, print the parent and only its child `thing` + thing':rest -> let ss = map getOccName (thing:rest) in print_it (`elem` ss) thing' where parents = go where ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elem` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4969745069e658978e74b8b6a99cf8d601413963 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4969745069e658978e74b8b6a99cf8d601413963 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 22:52:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 18:52:16 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 9 commits: testsuite: Add test to catch changes in core libraries Message-ID: <6467fda0c5cf5_9760a3c7f61746592ab@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 49697450 by Ben Gamari at 2023-05-19T18:51:52-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - b481981f by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Introduce Data.Enum - - - - - 3fca5ac6 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Num.Integer - - - - - 74b3ed4b by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Num - - - - - c61df649 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Num.Natural - - - - - db5136aa by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Introduce Data.Show - - - - - abb22535 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Float - - - - - a4a4efd0 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Real - - - - - 437a38c2 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 20 changed files: - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - + libraries/base/Data/Enum.hs - + libraries/base/Data/Show.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -146,8 +146,10 @@ pprTyThingHdr = pprTyThing showToHeader pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing = case parents thing of + -- If there are no parents print everything. [] -> print_it (const True) thing - thing':rest -> let ss = map getOccName rest in print_it (`elem` ss) thing' + -- If `thing` has a parent, print the parent and only its child `thing` + thing':rest -> let ss = map getOccName (thing:rest) in print_it (`elem` ss) thing' where parents = go where ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== libraries/base/Data/Enum.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum ===================================== libraries/base/Data/Show.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Show +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Show' class. +-- +----------------------------------------------------------------------------- + +module Data.Show + ( Show(..) + -- * 'ShowS' + , ShowS + , shows + , showChar, showString, showMultiLineString + , showParen, showCommaSpace, showSpace + , showLitChar, showLitString + ) where + +import GHC.Show + ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,109 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int + , int2Float + , word2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorFloat + , ceilingFloat + , truncateFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , eqFloat, gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , powerFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , word2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , eqDouble, gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , powerDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Internal + , stgFloatToWord32 + , stgWord32ToFloat + , stgDoubleToWord64 + , stgWord64ToDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Num.hs ===================================== @@ -18,7 +18,9 @@ module GHC.Num - ( module GHC.Num + ( Num(..) + , subtract + , quotRemInteger , module GHC.Num.Integer , module GHC.Num.Natural -- reexported for backward compatibility ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,68 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + , mkRationalWithExponentBase + , FractionalExponentBase(..) + ) where #include "MachDeps.h" ===================================== libraries/base/base.cabal ===================================== @@ -127,6 +127,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 @@ -151,6 +152,7 @@ Library Data.Proxy Data.Ratio Data.Semigroup + Data.Show Data.STRef Data.STRef.Lazy Data.STRef.Strict ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -20,7 +20,131 @@ -- -- The 'Integer' type. -module GHC.Num.Integer where +module GHC.Num.Integer + ( Integer(..) + , integerCheck + , integerCheck# + + -- * Useful constants + , integerZero + , integerOne + + -- * Conversion with... + -- ** 'Int' + , integerFromInt# + , integerFromInt + , integerToInt# + , integerToInt + -- ** 'BigNat' + , integerFromBigNat# + , integerFromBigNatNeg# + , integerFromBigNatSign# + , integerToBigNatSign# + , integerToBigNatClamp# + -- ** 'Word' + , integerFromWord# + , integerFromWord + , integerFromWordNeg# + , integerFromWordSign# + , integerToWord# + , integerToWord + -- ** 'Natural' + , integerFromNatural + , integerToNaturalClamp + , integerToNatural + , integerToNaturalThrow + -- ** 'Int64'/'Word64' + , integerFromInt64# + , integerFromWord64# + , integerToInt64# + , integerToWord64# + -- ** Floating-point + , integerDecodeDouble# + , integerEncodeDouble# + , integerEncodeDouble + , integerEncodeFloat# + -- ** 'Addr#' + , integerToAddr# + , integerToAddr + , integerFromAddr# + , integerFromAddr + -- ** Limbs + , integerFromWordList + , integerToMutableByteArray# + , integerToMutableByteArray + , integerFromByteArray# + , integerFromByteArray + + -- * Predicates + , integerIsNegative# + , integerIsNegative + , integerIsZero + , integerIsOne + + -- * Comparison + , integerNe + , integerEq + , integerLe + , integerLt + , integerGt + , integerGe + , integerEq# + , integerNe# + , integerGt# + , integerLe# + , integerLt# + , integerGe# + , integerCompare + + -- * Arithmetic + , integerSub + , integerAdd + , integerMul + , integerNegate + , integerAbs + , integerSignum + , integerSignum# + , integerQuotRem# + , integerQuotRem + , integerQuot + , integerRem + , integerDivMod# + , integerDivMod + , integerDiv + , integerMod + , integerGcd + , integerLcm + , integerSqr + , integerLog2# + , integerLog2 + , integerLogBaseWord# + , integerLogBaseWord + , integerLogBase# + , integerLogBase + , integerIsPowerOf2# + , integerGcde# + , integerGcde + , integerRecipMod# + , integerPowMod# + + -- * Bit operations + , integerPopCount# + , integerBit# + , integerBit + , integerTestBit# + , integerTestBit + , integerShiftR# + , integerShiftR + , integerShiftL# + , integerShiftL + , integerOr + , integerXor + , integerAnd + , integerComplement + + -- * Miscellaneous + , integerSizeInBase# + ) where #include "MachDeps.h" #include "WordSize.h" ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -8,7 +8,109 @@ #include "MachDeps.h" #include "WordSize.h" -module GHC.Num.Natural where +module GHC.Num.Natural + ( Natural(..) + , naturalCheck# + , naturalCheck + + -- * Useful constants + , naturalZero + , naturalOne + + -- * Predicates + , naturalIsZero + , naturalIsOne + , naturalIsPowerOf2# + + -- * Conversion with... + -- ** 'BigNat' + , naturalFromBigNat# + , naturalToBigNat# + -- ** 'Word' + , naturalFromWord# + , naturalFromWord2# + , naturalFromWord + , naturalToWord# + , naturalToWord + , naturalToWordClamp# + , naturalToWordClamp + , naturalToWordMaybe# + -- ** Limbs + , naturalFromWordList + , naturalToMutableByteArray# + , naturalFromByteArray# + -- ** Floating point + , naturalEncodeDouble# + , naturalEncodeFloat# + -- ** 'Addr#' + , naturalToAddr# + , naturalToAddr + , naturalFromAddr# + , naturalFromAddr + + -- * Comparison + , naturalEq# + , naturalEq + , naturalNe# + , naturalNe + , naturalGe# + , naturalGe + , naturalLe# + , naturalLe + , naturalGt# + , naturalGt + , naturalLt# + , naturalLt + , naturalCompare + + -- * Bit operations + , naturalPopCount# + , naturalPopCount + , naturalShiftR# + , naturalShiftR + , naturalShiftL# + , naturalShiftL + , naturalAnd + , naturalAndNot + , naturalOr + , naturalXor + , naturalTestBit# + , naturalTestBit + , naturalBit# + , naturalBit + , naturalSetBit# + , naturalSetBit + , naturalClearBit# + , naturalClearBit + , naturalComplementBit# + , naturalComplementBit + + -- * Arithmetic + , naturalAdd + , naturalSub + , naturalSubThrow + , naturalSubUnsafe + , naturalMul + , naturalSqr + , naturalSignum + , naturalNegate + , naturalQuotRem# + , naturalQuotRem + , naturalQuot + , naturalRem + , naturalGcd + , naturalLcm + , naturalLog2# + , naturalLog2 + , naturalLogBaseWord# + , naturalLogBaseWord + , naturalLogBase# + , naturalLogBase + , naturalPowMod + + -- * Miscellaneous + , naturalSizeInBase# + ) where import GHC.Prim import GHC.Types ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elem` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6189abc9c62bc6100f89ebb98ed17ef503357a81...437a38c2edad016c8841327f3884177b00312b38 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6189abc9c62bc6100f89ebb98ed17ef503357a81...437a38c2edad016c8841327f3884177b00312b38 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 22:52:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 18:52:35 -0400 Subject: [Git][ghc/ghc][wip/split-ghc-base] 10 commits: testsuite: Add test to catch changes in core libraries Message-ID: <6467fdb3a044c_9760a35e48240659855@gitlab.mail> Ben Gamari pushed to branch wip/split-ghc-base at Glasgow Haskell Compiler / GHC Commits: 49697450 by Ben Gamari at 2023-05-19T18:51:52-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - b481981f by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Introduce Data.Enum - - - - - 3fca5ac6 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Num.Integer - - - - - 74b3ed4b by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Num - - - - - c61df649 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Num.Natural - - - - - db5136aa by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Introduce Data.Show - - - - - abb22535 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Float - - - - - a4a4efd0 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Add export list to GHC.Real - - - - - 437a38c2 by Ben Gamari at 2023-05-19T18:52:05-04:00 base: Eliminate module reexport in GHC.Exception - - - - - b10ccb35 by Ben Gamari at 2023-05-19T18:52:29-04:00 base: Break up GHC.Base - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - + libraries/base/Data/Enum.hs - libraries/base/Data/Semigroup/Internal.hs-boot - + libraries/base/Data/Show.hs - libraries/base/GHC/Base.hs - + libraries/base/GHC/Base/FunOps.hs - + libraries/base/GHC/Base/Functor.hs - + libraries/base/GHC/Base/List.hs - + libraries/base/GHC/Base/NonEmpty.hs - + libraries/base/GHC/Base/Semigroup.hs - libraries/base/GHC/Base.hs-boot → libraries/base/GHC/Base/Semigroup.hs-boot - + libraries/base/GHC/Base/String.hs - + libraries/base/GHC/Base/Void.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84a92fad2e13a465b0fc852436e7f52bae5d4093...b10ccb35e7ca4960df13fd4b4e703b795ab39a6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84a92fad2e13a465b0fc852436e7f52bae5d4093...b10ccb35e7ca4960df13fd4b4e703b795ab39a6b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 22:55:55 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 19 May 2023 18:55:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-internals Message-ID: <6467fe7b5c61_9760a3bbe34e066028a@gitlab.mail> Ben Gamari pushed new branch wip/ghc-internals at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-internals You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 23:01:58 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Fri, 19 May 2023 19:01:58 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 142 commits: Fix doc typos in libraries/base/GHC Message-ID: <6467ffe6e7680_9760a3c7f61746627b7@gitlab.mail> Matthew Craven pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - 9ff6ba83 by Matthew Craven at 2023-05-19T16:00:30-04:00 WIP: Track visibility in forall-coercions - - - - - 36e8d745 by Matthew Craven at 2023-05-19T16:01:11-04:00 revert temporary renamings of the forallco constructors - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7f95d4a8492e9aaf5a5c6af317ffe4e393413d2...36e8d745318d4fd933adb79f1eadfa5fb7f8ccb3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7f95d4a8492e9aaf5a5c6af317ffe4e393413d2...36e8d745318d4fd933adb79f1eadfa5fb7f8ccb3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 23:03:00 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Fri, 19 May 2023 19:03:00 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] make necessary testsuite changes Message-ID: <64680024ea231_9760a3611a248662910@gitlab.mail> Matthew Craven pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: ebc9f2bf by Matthew Craven at 2023-05-19T19:01:58-04:00 make necessary testsuite changes - - - - - 7 changed files: - testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/pmcheck/should_compile/T11195.hs - testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/stranal/should_compile/T15627.stderr - testsuite/tests/stranal/should_compile/T18982.stderr Changes: ===================================== testsuite/tests/cpranal/should_compile/T18174.stderr ===================================== @@ -1,23 +1,18 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 464, types: 475, coercions: 6, joins: 0/3} +Result size of Tidy Core = {terms: 467, types: 458, coercions: 6, joins: 0/3} -- RHS size: {terms: 8, types: 7, coercions: 0, joins: 0/0} T18174.$WMkT :: Int %1 -> (Int, Int) %1 -> T -T18174.$WMkT = \ (conrep_aU0 :: Int) (conrep_aU1 :: (Int, Int)) -> case conrep_aU1 of conrep_X0 { __DEFAULT -> T18174.MkT conrep_aU0 conrep_X0 } +T18174.$WMkT = \ (conrep_aXh :: Int) (conrep1_aXi :: (Int, Int)) -> case conrep1_aXi of conrep2_aXi { __DEFAULT -> T18174.MkT conrep_aXh conrep2_aXi } --- RHS size: {terms: 5, types: 10, coercions: 0, joins: 0/0} +-- RHS size: {terms: 8, types: 15, coercions: 0, joins: 0/0} T18174.$wstrictField :: Int -> (Int, Int) -> (# Int, (Int, Int) #) -T18174.$wstrictField - = \ (ww_s18W :: Int) - (ww1_s18X - :: (Int, Int) - Unf=OtherCon []) -> - (# ww_s18W, ww1_s18X #) +T18174.$wstrictField = \ (ww_s1cs :: Int) (ww1_s1ct :: (Int, Int)) -> case ww1_s1ct of ww2_X1 { (ipv_s1ex, ipv1_s1ey) -> (# ww_s1cs, ww2_X1 #) } -- RHS size: {terms: 12, types: 21, coercions: 0, joins: 0/0} strictField :: T -> (Int, (Int, Int)) -strictField = \ (ds_s18U :: T) -> case ds_s18U of { MkT ww_s18W ww1_s18X -> case T18174.$wstrictField ww_s18W ww1_s18X of { (# ww2_s1aJ, ww3_s1aK #) -> (ww2_s1aJ, ww3_s1aK) } } +strictField = \ (ds_s1cq :: T) -> case ds_s1cq of { MkT ww_s1cs ww1_s1ct -> case T18174.$wstrictField ww_s1cs ww1_s1ct of { (# ww2_s1ef, ww3_s1eg #) -> (ww2_s1ef, ww3_s1eg) } } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18174.$trModule4 :: GHC.Prim.Addr# @@ -40,20 +35,20 @@ T18174.$trModule :: GHC.Types.Module T18174.$trModule = GHC.Types.Module T18174.$trModule3 T18174.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_r1c2 :: GHC.Types.KindRep -$krep_r1c2 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) +$krep_r1fR :: GHC.Types.KindRep +$krep_r1fR = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep1_r1c3 :: [GHC.Types.KindRep] -$krep1_r1c3 = GHC.Types.: @GHC.Types.KindRep $krep_r1c2 (GHC.Types.[] @GHC.Types.KindRep) +$krep1_r1fS :: [GHC.Types.KindRep] +$krep1_r1fS = GHC.Types.: @GHC.Types.KindRep $krep_r1fR (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep2_r1c4 :: [GHC.Types.KindRep] -$krep2_r1c4 = GHC.Types.: @GHC.Types.KindRep $krep_r1c2 $krep1_r1c3 +$krep2_r1fT :: [GHC.Types.KindRep] +$krep2_r1fT = GHC.Types.: @GHC.Types.KindRep $krep_r1fR $krep1_r1fS -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep3_r1c5 :: GHC.Types.KindRep -$krep3_r1c5 = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep2_r1c4 +$krep3_r1fU :: GHC.Types.KindRep +$krep3_r1fU = GHC.Types.KindRepTyConApp GHC.Tuple.Prim.$tcTuple2 $krep2_r1fT -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18174.$tcT2 :: GHC.Prim.Addr# @@ -65,19 +60,19 @@ T18174.$tcT1 = GHC.Types.TrNameS T18174.$tcT2 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18174.$tcT :: GHC.Types.TyCon -T18174.$tcT = GHC.Types.TyCon 10767449832801551323## 11558512111670031614## T18174.$trModule T18174.$tcT1 0# GHC.Types.krep$* +T18174.$tcT = GHC.Types.TyCon 10767449832801551323#Word64 11558512111670031614#Word64 T18174.$trModule T18174.$tcT1 0# GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep4_r1c6 :: GHC.Types.KindRep -$krep4_r1c6 = GHC.Types.KindRepTyConApp T18174.$tcT (GHC.Types.[] @GHC.Types.KindRep) +$krep4_r1fV :: GHC.Types.KindRep +$krep4_r1fV = GHC.Types.KindRepTyConApp T18174.$tcT (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep5_r1c7 :: GHC.Types.KindRep -$krep5_r1c7 = GHC.Types.KindRepFun $krep3_r1c5 $krep4_r1c6 +$krep5_r1fW :: GHC.Types.KindRep +$krep5_r1fW = GHC.Types.KindRepFun $krep3_r1fU $krep4_r1fV -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18174.$tc'MkT1 :: GHC.Types.KindRep -T18174.$tc'MkT1 = GHC.Types.KindRepFun $krep_r1c2 $krep5_r1c7 +T18174.$tc'MkT1 = GHC.Types.KindRepFun $krep_r1fR $krep5_r1fW -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18174.$tc'MkT3 :: GHC.Prim.Addr# @@ -89,60 +84,60 @@ T18174.$tc'MkT2 = GHC.Types.TrNameS T18174.$tc'MkT3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18174.$tc'MkT :: GHC.Types.TyCon -T18174.$tc'MkT = GHC.Types.TyCon 15126196523434762667## 13148007393547580468## T18174.$trModule T18174.$tc'MkT2 0# T18174.$tc'MkT1 +T18174.$tc'MkT = GHC.Types.TyCon 15126196523434762667#Word64 13148007393547580468#Word64 T18174.$trModule T18174.$tc'MkT2 0# T18174.$tc'MkT1 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -lvl_r1c8 :: Int -lvl_r1c8 = GHC.Types.I# 1# +lvl_r1fX :: Int +lvl_r1fX = GHC.Types.I# 1# Rec { --- RHS size: {terms: 38, types: 38, coercions: 0, joins: 0/1} -T18174.$wfac3 :: forall {a}. GHC.Prim.Int# -> a -> (# a, Int #) +-- RHS size: {terms: 38, types: 37, coercions: 0, joins: 0/1} +T18174.$wfac3 :: forall a. GHC.Prim.Int# -> a -> (# a, Int #) T18174.$wfac3 - = \ (@a_s196) (ww_s199 :: GHC.Prim.Int#) (s_s19b :: a_s196) -> - case GHC.Prim.<# ww_s199 2# of { + = \ (@a_s1cC) (ww_s1cF :: GHC.Prim.Int#) (s_s1cH :: a_s1cC) -> + case GHC.Prim.<# ww_s1cF 2# of { __DEFAULT -> let { - ds_s18k :: (a_s196, Int) - ds_s18k = case T18174.$wfac3 @a_s196 (GHC.Prim.-# ww_s199 1#) s_s19b of { (# ww1_s1aM, ww2_s1aN #) -> (ww1_s1aM, ww2_s1aN) } } in - (# case ds_s18k of { (s'_aYW, n'_aYX) -> s'_aYW }, case ds_s18k of { (s'_aYW, n'_aYX) -> case n'_aYX of { GHC.Types.I# ww1_s193 -> GHC.Types.I# (GHC.Prim.*# ww1_s193 ww1_s193) } } #); - 1# -> (# s_s19b, lvl_r1c8 #) + ds_s1bj :: (a_s1cC, Int) + ds_s1bj = case T18174.$wfac3 @a_s1cC (GHC.Prim.-# ww_s1cF 1#) s_s1cH of { (# ww1_s1ei, ww2_s1ej #) -> (ww1_s1ei, ww2_s1ej) } } in + (# case ds_s1bj of { (s'_a12d, n'_a12e) -> s'_a12d }, case ds_s1bj of { (s'_a12d, n'_a12e) -> case n'_a12e of { GHC.Types.I# ww1_s1cz -> GHC.Types.I# (GHC.Prim.*# ww1_s1cz ww1_s1cz) } } #); + 1# -> (# s_s1cH, lvl_r1fX #) } end Rec } --- RHS size: {terms: 14, types: 16, coercions: 0, joins: 0/0} +-- RHS size: {terms: 14, types: 15, coercions: 0, joins: 0/0} fac3 :: forall a. Int -> a -> (a, Int) -fac3 = \ (@a_s196) (n_s197 :: Int) (s_s19b :: a_s196) -> case n_s197 of { GHC.Types.I# ww_s199 -> case T18174.$wfac3 @a_s196 ww_s199 s_s19b of { (# ww1_s1aM, ww2_s1aN #) -> (ww1_s1aM, ww2_s1aN) } } +fac3 = \ (@a_s1cC) (n_s1cD :: Int) (s_s1cH :: a_s1cC) -> case n_s1cD of { GHC.Types.I# ww_s1cF -> case T18174.$wfac3 @a_s1cC ww_s1cF s_s1cH of { (# ww1_s1ei, ww2_s1ej #) -> (ww1_s1ei, ww2_s1ej) } } Rec { --- RHS size: {terms: 24, types: 21, coercions: 0, joins: 0/0} -T18174.$wfac2 :: forall {a}. GHC.Prim.Int# -> a -> (# a, Int #) +-- RHS size: {terms: 24, types: 20, coercions: 0, joins: 0/0} +T18174.$wfac2 :: forall a. GHC.Prim.Int# -> a -> (# a, Int #) T18174.$wfac2 - = \ (@a_s19g) (ww_s19j :: GHC.Prim.Int#) (s_s19l :: a_s19g) -> - case GHC.Prim.<# ww_s19j 2# of { - __DEFAULT -> case T18174.$wfac2 @a_s19g (GHC.Prim.-# ww_s19j 1#) s_s19l of { (# ww1_s1aP, ww2_s1aQ #) -> (# ww1_s1aP, GHC.Num.$fNumInt_$c* ww2_s1aQ ww2_s1aQ #) }; - 1# -> (# s_s19l, lvl_r1c8 #) + = \ (@a_s1cM) (ww_s1cP :: GHC.Prim.Int#) (s_s1cR :: a_s1cM) -> + case GHC.Prim.<# ww_s1cP 2# of { + __DEFAULT -> case T18174.$wfac2 @a_s1cM (GHC.Prim.-# ww_s1cP 1#) s_s1cR of { (# ww1_s1el, ww2_s1em #) -> (# ww1_s1el, GHC.Num.$fNumInt_$c* ww2_s1em ww2_s1em #) }; + 1# -> (# s_s1cR, lvl_r1fX #) } end Rec } --- RHS size: {terms: 14, types: 16, coercions: 0, joins: 0/0} +-- RHS size: {terms: 14, types: 15, coercions: 0, joins: 0/0} fac2 :: forall a. Int -> a -> (a, Int) -fac2 = \ (@a_s19g) (n_s19h :: Int) (s_s19l :: a_s19g) -> case n_s19h of { GHC.Types.I# ww_s19j -> case T18174.$wfac2 @a_s19g ww_s19j s_s19l of { (# ww1_s1aP, ww2_s1aQ #) -> (ww1_s1aP, ww2_s1aQ) } } +fac2 = \ (@a_s1cM) (n_s1cN :: Int) (s_s1cR :: a_s1cM) -> case n_s1cN of { GHC.Types.I# ww_s1cP -> case T18174.$wfac2 @a_s1cM ww_s1cP s_s1cR of { (# ww1_s1el, ww2_s1em #) -> (ww1_s1el, ww2_s1em) } } Rec { --- RHS size: {terms: 24, types: 21, coercions: 0, joins: 0/0} -T18174.$wfac1 :: forall {a}. GHC.Prim.Int# -> a -> (# a, GHC.Prim.Int# #) +-- RHS size: {terms: 24, types: 20, coercions: 0, joins: 0/0} +T18174.$wfac1 :: forall a. GHC.Prim.Int# -> a -> (# a, GHC.Prim.Int# #) T18174.$wfac1 - = \ (@a_s19q) (ww_s19t :: GHC.Prim.Int#) (s_s19v :: a_s19q) -> - case GHC.Prim.<# ww_s19t 2# of { - __DEFAULT -> case T18174.$wfac1 @a_s19q (GHC.Prim.-# ww_s19t 1#) s_s19v of { (# ww1_s19y, ww2_s1aS #) -> (# ww1_s19y, GHC.Prim.*# ww_s19t ww2_s1aS #) }; - 1# -> (# s_s19v, 1# #) + = \ (@a_s1cW) (ww_s1cZ :: GHC.Prim.Int#) (s_s1d1 :: a_s1cW) -> + case GHC.Prim.<# ww_s1cZ 2# of { + __DEFAULT -> case T18174.$wfac1 @a_s1cW (GHC.Prim.-# ww_s1cZ 1#) s_s1d1 of { (# ww1_s1d4, ww2_s1eo #) -> (# ww1_s1d4, GHC.Prim.*# ww_s1cZ ww2_s1eo #) }; + 1# -> (# s_s1d1, 1# #) } end Rec } --- RHS size: {terms: 15, types: 16, coercions: 0, joins: 0/0} +-- RHS size: {terms: 15, types: 15, coercions: 0, joins: 0/0} fac1 :: forall a. Int -> a -> (a, Int) -fac1 = \ (@a_s19q) (n_s19r :: Int) (s_s19v :: a_s19q) -> case n_s19r of { GHC.Types.I# ww_s19t -> case T18174.$wfac1 @a_s19q ww_s19t s_s19v of { (# ww1_s19y, ww2_s1aS #) -> (ww1_s19y, GHC.Types.I# ww2_s1aS) } } +fac1 = \ (@a_s1cW) (n_s1cX :: Int) (s_s1d1 :: a_s1cW) -> case n_s1cX of { GHC.Types.I# ww_s1cZ -> case T18174.$wfac1 @a_s1cW ww_s1cZ s_s1d1 of { (# ww1_s1d4, ww2_s1eo #) -> (ww1_s1d4, GHC.Types.I# ww2_s1eo) } } -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18174.h5 :: Int @@ -151,51 +146,51 @@ T18174.h5 = GHC.Types.I# 0# -- RHS size: {terms: 37, types: 15, coercions: 0, joins: 0/1} T18174.$wg2 :: GHC.Prim.Int# -> GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #) T18174.$wg2 - = \ (ww_s19G :: GHC.Prim.Int#) (ww1_s19K :: GHC.Prim.Int#) -> - case ww1_s19K of ds_X2 { + = \ (ww_s1dc :: GHC.Prim.Int#) (ww1_s1dg :: GHC.Prim.Int#) -> + case ww1_s1dg of ds_X2 { __DEFAULT -> - (# GHC.Prim.*# 2# ww_s19G, + (# GHC.Prim.*# 2# ww_s1dc, case ds_X2 of wild_X3 { __DEFAULT -> let { - c1#_a17n :: GHC.Prim.Int# - c1#_a17n = GHC.Prim.andI# 1# (GHC.Prim.<# wild_X3 0#) } in - case GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#_a17n) wild_X3 of wild1_a17o { __DEFAULT -> GHC.Types.I# (GHC.Prim.-# wild1_a17o c1#_a17n) }; + c1#_a1co :: GHC.Prim.Int# + c1#_a1co = GHC.Prim.andI# 1# (GHC.Prim.<# wild_X3 0#) } in + case GHC.Prim.-# (GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#_a1co) wild_X3) c1#_a1co of ds2_a1aa { __DEFAULT -> GHC.Types.I# ds2_a1aa }; 0# -> GHC.Real.divZeroError @Int } #); - 1# -> (# GHC.Prim.+# 2# ww_s19G, T18174.h5 #) + 1# -> (# GHC.Prim.+# 2# ww_s1dc, T18174.h5 #) } -- RHS size: {terms: 30, types: 19, coercions: 0, joins: 0/0} T18174.$wh2 :: GHC.Prim.Int# -> Int T18174.$wh2 - = \ (ww_s19W :: GHC.Prim.Int#) -> - case ww_s19W of ds_X2 { + = \ (ww_s1ds :: GHC.Prim.Int#) -> + case ww_s1ds of ds_X2 { __DEFAULT -> case GHC.Prim.remInt# ds_X2 2# of { - __DEFAULT -> case T18174.$wg2 ds_X2 2# of { (# ww1_s1aU, ww2_s19Q #) -> ww2_s19Q }; - 0# -> case T18174.$wg2 2# ds_X2 of { (# ww1_s1aU, ww2_s19Q #) -> case ww2_s19Q of { GHC.Types.I# y_a17v -> GHC.Types.I# (GHC.Prim.+# ww1_s1aU y_a17v) } } + __DEFAULT -> case T18174.$wg2 ds_X2 2# of { (# ww1_s1eq, ww2_s1dl #) -> ww2_s1dl }; + 0# -> case T18174.$wg2 2# ds_X2 of { (# ww1_s1eq, ww2_s1dl #) -> case ww2_s1dl of { GHC.Types.I# y_a1ah -> GHC.Types.I# (GHC.Prim.+# ww1_s1eq y_a1ah) } } }; 1# -> T18174.h5 } -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} h2 :: Int -> Int -h2 = \ (ds_s19U :: Int) -> case ds_s19U of { GHC.Types.I# ww_s19W -> T18174.$wh2 ww_s19W } +h2 = \ (ds_s1dq :: Int) -> case ds_s1dq of { GHC.Types.I# ww_s1ds -> T18174.$wh2 ww_s1ds } -- RHS size: {terms: 34, types: 14, coercions: 0, joins: 0/1} T18174.$wg1 :: GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #) T18174.$wg1 - = \ (ww_s1a3 :: GHC.Prim.Int#) -> - case ww_s1a3 of ds_X2 { + = \ (ww_s1dz :: GHC.Prim.Int#) -> + case ww_s1dz of ds_X2 { __DEFAULT -> (# GHC.Prim.*# 2# ds_X2, case ds_X2 of wild_X3 { __DEFAULT -> let { - c1#_a17n :: GHC.Prim.Int# - c1#_a17n = GHC.Prim.andI# 1# (GHC.Prim.<# wild_X3 0#) } in - case GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#_a17n) wild_X3 of wild1_a17o { __DEFAULT -> GHC.Types.I# (GHC.Prim.-# wild1_a17o c1#_a17n) }; + c1#_a1co :: GHC.Prim.Int# + c1#_a1co = GHC.Prim.andI# 1# (GHC.Prim.<# wild_X3 0#) } in + case GHC.Prim.-# (GHC.Prim.quotInt# (GHC.Prim.-# 2# c1#_a1co) wild_X3) c1#_a1co of ds2_a1aa { __DEFAULT -> GHC.Types.I# ds2_a1aa }; 0# -> GHC.Real.divZeroError @Int } #); 1# -> (# 15#, T18174.h5 #) @@ -203,52 +198,52 @@ T18174.$wg1 -- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} T18174.h4 :: (Int, Int) -T18174.h4 = case T18174.$wg1 2# of { (# ww_s1aW, ww1_s1a9 #) -> (GHC.Types.I# ww_s1aW, ww1_s1a9) } +T18174.h4 = case T18174.$wg1 2# of { (# ww_s1es, ww1_s1dE #) -> (GHC.Types.I# ww_s1es, ww1_s1dE) } -- RHS size: {terms: 22, types: 16, coercions: 0, joins: 0/0} T18174.$wh1 :: GHC.Prim.Int# -> Int T18174.$wh1 - = \ (ww_s1af :: GHC.Prim.Int#) -> - case ww_s1af of ds_X2 { - __DEFAULT -> case T18174.$wg1 ds_X2 of { (# ww1_s1aW, ww2_s1a9 #) -> case ww2_s1a9 of { GHC.Types.I# y_a17v -> GHC.Types.I# (GHC.Prim.+# ww1_s1aW y_a17v) } }; + = \ (ww_s1dL :: GHC.Prim.Int#) -> + case ww_s1dL of ds_X2 { + __DEFAULT -> case T18174.$wg1 ds_X2 of { (# ww1_s1es, ww2_s1dE #) -> case ww2_s1dE of { GHC.Types.I# y_a1ah -> GHC.Types.I# (GHC.Prim.+# ww1_s1es y_a1ah) } }; 1# -> T18174.h5; - 2# -> case T18174.h4 of { (ds1_a155, y_a156) -> y_a156 } + 2# -> case T18174.h4 of { (ds1_a1aS, y_a1aT) -> y_a1aT } } -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} h1 :: Int -> Int -h1 = \ (ds_s1ad :: Int) -> case ds_s1ad of { GHC.Types.I# ww_s1af -> T18174.$wh1 ww_s1af } +h1 = \ (ds_s1dJ :: Int) -> case ds_s1dJ of { GHC.Types.I# ww_s1dL -> T18174.$wh1 ww_s1dL } -- RHS size: {terms: 12, types: 5, coercions: 0, joins: 0/0} thunkDiverges :: Int -> (Int, Bool) -thunkDiverges = \ (x_aIy :: Int) -> (case x_aIy of { GHC.Types.I# x1_a17s -> GHC.Types.I# (GHC.Prim.+# 2# (GHC.Prim.*# 2# x1_a17s)) }, GHC.Types.False) +thunkDiverges = \ (x_aLg :: Int) -> (case x_aLg of { GHC.Types.I# x1_a1ae -> GHC.Types.I# (GHC.Prim.+# 2# (GHC.Prim.*# 2# x1_a1ae)) }, GHC.Types.False) -- RHS size: {terms: 13, types: 10, coercions: 0, joins: 0/0} T18174.$wdataConWrapper :: (Int, Int) -> Int -> (# T, Int #) -T18174.$wdataConWrapper = \ (p_s1av :: (Int, Int)) (x_s1aw :: Int) -> (# T18174.$WMkT x_s1aw p_s1av, case x_s1aw of { GHC.Types.I# x1_a17s -> GHC.Types.I# (GHC.Prim.+# x1_a17s 1#) } #) +T18174.$wdataConWrapper = \ (p_s1e1 :: (Int, Int)) (x_s1e2 :: Int) -> (# T18174.$WMkT x_s1e2 p_s1e1, case x_s1e2 of { GHC.Types.I# x1_a1ae -> GHC.Types.I# (GHC.Prim.+# x1_a1ae 1#) } #) -- RHS size: {terms: 10, types: 13, coercions: 0, joins: 0/0} dataConWrapper :: (Int, Int) -> Int -> (T, Int) -dataConWrapper = \ (p_s1av :: (Int, Int)) (x_s1aw :: Int) -> case T18174.$wdataConWrapper p_s1av x_s1aw of { (# ww_s1aY, ww1_s1aZ #) -> (ww_s1aY, ww1_s1aZ) } +dataConWrapper = \ (p_s1e1 :: (Int, Int)) (x_s1e2 :: Int) -> case T18174.$wdataConWrapper p_s1e1 x_s1e2 of { (# ww_s1eu, ww1_s1ev #) -> (ww_s1eu, ww1_s1ev) } Rec { --- RHS size: {terms: 27, types: 31, coercions: 0, joins: 0/0} +-- RHS size: {terms: 27, types: 25, coercions: 0, joins: 0/0} T18174.$wfacIO :: GHC.Prim.Int# -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) T18174.$wfacIO - = \ (ww_s1aD :: GHC.Prim.Int#) (eta_s1aF :: GHC.Prim.State# GHC.Prim.RealWorld) -> - case GHC.Prim.<# ww_s1aD 2# of { - __DEFAULT -> case T18174.$wfacIO (GHC.Prim.-# ww_s1aD 1#) eta_s1aF of { (# ipv_a180, ipv1_a181 #) -> (# ipv_a180, case ipv1_a181 of { GHC.Types.I# y_a16I -> GHC.Types.I# (GHC.Prim.*# ww_s1aD y_a16I) } #) }; - 1# -> (# eta_s1aF, lvl_r1c8 #) + = \ (ww_s1e9 :: GHC.Prim.Int#) (eta_s1eb :: GHC.Prim.State# GHC.Prim.RealWorld) -> + case GHC.Prim.<# ww_s1e9 2# of { + __DEFAULT -> case T18174.$wfacIO (GHC.Prim.-# ww_s1e9 1#) eta_s1eb of { (# ipv_a1bb, ipv1_a1bc #) -> (# ipv_a1bb, case ipv1_a1bc of { GHC.Types.I# y_a19M -> GHC.Types.I# (GHC.Prim.*# ww_s1e9 y_a19M) } #) }; + 1# -> (# eta_s1eb, lvl_r1fX #) } end Rec } -- RHS size: {terms: 8, types: 5, coercions: 0, joins: 0/0} T18174.facIO1 :: Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) -T18174.facIO1 = \ (n_s1aB :: Int) (eta_s1aF :: GHC.Prim.State# GHC.Prim.RealWorld) -> case n_s1aB of { GHC.Types.I# ww_s1aD -> T18174.$wfacIO ww_s1aD eta_s1aF } +T18174.facIO1 = \ (n_s1e7 :: Int) (eta_s1eb :: GHC.Prim.State# GHC.Prim.RealWorld) -> case n_s1e7 of { GHC.Types.I# ww_s1e9 -> T18174.$wfacIO ww_s1e9 eta_s1eb } -- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} facIO :: Int -> IO Int -facIO = T18174.facIO1 `cast` (_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int)) +facIO = T18174.facIO1 `cast` (_R %_N ->_R Sym (GHC.Types.N:IO[0] _R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int)) ===================================== testsuite/tests/cpranal/should_compile/T18401.stderr ===================================== @@ -4,31 +4,31 @@ Result size of Tidy Core = {terms: 52, types: 86, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 18, types: 24, coercions: 0, joins: 0/0} -T18401.$w$spoly_$wgo1 :: forall {a}. a -> [a] -> (# [a] #) +T18401.$w$spoly_$wgo1 :: forall a. a -> [a] -> (# [a] #) T18401.$w$spoly_$wgo1 - = \ (@a_s18C) (w_s18D :: a_s18C) (w1_s18E :: [a_s18C]) -> - case w1_s18E of { - [] -> (# GHC.Types.[] @a_s18C #); - : y_a15b ys_a15c -> (# GHC.Types.: @a_s18C w_s18D (case T18401.$w$spoly_$wgo1 @a_s18C y_a15b ys_a15c of { (# ww_s18J #) -> ww_s18J }) #) + = \ (@a_s1cL) (sc_s1cM :: a_s1cL) (sc1_s1cN :: [a_s1cL]) -> + case sc1_s1cN of { + [] -> (# GHC.Types.[] @a_s1cL #); + : y_a1bH ys_a1bI -> (# GHC.Types.: @a_s1cL sc_s1cM (case T18401.$w$spoly_$wgo1 @a_s1cL y_a1bH ys_a1bI of { (# ww_s1cR #) -> ww_s1cR }) #) } end Rec } -- RHS size: {terms: 17, types: 22, coercions: 0, joins: 0/0} si :: forall a. [a] -> (Bool, [a]) si - = \ (@a_s17T) (w_s17U :: [a_s17T]) -> - case w_s17U of { - [] -> (GHC.Types.False, GHC.Types.[] @a_s17T); - : y_a15b ys_a15c -> (GHC.Types.True, case T18401.$w$spoly_$wgo1 @a_s17T y_a15b ys_a15c of { (# ww_s18J #) -> ww_s18J }) + = \ (@a_s1bR) (xs0_s1bS :: [a_s1bR]) -> + case xs0_s1bS of { + [] -> (GHC.Types.False, GHC.Types.[] @a_s1bR); + : y_a1bH ys_a1bI -> (GHC.Types.True, case T18401.$w$spoly_$wgo1 @a_s1bR y_a1bH ys_a1bI of { (# ww_s1cR #) -> ww_s1cR }) } -- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0} safeInit :: forall a. [a] -> Maybe [a] safeInit - = \ (@a_aPB) (xs_aut :: [a_aPB]) -> - case xs_aut of { - [] -> GHC.Maybe.Nothing @[a_aPB]; - : y_a15b ys_a15c -> GHC.Maybe.Just @[a_aPB] (case T18401.$w$spoly_$wgo1 @a_aPB y_a15b ys_a15c of { (# ww_s18J #) -> ww_s18J }) + = \ (@a_aQu) (xs_awN :: [a_aQu]) -> + case xs_awN of { + [] -> GHC.Maybe.Nothing @[a_aQu]; + : y_a1bH ys_a1bI -> GHC.Maybe.Just @[a_aQu] (case T18401.$w$spoly_$wgo1 @a_aQu y_a1bH ys_a1bI of { (# ww_s1cR #) -> ww_s1cR }) } ===================================== testsuite/tests/pmcheck/should_compile/T11195.hs ===================================== @@ -111,11 +111,11 @@ opt_trans_rule is co1 co2@(AppCo co2a co2b) -- Push transitivity inside forall opt_trans_rule is co1 co2 - | ForAllCo tv1 eta1 r1 <- co1 - , Just (tv2,eta2,r2) <- etaForAllCo_maybe co2 = undefined + | ForAllCo tv1 vl1 vr1 eta1 r1 <- co1 + , Just (tv2,vl2,vr2,eta2,r2) <- etaForAllCo_maybe co2 = undefined - | ForAllCo tv2 eta2 r2 <- co2 - , Just (tv1,eta1,r1) <- etaForAllCo_maybe co1 = undefined + | ForAllCo tv2 vl2 vr1 eta2 r2 <- co2 + , Just (tv1,vl1,vr2,eta1,r1) <- etaForAllCo_maybe co1 = undefined where push_trans tv1 eta1 r1 tv2 eta2 r2 = undefined ===================================== testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr ===================================== @@ -4,7 +4,7 @@ Result size of Tidy Core = {terms: 82, types: 52, coercions: 29, joins: 0/0} -- RHS size: {terms: 3, types: 3, coercions: 0, joins: 0/0} -unsafeToInteger1 :: forall {n :: Nat}. Signed n -> Signed n +unsafeToInteger1 :: forall (n :: Nat). Signed n -> Signed n [GblId, Arity=1, Unf=OtherCon []] unsafeToInteger1 = \ (@(n :: Nat)) (ds :: Signed n) -> ds @@ -15,8 +15,8 @@ unsafeToInteger = unsafeToInteger1 `cast` (forall (n :: _N). _R %_N ->_R OpaqueNoCastWW.N:Signed[0] _P - :: (forall {n :: Nat}. Signed n -> Signed n) - ~R# (forall {n :: Nat}. Signed n -> Integer)) + :: (forall (n :: Nat). Signed n -> Signed n) + ~R# (forall (n :: Nat). Signed n -> Integer)) -- RHS size: {terms: 8, types: 7, coercions: 21, joins: 0/0} times [InlPrag=OPAQUE] @@ -38,8 +38,8 @@ times _R %_N ->_R _R %_N ->_R Sym (OpaqueNoCastWW.N:Signed[0] _P) - :: (forall {m :: Nat} {n :: Nat}. Signed m -> Signed n -> Integer) - ~R# (forall {m :: Nat} {n :: Nat}. + :: (forall (m :: Nat) (n :: Nat). Signed m -> Signed n -> Integer) + ~R# (forall (m :: Nat) (n :: Nat). Signed m -> Signed n -> Signed (m + n))) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} ===================================== testsuite/tests/simplCore/should_compile/T8331.stderr ===================================== @@ -10,9 +10,9 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) ; Sym (N:ReaderT[0] <*>_N _R _R _N) :: Coercible - (forall {a} {b}. + (forall a b. ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s b) - (forall {a} {b}. + (forall a b. ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) b)) "SPEC $c<$ @(ST s) @_" forall (@s) (@r) ($dFunctor :: Functor (ST s)). @@ -24,8 +24,8 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) ; Sym (N:ReaderT[0] <*>_N _R _R _N) :: Coercible - (forall {a} {b}. a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) + (forall a b. a -> ReaderT r (ST s) b -> r -> STRep s a) + (forall a b. a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) "SPEC $c<* @(ST s) @_" forall (@s) (@r) ($dApplicative :: Applicative (ST s)). $fApplicativeReaderT_$c<* @(ST s) @r $dApplicative @@ -36,9 +36,9 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) ; Sym (N:ReaderT[0] <*>_N _R _R _N) :: Coercible - (forall {a} {b}. + (forall a b. ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. + (forall a b. ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) "SPEC $c<*> @(ST s) @_" forall (@s) (@r) ($dApplicative :: Applicative (ST s)). @@ -50,9 +50,9 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) :: Coercible - (forall {a} {b}. + (forall a b. ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. + (forall a b. ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> ST s b)) "SPEC $c>> @(ST s) @_" forall (@s) (@r) ($dMonad :: Monad (ST s)). @@ -68,9 +68,9 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) :: Coercible - (forall {a} {b}. + (forall a b. ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> STRep s b) - (forall {a} {b}. + (forall a b. ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> ST s b)) "SPEC $cfmap @(ST s) @_" forall (@s) (@r) ($dFunctor :: Functor (ST s)). @@ -82,9 +82,8 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) ; Sym (N:ReaderT[0] <*>_N _R _R _N) :: Coercible - (forall {a} {b}. (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - (a -> b) -> ReaderT r (ST s) a -> ReaderT r (ST s) b)) + (forall a b. (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) + (forall a b. (a -> b) -> ReaderT r (ST s) a -> ReaderT r (ST s) b)) "SPEC $cliftA2 @(ST s) @_" forall (@s) (@r) ($dApplicative :: Applicative (ST s)). $fApplicativeReaderT_$cliftA2 @(ST s) @r $dApplicative @@ -96,10 +95,10 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) ; Sym (N:ReaderT[0] <*>_N _R _R _N) :: Coercible - (forall {a} {b} {c}. + (forall a b c. (a -> b -> c) -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s c) - (forall {a} {b} {c}. + (forall a b c. (a -> b -> c) -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) c)) "SPEC $cp1Applicative @(ST s) @_" @@ -119,8 +118,8 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) ; Sym (N:ReaderT[0] <*>_N _R _R _N) :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) + (forall a. a -> r -> STRep s a) + (forall a. a -> ReaderT r (ST s) a)) "SPEC $creturn @(ST s) @_" forall (@s) (@r) ($dMonad :: Monad (ST s)). $fMonadReaderT_$creturn @(ST s) @r $dMonad @@ -130,8 +129,8 @@ %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) ; Sym (N:ReaderT[0] <*>_N _R _R _N) :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) + (forall a. a -> r -> STRep s a) + (forall a. a -> ReaderT r (ST s) a)) "SPEC $fApplicativeReaderT @(ST s) @_" forall (@s) (@r) ($dApplicative :: Applicative (ST s)). $fApplicativeReaderT @(ST s) @r $dApplicative ===================================== testsuite/tests/stranal/should_compile/T15627.stderr ===================================== @@ -1,337 +1,320 @@ -[1 of 1] Compiling Unlifted ( T15627.hs, T15627.o ) ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 254, types: 130, coercions: 0, joins: 3/3} +Result size of Tidy Core = {terms: 266, types: 128, coercions: 0, joins: 3/3} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Unlifted.$trModule4 :: Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Unlifted.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Unlifted.$trModule3 :: GHC.Types.TrName -[GblId, - Caf=NoCafRefs, - Str=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$trModule3 = GHC.Types.TrNameS Unlifted.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Unlifted.$trModule2 :: Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Unlifted.$trModule2 = "Unlifted"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Unlifted.$trModule1 :: GHC.Types.TrName -[GblId, - Caf=NoCafRefs, - Str=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$trModule1 = GHC.Types.TrNameS Unlifted.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -Unlifted.$trModule :: GHC.Unit.Module -[GblId, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -Unlifted.$trModule = GHC.Unit.Module Unlifted.$trModule3 Unlifted.$trModule1 +Unlifted.$trModule :: GHC.Types.Module +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +Unlifted.$trModule = GHC.Types.Module Unlifted.$trModule3 Unlifted.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep_r1d0 :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep_r1d0 = GHC.Types.KindRepTyConApp GHC.Types.$tc'Lifted (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_r2Xd :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep_r2Xd = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) +$krep1_r1d1 :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep1_r1d1 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep1_r2Xe :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep1_r2Xe = GHC.Types.KindRepVar 1# +$krep2_r1d2 :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep2_r1d2 = GHC.Types.KindRepVar 1# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep2_r2Xf :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep2_r2Xf = GHC.Types.KindRepVar 0# +$krep3_r1d3 :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep3_r1d3 = GHC.Types.KindRepVar 0# -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep3_r2Xg :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep3_r2Xg = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Xf (GHC.Types.[] @ GHC.Types.KindRep) +$krep4_r1d4 :: [GHC.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep4_r1d4 = GHC.Types.: @GHC.Types.KindRep $krep3_r1d3 (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5_r1d5 :: [GHC.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep5_r1d5 = GHC.Types.: @GHC.Types.KindRep $krep_r1d0 $krep4_r1d4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep4_r2Xh :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep4_r2Xh = GHC.Types.KindRepTyConApp GHC.Types.$tcArray# $krep3_r2Xg +$krep6_r1d6 :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep6_r1d6 = GHC.Types.KindRepTyConApp GHC.Types.$tcArray# $krep5_r1d5 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep5_r2Xi :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep5_r2Xi = GHC.Types.: @ GHC.Types.KindRep $krep1_r2Xe (GHC.Types.[] @ GHC.Types.KindRep) +$krep7_r1d7 :: [GHC.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep7_r1d7 = GHC.Types.: @GHC.Types.KindRep $krep2_r1d2 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep6_r2Xj :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep6_r2Xj = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Xf $krep5_r2Xi +$krep8_r1d8 :: [GHC.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep8_r1d8 = GHC.Types.: @GHC.Types.KindRep $krep3_r1d3 $krep7_r1d7 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep9_r1d9 :: [GHC.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep9_r1d9 = GHC.Types.: @GHC.Types.KindRep $krep_r1d0 $krep8_r1d8 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7_r2Xk :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep7_r2Xk = GHC.Types.KindRepTyConApp GHC.Types.$tcMutVar# $krep6_r2Xj +$krep10_r1da :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep10_r1da = GHC.Types.KindRepTyConApp GHC.Types.$tcMutVar# $krep9_r1d9 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Unlifted.$tcMMutVar2 :: Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Unlifted.$tcMMutVar2 = "MMutVar"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Unlifted.$tcMMutVar1 :: GHC.Types.TrName -[GblId, - Caf=NoCafRefs, - Str=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$tcMMutVar1 = GHC.Types.TrNameS Unlifted.$tcMMutVar2 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Unlifted.$tcMMutVar :: GHC.Types.TyCon -[GblId, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$tcMMutVar - = GHC.Types.TyCon 976071122164149049## 18076036821450447502## Unlifted.$trModule Unlifted.$tcMMutVar1 0# GHC.Types.krep$*->*->* + = GHC.Types.TyCon + 976071122164149049#Word64 18076036821450447502#Word64 Unlifted.$trModule Unlifted.$tcMMutVar1 0# GHC.Types.krep$*->*->* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep8_r2Xl :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep8_r2Xl = GHC.Types.KindRepTyConApp Unlifted.$tcMMutVar $krep6_r2Xj +$krep11_r1db :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep11_r1db = GHC.Types.KindRepTyConApp Unlifted.$tcMMutVar $krep8_r1d8 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep9_r2Xm :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep9_r2Xm = GHC.Types.KindRepFun $krep_r2Xd $krep8_r2Xl +$krep12_r1dc :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep12_r1dc = GHC.Types.KindRepFun $krep1_r1d1 $krep11_r1db -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -Unlifted.$tc'MMutVar1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Unlifted.$tc'MMutVar1 = GHC.Types.KindRepFun $krep7_r2Xk $krep9_r2Xm +Unlifted.$tc'MMutVar1 [InlPrag=[~]] :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +Unlifted.$tc'MMutVar1 = GHC.Types.KindRepFun $krep10_r1da $krep12_r1dc -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Unlifted.$tc'MMutVar3 :: Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Unlifted.$tc'MMutVar3 = "'MMutVar"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Unlifted.$tc'MMutVar2 :: GHC.Types.TrName -[GblId, - Caf=NoCafRefs, - Str=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$tc'MMutVar2 = GHC.Types.TrNameS Unlifted.$tc'MMutVar3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Unlifted.$tc'MMutVar :: GHC.Types.TyCon -[GblId, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$tc'MMutVar - = GHC.Types.TyCon 1807347364283186211## 6245494011022471830## Unlifted.$trModule Unlifted.$tc'MMutVar2 2# Unlifted.$tc'MMutVar1 + = GHC.Types.TyCon + 1807347364283186211#Word64 6245494011022471830#Word64 Unlifted.$trModule Unlifted.$tc'MMutVar2 2# Unlifted.$tc'MMutVar1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Unlifted.$tcAArray2 :: Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Unlifted.$tcAArray2 = "AArray"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Unlifted.$tcAArray1 :: GHC.Types.TrName -[GblId, - Caf=NoCafRefs, - Str=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$tcAArray1 = GHC.Types.TrNameS Unlifted.$tcAArray2 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Unlifted.$tcAArray :: GHC.Types.TyCon -[GblId, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$tcAArray - = GHC.Types.TyCon 15463012197909582608## 8369862272173810511## Unlifted.$trModule Unlifted.$tcAArray1 0# GHC.Types.krep$*Arr* + = GHC.Types.TyCon + 15463012197909582608#Word64 8369862272173810511#Word64 Unlifted.$trModule Unlifted.$tcAArray1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10_r2Xn :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep10_r2Xn = GHC.Types.KindRepTyConApp Unlifted.$tcAArray $krep3_r2Xg +$krep13_r1dd :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep13_r1dd = GHC.Types.KindRepTyConApp Unlifted.$tcAArray $krep4_r1d4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11_r2Xo :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep11_r2Xo = GHC.Types.KindRepFun $krep_r2Xd $krep10_r2Xn +$krep14_r1de :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +$krep14_r1de = GHC.Types.KindRepFun $krep1_r1d1 $krep13_r1dd -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -Unlifted.$tc'AArray1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Unlifted.$tc'AArray1 = GHC.Types.KindRepFun $krep4_r2Xh $krep11_r2Xo +Unlifted.$tc'AArray1 [InlPrag=[~]] :: GHC.Types.KindRep +[GblId, Unf=OtherCon []] +Unlifted.$tc'AArray1 = GHC.Types.KindRepFun $krep6_r1d6 $krep14_r1de -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Unlifted.$tc'AArray3 :: Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Unlifted.$tc'AArray3 = "'AArray"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Unlifted.$tc'AArray2 :: GHC.Types.TrName -[GblId, - Caf=NoCafRefs, - Str=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$tc'AArray2 = GHC.Types.TrNameS Unlifted.$tc'AArray3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Unlifted.$tc'AArray :: GHC.Types.TyCon -[GblId, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Unlifted.$tc'AArray - = GHC.Types.TyCon 5117353292610538775## 18288923674485681885## Unlifted.$trModule Unlifted.$tc'AArray2 1# Unlifted.$tc'AArray1 + = GHC.Types.TyCon + 5117353292610538775#Word64 18288923674485681885#Word64 Unlifted.$trModule Unlifted.$tc'AArray2 1# Unlifted.$tc'AArray1 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -lvl_r2Xp :: Int -[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] -lvl_r2Xp = GHC.Types.I# 1# +Unlifted.fac1 :: Int +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +Unlifted.fac1 = GHC.Types.I# 1# -- RHS size: {terms: 34, types: 10, coercions: 0, joins: 1/1} -fac [InlPrag=NOUSERINLINE[2]] :: Int -> Int +fac :: Int -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Str=<1!P(L)>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_s2UI [Occ=Once!] :: Int) -> - case w_s2UI of { I# ww1_s2UL -> - case ># 1# ww1_s2UL of { + Tmpl= \ (n_ayj [Occ=Once1!] :: Int) -> + case n_ayj of { I# y_a1bo -> + case ># 1# y_a1bo of { __DEFAULT -> joinrec { - $wgo_s2UH [InlPrag=NOUSERINLINE[2], Occ=LoopBreakerT[2]] :: Int# -> Int# -> Int - [LclId[JoinId(2)], Arity=2, Str=m, Unf=OtherCon []] - $wgo_s2UH (w1_s2UB :: Int#) (ww2_s2UF [Occ=Once*] :: Int#) - = case ==# w1_s2UB ww1_s2UL of { - __DEFAULT -> jump $wgo_s2UH (+# w1_s2UB 1#) (*# ww2_s2UF w1_s2UB); - 1# -> GHC.Types.I# (*# ww2_s2UF w1_s2UB) + go3_a1bC [InlPrag=[2], Occ=T[2]] :: Int# -> Int -> Int + [LclId[JoinId(2)(Just [~, !])], + Arity=2, + Str=, + Unf=Unf{Src=StableSystem, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (x_s1bI [Occ=Once1] :: Int#) (v_s1bJ [Occ=Once1!, OS=OneShot] :: Int) -> + case v_s1bJ of { I# ww_s1bL [Occ=Once1] -> jump $wgo3_s1bO x_s1bI ww_s1bL }}] + go3_a1bC (x_s1bI [Occ=Once1] :: Int#) (v_s1bJ [Occ=Once1!, OS=OneShot] :: Int) + = case v_s1bJ of { I# ww_s1bL [Occ=Once1] -> jump $wgo3_s1bO x_s1bI ww_s1bL }; + $wgo3_s1bO [InlPrag=[2], Occ=LoopBreakerT[2]] :: Int# -> Int# -> Int + [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] + $wgo3_s1bO (x_s1bI :: Int#) (ww_s1bL [Occ=Once2] :: Int#) + = case ==# x_s1bI y_a1bo of { + __DEFAULT -> jump go3_a1bC (+# x_s1bI 1#) (GHC.Types.I# (*# ww_s1bL x_s1bI)); + 1# -> GHC.Types.I# (*# ww_s1bL x_s1bI) }; } in - jump $wgo_s2UH 1# 1#; - 1# -> GHC.Types.I# 1# + jump go3_a1bC 1# Unlifted.fac1; + 1# -> Unlifted.fac1 } }}] fac - = \ (w_s2UI :: Int) -> - case w_s2UI of { I# ww1_s2UL -> - case ># 1# ww1_s2UL of { + = \ (n_ayj :: Int) -> + case n_ayj of { I# y_a1bo -> + case ># 1# y_a1bo of { __DEFAULT -> joinrec { - $wgo_s2UH [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Int# -> Int# -> Int - [LclId[JoinId(2)], Arity=2, Str=m, Unf=OtherCon []] - $wgo_s2UH (w1_s2UB :: Int#) (ww2_s2UF :: Int#) - = case ==# w1_s2UB ww1_s2UL of { - __DEFAULT -> jump $wgo_s2UH (+# w1_s2UB 1#) (*# ww2_s2UF w1_s2UB); - 1# -> GHC.Types.I# (*# ww2_s2UF w1_s2UB) + $wgo3_s1bO [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L)))] :: Int# -> Int# -> Int + [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] + $wgo3_s1bO (x_s1bI :: Int#) (ww_s1bL :: Int#) + = case ==# x_s1bI y_a1bo of { + __DEFAULT -> jump $wgo3_s1bO (+# x_s1bI 1#) (*# ww_s1bL x_s1bI); + 1# -> GHC.Types.I# (*# ww_s1bL x_s1bI) }; } in - jump $wgo_s2UH 1# 1#; - 1# -> lvl_r2Xp + jump $wgo3_s1bO 1# 1#; + 1# -> Unlifted.fac1 } } --- RHS size: {terms: 32, types: 12, coercions: 0, joins: 1/1} -Unlifted.$wmutVar [InlPrag=NOINLINE] :: forall {s} {a}. Int# -> Int# -[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] +-- RHS size: {terms: 32, types: 10, coercions: 0, joins: 1/1} +Unlifted.$wmutVar [InlPrag=NOINLINE] :: forall s a. Int# -> Int# +[GblId, Arity=1, Str=, Unf=OtherCon []] Unlifted.$wmutVar - = \ (@ s_s2UR) (@ a_s2US) (ww_s2V0 :: Int#) -> - case ># 1# ww_s2V0 of { + = \ (@s_s1bX) (@a_s1bY) (ww_s1c4 :: Int#) -> + case ># 1# ww_s1c4 of { __DEFAULT -> joinrec { - $wgo_s2UH [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Int# -> Int# -> Int# - [LclId[JoinId(2)], Arity=2, Str=, Unf=OtherCon []] - $wgo_s2UH (w_s2UB :: Int#) (ww1_s2UF :: Int#) - = case ==# w_s2UB ww_s2V0 of { - __DEFAULT -> jump $wgo_s2UH (+# w_s2UB 1#) (*# ww1_s2UF w_s2UB); - 1# -> *# ww1_s2UF w_s2UB + $wgo3_s1bO [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,L))] :: Int# -> Int# -> Int# + [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] + $wgo3_s1bO (x_s1bI :: Int#) (ww1_s1bL :: Int#) + = case ==# x_s1bI ww_s1c4 of { + __DEFAULT -> jump $wgo3_s1bO (+# x_s1bI 1#) (*# ww1_s1bL x_s1bI); + 1# -> *# ww1_s1bL x_s1bI }; } in - jump $wgo_s2UH 1# 1#; + jump $wgo3_s1bO 1# 1#; 1# -> 1# } --- RHS size: {terms: 15, types: 19, coercions: 0, joins: 0/0} -mutVar [InlPrag=NOUSERINLINE[0]] :: forall s a. MMutVar s a -> Int +-- RHS size: {terms: 15, types: 18, coercions: 0, joins: 0/0} +mutVar [InlPrag=NOINLINE[final]] :: forall s a. MMutVar s a -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Str=<1!P(A,1!P(L))>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ s_s2UR) (@ a_s2US) (w_s2UT [Occ=Once!] :: MMutVar s_s2UR a_s2US) -> - case w_s2UT of { MMutVar _ [Occ=Dead] ww2_s2UX [Occ=Once!] -> - case ww2_s2UX of { I# ww4_s2V0 [Occ=Once] -> - case Unlifted.$wmutVar @ s_s2UR @ a_s2US ww4_s2V0 of ww5_s2V5 [Occ=Once] { __DEFAULT -> GHC.Types.I# ww5_s2V5 } + Tmpl= \ (@s_s1bX) (@a_s1bY) (ds_s1bZ [Occ=Once1!] :: MMutVar s_s1bX a_s1bY) -> + case ds_s1bZ of { MMutVar _ [Occ=Dead] ww1_s1c2 [Occ=Once1!] -> + case ww1_s1c2 of { I# ww2_s1c4 [Occ=Once1] -> + case Unlifted.$wmutVar @s_s1bX @a_s1bY ww2_s1c4 of ww3_s1cn [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww3_s1cn } } }}] mutVar - = \ (@ s_s2UR) (@ a_s2US) (w_s2UT :: MMutVar s_s2UR a_s2US) -> - case w_s2UT of { MMutVar ww1_s2UW ww2_s2UX -> - case ww2_s2UX of { I# ww4_s2V0 -> - case Unlifted.$wmutVar @ s_s2UR @ a_s2US ww4_s2V0 of ww5_s2V5 { __DEFAULT -> GHC.Types.I# ww5_s2V5 } + = \ (@s_s1bX) (@a_s1bY) (ds_s1bZ :: MMutVar s_s1bX a_s1bY) -> + case ds_s1bZ of { MMutVar ww_s1c1 ww1_s1c2 -> + case ww1_s1c2 of { I# ww2_s1c4 -> + case Unlifted.$wmutVar @s_s1bX @a_s1bY ww2_s1c4 of ww3_s1cn { __DEFAULT -> GHC.Types.I# ww3_s1cn } } } --- RHS size: {terms: 31, types: 10, coercions: 0, joins: 1/1} -Unlifted.$warray [InlPrag=NOINLINE] :: forall {a}. Int# -> Int# -[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] +-- RHS size: {terms: 31, types: 9, coercions: 0, joins: 1/1} +Unlifted.$warray [InlPrag=NOINLINE] :: forall a. Int# -> Int# +[GblId, Arity=1, Str=, Unf=OtherCon []] Unlifted.$warray - = \ (@ a_s2V7) (ww_s2Vf :: Int#) -> - case ># 1# ww_s2Vf of { + = \ (@a_s1cb) (ww_s1ch :: Int#) -> + case ># 1# ww_s1ch of { __DEFAULT -> joinrec { - $wgo_s2UH [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Int# -> Int# -> Int# - [LclId[JoinId(2)], Arity=2, Str=, Unf=OtherCon []] - $wgo_s2UH (w_s2UB :: Int#) (ww1_s2UF :: Int#) - = case ==# w_s2UB ww_s2Vf of { - __DEFAULT -> jump $wgo_s2UH (+# w_s2UB 1#) (*# ww1_s2UF w_s2UB); - 1# -> *# ww1_s2UF w_s2UB + $wgo3_s1bO [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,L))] :: Int# -> Int# -> Int# + [LclId[JoinId(2)(Nothing)], Arity=2, Str=, Unf=OtherCon []] + $wgo3_s1bO (x_s1bI :: Int#) (ww1_s1bL :: Int#) + = case ==# x_s1bI ww_s1ch of { + __DEFAULT -> jump $wgo3_s1bO (+# x_s1bI 1#) (*# ww1_s1bL x_s1bI); + 1# -> *# ww1_s1bL x_s1bI }; } in - jump $wgo_s2UH 1# 1#; + jump $wgo3_s1bO 1# 1#; 1# -> 1# } -- RHS size: {terms: 14, types: 13, coercions: 0, joins: 0/0} -array [InlPrag=NOUSERINLINE[0]] :: forall a. AArray a -> Int +array [InlPrag=NOINLINE[final]] :: forall a. AArray a -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, - Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Str=<1!P(A,1!P(L))>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ a_s2V7) (w_s2V8 [Occ=Once!] :: AArray a_s2V7) -> - case w_s2V8 of { AArray _ [Occ=Dead] ww2_s2Vc [Occ=Once!] -> - case ww2_s2Vc of { I# ww4_s2Vf [Occ=Once] -> - case Unlifted.$warray @ a_s2V7 ww4_s2Vf of ww5_s2Vk [Occ=Once] { __DEFAULT -> GHC.Types.I# ww5_s2Vk } + Tmpl= \ (@a_s1cb) (ds_s1cc [Occ=Once1!] :: AArray a_s1cb) -> + case ds_s1cc of { AArray _ [Occ=Dead] ww1_s1cf [Occ=Once1!] -> + case ww1_s1cf of { I# ww2_s1ch [Occ=Once1] -> + case Unlifted.$warray @a_s1cb ww2_s1ch of ww3_s1cp [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww3_s1cp } } }}] array - = \ (@ a_s2V7) (w_s2V8 :: AArray a_s2V7) -> - case w_s2V8 of { AArray ww1_s2Vb ww2_s2Vc -> - case ww2_s2Vc of { I# ww4_s2Vf -> case Unlifted.$warray @ a_s2V7 ww4_s2Vf of ww5_s2Vk { __DEFAULT -> GHC.Types.I# ww5_s2Vk } } + = \ (@a_s1cb) (ds_s1cc :: AArray a_s1cb) -> + case ds_s1cc of { AArray ww_s1ce ww1_s1cf -> + case ww1_s1cf of { I# ww2_s1ch -> case Unlifted.$warray @a_s1cb ww2_s1ch of ww3_s1cp { __DEFAULT -> GHC.Types.I# ww3_s1cp } } } ===================================== testsuite/tests/stranal/should_compile/T18982.stderr ===================================== @@ -1,10 +1,10 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 311, types: 214, coercions: 4, joins: 0/0} +Result size of Tidy Core = {terms: 295, types: 206, coercions: 4, joins: 0/0} -- RHS size: {terms: 8, types: 9, coercions: 1, joins: 0/0} T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int -T18982.$WExGADT = \ (@e) (conrep :: e ~ Int) (conrep :: e) (conrep :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) conrep conrep conrep +T18982.$WExGADT = \ (@e) (conrep :: e ~ Int) (conrep1 :: e) (conrep2 :: Int) -> T18982.ExGADT @Int @e @~(_N :: Int GHC.Prim.~# Int) conrep conrep1 conrep2 -- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} T18982.$WGADT :: Int %1 -> GADT Int @@ -12,7 +12,7 @@ T18982.$WGADT = \ (conrep :: Int) -> T18982.GADT @Int @~(_N :: Int GHC.Prim -- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a -T18982.$WEx = \ (@e) (@a) (conrep :: e) (conrep :: a) -> T18982.Ex @a @e conrep conrep +T18982.$WEx = \ (@e) (@a) (conrep :: e) (conrep1 :: a) -> T18982.Ex @a @e conrep conrep1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18982.$trModule4 :: GHC.Prim.Addr# @@ -46,22 +46,6 @@ $krep1 = GHC.Types.KindRepVar 1# $krep2 :: GHC.Types.KindRep $krep2 = GHC.Types.KindRepVar 0# --- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep3 :: [GHC.Types.KindRep] -$krep3 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) - --- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep4 :: [GHC.Types.KindRep] -$krep4 = GHC.Types.: @GHC.Types.KindRep $krep2 $krep3 - --- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep5 :: [GHC.Types.KindRep] -$krep5 = GHC.Types.: @GHC.Types.KindRep GHC.Types.krep$* $krep4 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep6 :: GHC.Types.KindRep -$krep6 = GHC.Types.KindRepTyConApp GHC.Types.$tc~ $krep5 - -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18982.$tcBox2 :: GHC.Prim.Addr# T18982.$tcBox2 = "Box"# @@ -75,16 +59,16 @@ T18982.$tcBox :: GHC.Types.TyCon T18982.$tcBox = GHC.Types.TyCon 16948648223906549518#Word64 2491460178135962649#Word64 T18982.$trModule T18982.$tcBox1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep7 :: [GHC.Types.KindRep] -$krep7 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) +$krep3 :: [GHC.Types.KindRep] +$krep3 = GHC.Types.: @GHC.Types.KindRep $krep2 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep8 :: GHC.Types.KindRep -$krep8 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep7 +$krep4 :: GHC.Types.KindRep +$krep4 = GHC.Types.KindRepTyConApp T18982.$tcBox $krep3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Box1 :: GHC.Types.KindRep -T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep8 +T18982.$tc'Box1 = GHC.Types.KindRepFun $krep2 $krep4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Box3 :: GHC.Prim.Addr# @@ -111,20 +95,20 @@ T18982.$tcEx :: GHC.Types.TyCon T18982.$tcEx = GHC.Types.TyCon 4376661818164435927#Word64 18005417598910668817#Word64 T18982.$trModule T18982.$tcEx1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep9 :: [GHC.Types.KindRep] -$krep9 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) +$krep5 :: [GHC.Types.KindRep] +$krep5 = GHC.Types.: @GHC.Types.KindRep $krep1 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10 :: GHC.Types.KindRep -$krep10 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep9 +$krep6 :: GHC.Types.KindRep +$krep6 = GHC.Types.KindRepTyConApp T18982.$tcEx $krep5 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Types.KindRep -$krep11 = GHC.Types.KindRepFun $krep1 $krep10 +$krep7 :: GHC.Types.KindRep +$krep7 = GHC.Types.KindRepFun $krep1 $krep6 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Ex1 :: GHC.Types.KindRep -T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep11 +T18982.$tc'Ex1 = GHC.Types.KindRepFun $krep2 $krep7 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Ex3 :: GHC.Prim.Addr# @@ -150,13 +134,17 @@ T18982.$tcGADT1 = GHC.Types.TrNameS T18982.$tcGADT2 T18982.$tcGADT :: GHC.Types.TyCon T18982.$tcGADT = GHC.Types.TyCon 9243924476135839950#Word64 5096619276488416461#Word64 T18982.$trModule T18982.$tcGADT1 0# GHC.Types.krep$*Arr* +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep8 :: [GHC.Types.KindRep] +$krep8 = GHC.Types.: @GHC.Types.KindRep $krep (GHC.Types.[] @GHC.Types.KindRep) + -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep12 :: GHC.Types.KindRep -$krep12 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep3 +$krep9 :: GHC.Types.KindRep +$krep9 = GHC.Types.KindRepTyConApp T18982.$tcGADT $krep8 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18982.$tc'GADT1 :: GHC.Types.KindRep -T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep12 +T18982.$tc'GADT1 = GHC.Types.KindRepFun $krep $krep9 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18982.$tc'GADT3 :: GHC.Prim.Addr# @@ -183,20 +171,16 @@ T18982.$tcExGADT :: GHC.Types.TyCon T18982.$tcExGADT = GHC.Types.TyCon 6470898418160489500#Word64 10361108917441214060#Word64 T18982.$trModule T18982.$tcExGADT1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13 :: GHC.Types.KindRep -$krep13 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep3 - --- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep14 :: GHC.Types.KindRep -$krep14 = GHC.Types.KindRepFun $krep $krep13 +$krep10 :: GHC.Types.KindRep +$krep10 = GHC.Types.KindRepTyConApp T18982.$tcExGADT $krep8 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep15 :: GHC.Types.KindRep -$krep15 = GHC.Types.KindRepFun $krep2 $krep14 +$krep11 :: GHC.Types.KindRep +$krep11 = GHC.Types.KindRepFun $krep $krep10 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18982.$tc'ExGADT1 :: GHC.Types.KindRep -T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep6 $krep15 +T18982.$tc'ExGADT1 = GHC.Types.KindRepFun $krep2 $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18982.$tc'ExGADT3 :: GHC.Prim.Addr# @@ -211,7 +195,7 @@ T18982.$tc'ExGADT :: GHC.Types.TyCon T18982.$tc'ExGADT = GHC.Types.TyCon 8468257409157161049#Word64 5503123603717080600#Word64 T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 -- RHS size: {terms: 11, types: 10, coercions: 0, joins: 0/0} -T18982.$wi :: forall {a} {e}. (a GHC.Prim.~# Int) => e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wi :: forall a e. (a GHC.Prim.~# Int) => e -> GHC.Prim.Int# -> GHC.Prim.Int# T18982.$wi = \ (@a) (@e) (ww :: a GHC.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Prim.+# ww2 1# } -- RHS size: {terms: 15, types: 22, coercions: 1, joins: 0/0} @@ -219,7 +203,7 @@ i :: forall a. ExGADT a -> Int i = \ (@a) (ds :: ExGADT a) -> case ds of { ExGADT @e ww ww1 ww2 ww3 -> case ww3 of { GHC.Types.I# ww4 -> case T18982.$wi @a @e @~(ww :: a GHC.Prim.~# Int) ww2 ww4 of ww5 { __DEFAULT -> GHC.Types.I# ww5 } } } -- RHS size: {terms: 6, types: 7, coercions: 0, joins: 0/0} -T18982.$wh :: forall {a}. (a GHC.Prim.~# Int) => GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wh :: forall a. (a GHC.Prim.~# Int) => GHC.Prim.Int# -> GHC.Prim.Int# T18982.$wh = \ (@a) (ww :: a GHC.Prim.~# Int) (ww1 :: GHC.Prim.Int#) -> GHC.Prim.+# ww1 1# -- RHS size: {terms: 14, types: 15, coercions: 1, joins: 0/0} @@ -227,7 +211,7 @@ h :: forall a. GADT a -> Int h = \ (@a) (ds :: GADT a) -> case ds of { GADT ww ww1 -> case ww1 of { GHC.Types.I# ww2 -> case T18982.$wh @a @~(ww :: a GHC.Prim.~# Int) ww2 of ww3 { __DEFAULT -> GHC.Types.I# ww3 } } } -- RHS size: {terms: 9, types: 4, coercions: 0, joins: 0/0} -T18982.$wg :: forall {e}. e -> GHC.Prim.Int# -> GHC.Prim.Int# +T18982.$wg :: forall e. e -> GHC.Prim.Int# -> GHC.Prim.Int# T18982.$wg = \ (@e) (ww :: e) (ww1 :: GHC.Prim.Int#) -> case ww of { __DEFAULT -> GHC.Prim.+# ww1 1# } -- RHS size: {terms: 14, types: 11, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ebc9f2bfb51e728f94051607f0364796797e31a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ebc9f2bfb51e728f94051607f0364796797e31a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 19 23:24:15 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 19 May 2023 19:24:15 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] 14 commits: Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <6468051fe182c_9760a364c017c673083@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - 0771121e by Simon Peyton Jones at 2023-05-20T00:23:53+01:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. ..maybe more to come.. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better: Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Read(normal) +0.4% LargeRecord(normal) +0.7% T12227(normal) -1.8% GOOD T13035(normal) -0.6% T15703(normal) -1.4% GOOD T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -36.9% GOOD geo. mean -1.3% minimum -40.7% maximum +0.7% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6aab81509fc261cc986dde5c2c619140ad226667...0771121e40f2d04a99a8002223e925d685562a1d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6aab81509fc261cc986dde5c2c619140ad226667...0771121e40f2d04a99a8002223e925d685562a1d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 20 03:46:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 19 May 2023 23:46:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Type inference for data family newtype instances Message-ID: <6468428245839_9760a36afc5546819c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - 4885518e by Peter Trommler at 2023-05-19T23:46:02-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - d74a1111 by Matthew Pickering at 2023-05-19T23:46:03-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - 9 changed files: - compiler/GHC/Tc/Solver/Equality.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/using-optimisation.rst - + testsuite/tests/indexed-types/should_compile/T23408.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/rts/linker/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -205,15 +205,22 @@ can_eq_nc' _rewritten _rdr_env _envs ev eq_rel -- Decompose type constructor applications -- NB: we have expanded type synonyms already -can_eq_nc' _rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ +can_eq_nc' rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ | Just (tc1, tys1) <- tcSplitTyConApp_maybe ty1 , Just (tc2, tys2) <- tcSplitTyConApp_maybe ty2 - -- we want to catch e.g. Maybe Int ~ (Int -> Int) here for better - -- error messages rather than decomposing into AppTys; - -- hence no direct match on TyConApp - , not (isTypeFamilyTyCon tc1) - , not (isTypeFamilyTyCon tc2) - = canTyConApp ev eq_rel tc1 tys1 tc2 tys2 + -- tcSplitTyConApp_maybe: we want to catch e.g. Maybe Int ~ (Int -> Int) + -- here for better error messages rather than decomposing into AppTys; + -- hence not using a direct match on TyConApp + + , not (isTypeFamilyTyCon tc1 || isTypeFamilyTyCon tc2) + -- A type family at the top of LHS or RHS: we want to fall through + -- to the canonical-LHS cases (look for canEqLHS_maybe) + + -- See (TC1) in Note [Canonicalising TyCon/TyCon equalities] + , let role = eqRelRole eq_rel + both_generative = isGenerativeTyCon tc1 role && isGenerativeTyCon tc2 role + , rewritten || both_generative + = canTyConApp ev eq_rel both_generative tc1 tys1 tc2 tys2 can_eq_nc' _rewritten _rdr_env _envs ev eq_rel s1@(ForAllTy (Bndr _ vis1) _) _ @@ -248,7 +255,7 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 -- Only rewritten types end up below here. ---------------------------- --- NB: pattern match on True: we want only rewritten types sent to canEqLHS +-- NB: pattern match on rewritten=True: we want only rewritten types sent to canEqLHS -- This means we've rewritten any variables and reduced any type family redexes -- See also Note [No top-level newtypes on RHS of representational equalities] can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 @@ -278,7 +285,7 @@ can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 ; case eq_rel of -- See Note [Unsolved equalities] ReprEq -> solveIrredEquality ReprEqReason ev NomEq -> solveIrredEquality ShapeMismatchReason ev } - -- No need to call canEqFailure/canEqHardFailure because they + -- No need to call canEqSoftFailure/canEqHardFailure because they -- rewrite, and the types involved here are already rewritten @@ -720,33 +727,31 @@ canEqCast rewritten ev eq_rel swapped ty1 co1 ty2 ps_ty2 ------------------------ canTyConApp :: CtEvidence -> EqRel + -> Bool -- Both TyCons are generative -> TyCon -> [TcType] -> TyCon -> [TcType] -> TcS (StopOrContinue Ct) -- See Note [Decomposing TyConApp equalities] -- Neither tc1 nor tc2 is a saturated funTyCon, nor a type family -- But they can be data families. -canTyConApp ev eq_rel tc1 tys1 tc2 tys2 +canTyConApp ev eq_rel both_generative tc1 tys1 tc2 tys2 | tc1 == tc2 , tys1 `equalLength` tys2 = do { inerts <- getTcSInerts ; if can_decompose inerts then canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2 - else canEqFailure ev eq_rel ty1 ty2 } + else canEqSoftFailure ev eq_rel ty1 ty2 } -- See Note [Skolem abstract data] in GHC.Core.Tycon | tyConSkolem tc1 || tyConSkolem tc2 = do { traceTcS "canTyConApp: skolem abstract" (ppr tc1 $$ ppr tc2) ; solveIrredEquality AbstractTyConReason ev } - -- Fail straight away for better error messages - -- See Note [Use canEqFailure in canDecomposableTyConApp] - | eq_rel == ReprEq && not (isGenerativeTyCon tc1 Representational && - isGenerativeTyCon tc2 Representational) - = canEqFailure ev eq_rel ty1 ty2 - - | otherwise - = canEqHardFailure ev ty1 ty2 + | otherwise -- Different TyCons + = if both_generative -- See (TC2) and (TC3) in + -- Note [Canonicalising TyCon/TyCon equalities] + then canEqHardFailure ev ty1 ty2 + else canEqSoftFailure ev eq_rel ty1 ty2 where -- Reconstruct the types for error messages. This would do -- the wrong thing (from a pretty printing point of view) @@ -768,37 +773,42 @@ canTyConApp ev eq_rel tc1 tys1 tc2 tys2 ctEvFlavour ev == Wanted && noGivenNewtypeReprEqs tc1 inerts) -- See Note [Decomposing newtype equalities] (EX2) -{- -Note [Use canEqFailure in canDecomposableTyConApp] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We must use canEqFailure, not canEqHardFailure here, because there is -the possibility of success if working with a representational equality. -Here is one case: +{- Note [Canonicalising TyCon/TyCon equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int -Suppose we are canonicalising (Int ~R DF (TF a)), where we don't yet -know `a`. This is *not* a hard failure, because we might soon learn -that `a` is, in fact, Char, and then the equality succeeds. +Suppose we are canonicalising [W] Int ~R# DF (TF a). Then -Here is another case: +(TC1) We might have an inert Given (a ~# Char), so if we rewrote the wanted + (i.e. went around again in `can_eq_nc` with `rewritten`=True, we'd get + [W] Int ~R# DF Bool + and then the `tcTopNormaliseNewTypeTF_maybe` call would fire and + we'd unwrap the newtype. So we must do that "go round again" bit. + Hence the complicated guard (rewritten || both_generative) in `can_eq_nc`. - [G] Age ~R Int +(TC2) If we can't rewrite `a` yet, we'll finish with an unsolved + [W] Int ~R# DF (TF a) + in the inert set. But we must use canEqSoftFailure, not canEqHardFailure, + because it might be solved "later" when we learn more about `a`. + Hence the use of `both_generative` in `canTyConApp`. -where Age's constructor is not in scope. We don't want to report -an "inaccessible code" error in the context of this Given! +(TC3) Here's another example: + [G] Age ~R# Int + where Age's constructor is not in scope. We don't want to report + an "inaccessible code" error in the context of this Given! So again + we want `canEqSoftFailure`. -For example, see typecheck/should_compile/T10493, repeated here: + For example, see typecheck/should_compile/T10493, repeated here: + import Data.Ord (Down) -- no constructor + foo :: Coercible (Down Int) Int => Down Int -> Int + foo = coerce - import Data.Ord (Down) -- no constructor - - foo :: Coercible (Down Int) Int => Down Int -> Int - foo = coerce - -That should compile, but only because we use canEqFailure and not -canEqHardFailure. + That should compile, but only because we use canEqSoftFailure and + not canEqHardFailure. Note [Fast path when decomposing TyConApps] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1289,20 +1299,19 @@ canDecomposableFunTy ev eq_rel af f1@(m1,a1,r1) f2@(m2,a2,r2) loc = ctEvLoc ev role = eqRelRole eq_rel --- | Call when canonicalizing an equality fails, but if the equality is --- representational, there is some hope for the future. --- Examples in Note [Use canEqFailure in canDecomposableTyConApp] -canEqFailure :: CtEvidence -> EqRel - -> TcType -> TcType -> TcS (StopOrContinue Ct) -canEqFailure ev NomEq ty1 ty2 +-- | Call canEqSoftFailure when canonicalizing an equality fails, but if the +-- equality is representational, there is some hope for the future. +canEqSoftFailure :: CtEvidence -> EqRel + -> TcType -> TcType -> TcS (StopOrContinue Ct) +canEqSoftFailure ev NomEq ty1 ty2 = canEqHardFailure ev ty1 ty2 -canEqFailure ev ReprEq ty1 ty2 +canEqSoftFailure ev ReprEq ty1 ty2 = do { (redn1, rewriters1) <- rewrite ev ty1 ; (redn2, rewriters2) <- rewrite ev ty2 -- We must rewrite the types before putting them in the -- inert set, so that we are sure to kick them out when -- new equalities become available - ; traceTcS "canEqFailure with ReprEq" $ + ; traceTcS "canEqSoftFailure with ReprEq" $ vcat [ ppr ev, ppr redn1, ppr redn2 ] ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 ; continueWith (mkIrredCt ReprEqReason new_ev) } ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -33,11 +33,10 @@ Compiler - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking - the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket - #22448 for further details. + the specification described in the documentation of the `INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. - Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. - See GHC ticket #23049. + See :ghc-ticket:`23049`. - The ``-Wno-⟨wflag⟩``, ``-Werror=⟨wflag⟩`` and ``-Wwarn=⟨wflag⟩`` options are now defined systematically for all warning groups (for example, @@ -121,7 +120,7 @@ Runtime system ~~~~~~~~~~~~~~ - On POSIX systems that support timerfd, RTS shutdown no longer has to wait for - the next RTS 'tick' to occur before continuing the shutdown process. See #22692. + the next RTS 'tick' to occur before continuing the shutdown process. See :ghc-ticket:`22692`. ``base`` library ~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -287,7 +287,7 @@ would invoke GHC like this: Plugins can be also be loaded from libraries directly. It allows plugins to be -loaded in cross-compilers (as a workaround for #14335). +loaded in cross-compilers (as a workaround for :ghc-ticket:`14335`). .. ghc-flag:: -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩ :shortdesc: Load a pre-compiled static plugin from an external library ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -262,7 +262,7 @@ From a semantic point of view: {-# RULES forall @m (x :: KnownNat m => Proxy m). g x = blah #-} - See `#21093 `_ for discussion. + See :ghc-ticket:`21093` for discussion. .. _rules-inline: ===================================== docs/users_guide/exts/template_haskell.rst ===================================== @@ -135,7 +135,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under spliced expression must have type ``Code Q a`` **NOTE**: Currently typed splices may inhibit the unused identifier warning for - identifiers in scope. See `#16524 ` + identifiers in scope. See :ghc-ticket:`16524`. - A *typed* expression quotation is written as ``[|| ... ||]``, or ``[e|| ... ||]``, where the "..." is an expression; if the "..." ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1691,7 +1691,7 @@ as such you shouldn't need to set any of them explicitly. A flag overhead for the check disappears completely. This can cause slight codesize increases. It will also cause many more functions - to get a worker/wrapper split which can play badly with rules (see Ticket #20364) + to get a worker/wrapper split which can play badly with rules (see :ghc-ticket:`20364`) which is why it's currently disabled by default. In particular if you depend on rules firing on functions marked as NOINLINE without marking use sites of these functions as INLINE or INLINEABLE then things will break ===================================== testsuite/tests/indexed-types/should_compile/T23408.hs ===================================== @@ -0,0 +1,42 @@ +{-# LANGUAGE TypeFamilies, TypeApplications, GADTs, FunctionalDependencies, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} + +module T23408 where + +import Data.Coerce +import Data.Proxy + +f :: Proxy a -> Key a -> Maybe () +f _ _ = Nothing + +g :: Key a -> Proxy a -> Maybe () +g _ _ = Nothing + +data User + +data family Key a + +newtype instance Key User = UserKey String + +class Convert lhs result where + convert :: Proxy lhs -> Proxy result + +instance (rec ~ rec') => Convert rec rec' where + convert _ = Proxy + +a :: Maybe () +a = f (convert @User Proxy) (coerce "asdf") + +{- Typechecking `a` + + convert @User Proxy :: Proxy alpha + [W] Convert User alpha + coerce "asdf" :: Key alpha + [W] Coercible String (Key alpha) + + Solve [W] Convert User alpha ==> [W] User ~ alpha + [W] Coercible String (Key User) +-} + +b :: Maybe () +b = g (coerce "asdf") (convert @User Proxy) + ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -308,3 +308,4 @@ test('T4254', normal, compile, ['']) test('T22547', normal, compile, ['']) test('T22717', normal, makefile_test, ['T22717']) test('T22717_fam_orph', normal, multimod_compile, ['T22717_fam_orph', '-v0']) +test('T23408', normal, compile, ['']) ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -131,7 +131,7 @@ test('linker_error3', [extra_files(['linker_error.c']), ###################################### test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) - , req_rts_linker + , unless(have_dynamic(), skip) # this needs runtime infrastructure to do in ghci: # '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more. , omit_ways(['ghci']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ff7788e2038160a9168466a8fd96dc1d5a9f270...d74a11115ee26942262f95a0f617945835cf2ed2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ff7788e2038160a9168466a8fd96dc1d5a9f270...d74a11115ee26942262f95a0f617945835cf2ed2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 20 07:16:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 20 May 2023 03:16:26 -0400 Subject: [Git][ghc/ghc][master] testsuite: fix predicate on rdynamic test Message-ID: <646873ca64ad8_9760a3c7f6174697233@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 1 changed file: - testsuite/tests/rts/linker/all.T Changes: ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -131,7 +131,7 @@ test('linker_error3', [extra_files(['linker_error.c']), ###################################### test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) - , req_rts_linker + , unless(have_dynamic(), skip) # this needs runtime infrastructure to do in ghci: # '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more. , omit_ways(['ghci']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6fb669028963e166ee34046c4a94dcc141f1ab9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6fb669028963e166ee34046c4a94dcc141f1ab9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 20 07:17:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 20 May 2023 03:17:07 -0400 Subject: [Git][ghc/ghc][master] docs: Use ghc-ticket directive where appropiate in users guide Message-ID: <646873f3ae374_9760a36af8940700631@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - 5 changed files: - docs/users_guide/9.8.1-notes.rst - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/using-optimisation.rst Changes: ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -33,11 +33,10 @@ Compiler - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking - the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket - #22448 for further details. + the specification described in the documentation of the `INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. - Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. - See GHC ticket #23049. + See :ghc-ticket:`23049`. - The ``-Wno-⟨wflag⟩``, ``-Werror=⟨wflag⟩`` and ``-Wwarn=⟨wflag⟩`` options are now defined systematically for all warning groups (for example, @@ -121,7 +120,7 @@ Runtime system ~~~~~~~~~~~~~~ - On POSIX systems that support timerfd, RTS shutdown no longer has to wait for - the next RTS 'tick' to occur before continuing the shutdown process. See #22692. + the next RTS 'tick' to occur before continuing the shutdown process. See :ghc-ticket:`22692`. ``base`` library ~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -287,7 +287,7 @@ would invoke GHC like this: Plugins can be also be loaded from libraries directly. It allows plugins to be -loaded in cross-compilers (as a workaround for #14335). +loaded in cross-compilers (as a workaround for :ghc-ticket:`14335`). .. ghc-flag:: -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩ :shortdesc: Load a pre-compiled static plugin from an external library ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -262,7 +262,7 @@ From a semantic point of view: {-# RULES forall @m (x :: KnownNat m => Proxy m). g x = blah #-} - See `#21093 `_ for discussion. + See :ghc-ticket:`21093` for discussion. .. _rules-inline: ===================================== docs/users_guide/exts/template_haskell.rst ===================================== @@ -135,7 +135,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under spliced expression must have type ``Code Q a`` **NOTE**: Currently typed splices may inhibit the unused identifier warning for - identifiers in scope. See `#16524 ` + identifiers in scope. See :ghc-ticket:`16524`. - A *typed* expression quotation is written as ``[|| ... ||]``, or ``[e|| ... ||]``, where the "..." is an expression; if the "..." ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1691,7 +1691,7 @@ as such you shouldn't need to set any of them explicitly. A flag overhead for the check disappears completely. This can cause slight codesize increases. It will also cause many more functions - to get a worker/wrapper split which can play badly with rules (see Ticket #20364) + to get a worker/wrapper split which can play badly with rules (see :ghc-ticket:`20364`) which is why it's currently disabled by default. In particular if you depend on rules firing on functions marked as NOINLINE without marking use sites of these functions as INLINE or INLINEABLE then things will break View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/735d504ee4d7a0635d9baaa76d28673cf3947dd4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/735d504ee4d7a0635d9baaa76d28673cf3947dd4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 20 09:58:02 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 20 May 2023 05:58:02 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] CmmInt 0 should refer to zero register Message-ID: <646899aadeb8c_9760a4b15327c709829@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: a08a160d by Sven Tennie at 2023-05-20T11:57:23+02:00 CmmInt 0 should refer to zero register A constant 0 can always be taken from the zero register. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - + tests/compiler/cmm/zero.cmm Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -499,7 +499,7 @@ getRegister' config plat expr CmmLit lit -> case lit of - -- TODO handle CmmInt 0 specially, use wzr or xzr. + CmmInt 0 w -> pure $ Fixed (intFormat w) zero_reg nilOL CmmInt i W8 | i >= 0 -> do return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -793,14 +793,14 @@ opReg :: Width -> Reg -> Operand opReg = OpReg ra_reg, sp_reg :: Reg +zero_reg = RegReal (RealRegSingle 0) ra_reg = RegReal (RealRegSingle 1) sp_reg = RegReal (RealRegSingle 2) -xzr, wzr, sp, ip0 :: Operand -xzr = OpReg W64 (RegReal (RealRegSingle 0)) -wzr = OpReg W32 (RegReal (RealRegSingle 0)) -ra = OpReg W64 (RegReal (RealRegSingle 1)) -sp = OpReg W64 (RegReal (RealRegSingle 2)) +zero, sp, ip0 :: Operand +zero = OpReg W64 zero_reg +ra = OpReg W64 ra_reg +sp = OpReg W64 sp_reg gp = OpReg W64 (RegReal (RealRegSingle 3)) tp = OpReg W64 (RegReal (RealRegSingle 4)) fp = OpReg W64 (RegReal (RealRegSingle 8)) ===================================== tests/compiler/cmm/zero.cmm ===================================== @@ -0,0 +1,14 @@ +// RUN: "$HC" -cpp -dcmm-lint -keep-s-file -c "$1" && cat "${1%%.*}.s" | FileCheck "$1" -check-prefix=CHECK-RV64 +// RUN: "$CC" "${1%%.*}.o" -o "${1%%.*}.exe" +// RUN: "$EXEC" "${1%%.cmm}.exe" + +#include "Cmm.h" +#include "Types.h" + +main(){ + I64 zero; + // Should refer to the zero register + // CHECK-RV64: addi t0, zero, 0 + zero = 0; + foreign "C" exit(zero); +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a08a160d8bd504e80348c31c0a08844a385a1ee5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a08a160d8bd504e80348c31c0a08844a385a1ee5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 20 10:39:56 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 20 May 2023 06:39:56 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] 3 commits: testsuite: fix predicate on rdynamic test Message-ID: <6468a37ce6931_9760a4b15329071362b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - e01bab47 by Simon Peyton Jones at 2023-05-20T11:39:44+01:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 22 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0771121e40f2d04a99a8002223e925d685562a1d...e01bab47baaa649353240e00fa537e15e5942457 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0771121e40f2d04a99a8002223e925d685562a1d...e01bab47baaa649353240e00fa537e15e5942457 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 20 19:05:31 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sat, 20 May 2023 15:05:31 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] accept new output for T23398 Message-ID: <646919fb3b972_9760a4af5e340746549@gitlab.mail> Matthew Craven pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: cd59cd32 by Matthew Craven at 2023-05-20T15:04:20-04:00 accept new output for T23398 - - - - - 1 changed file: - testsuite/tests/stranal/should_compile/T23398.stderr Changes: ===================================== testsuite/tests/stranal/should_compile/T23398.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core -- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} T23398.$wfoo [InlPrag=[2]] - :: forall {a}. (Eq a, Show a) => a -> a -> String + :: forall a. (Eq a, Show a) => a -> a -> String [GblId[StrictWorker([!, !])], Arity=4, Str=, @@ -41,7 +41,7 @@ foo Rec { -- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} T23398.$wbar [InlPrag=[2], Occ=LoopBreaker] - :: forall {a} {b}. + :: forall a b. (a GHC.Prim.~# b, Show a) => GHC.Prim.Int# -> a -> (# b, String #) [GblId[StrictWorker([~, !])], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd59cd32042db4c5bdbc0504e1b27a52651a800c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd59cd32042db4c5bdbc0504e1b27a52651a800c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 20 23:03:19 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Sat, 20 May 2023 19:03:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/more-dynflags-imports Message-ID: <646951b791f41_9760a4af5e340761416@gitlab.mail> Oleg Grenrus pushed new branch wip/more-dynflags-imports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/more-dynflags-imports You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 03:17:08 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Sat, 20 May 2023 23:17:08 -0400 Subject: [Git][ghc/ghc][wip/more-dynflags-imports] Change GHC.Driver.Session import to .DynFlags Message-ID: <64698d34cb396_9760a4b1532907706d6@gitlab.mail> Oleg Grenrus pushed to branch wip/more-dynflags-imports at Glasgow Haskell Compiler / GHC Commits: 6766907e by Oleg Grenrus at 2023-05-21T06:16:59+03:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 30 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Config/HsToCore.hs - compiler/GHC/Driver/Config/Linker.hs - compiler/GHC/Driver/Config/Stg/Debug.hs - compiler/GHC/Driver/Config/Stg/Lift.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Config/Tidy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6766907e40de2e37a3730cd9708c3eec0c5fd46a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6766907e40de2e37a3730cd9708c3eec0c5fd46a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 15:53:46 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 21 May 2023 11:53:46 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix signed shift right Message-ID: <646a3e8a72c9d_9760a4b31b03c806251@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 6c908960 by Sven Tennie at 2023-05-21T17:52:50+02:00 Fix signed shift right This includes overhauling the sign extension and width truncation logic. - - - - - 4 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - + tests/compiler/cmm/shift_right.cmm Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -201,7 +201,7 @@ ann doc instr {- debugIsOn -} = ANN doc instr -- forced until we actually force them, and without -dppr-debug they should -- never end up being forced. annExpr :: CmmExpr -> Instr -> Instr -annExpr e instr {- debugIsOn -} = ANN (text . show $ e) instr +annExpr e {- debugIsOn -} = ANN (text . show $ e) -- annExpr e instr {- debugIsOn -} = ANN (pprExpr genericPlatform e) instr -- annExpr _ instr = instr {-# INLINE annExpr #-} @@ -708,24 +708,20 @@ getRegister' config plat expr return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | fitsIn12bitImm n -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> - code_x `appOL` toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w))) - , STR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , LDR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , ADD sp sp (OpImm (ImmInt (widthInBits w))) - , ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) - ]) + (reg_x, format_x, code_x) <- getSomeReg x + (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x + return $ Any (intFormat w) ( + \dst -> + code_x `appOL` code_x' `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n))) + ) CmmMachOp (MO_S_Shr w) [x, y] -> do - (reg_x, _format_x, code_x) <- getSomeReg x + (reg_x, format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> - code_x `appOL` code_y `appOL` toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w))) - , STR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , LDR (intFormat w) (OpReg w reg_x) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , ADD sp sp (OpImm (ImmInt (widthInBits w))) - , ASR (OpReg w dst) (OpReg w reg_y) (OpImm (ImmInteger 0)) - ]) + (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x + return $ Any (intFormat w) ( + \dst -> + code_x `appOL` code_x' `appOL` code_y `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y)) + ) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x @@ -752,7 +748,7 @@ getRegister' config plat expr return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) -- 3. Logic &&, || - CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | fitsIn12bitImm n -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (AND (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg @@ -934,17 +930,6 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) - -- FIXME: These are wrong, they are for AArch64, not RISCV! I'm not even sure we need them for RISCV - isBitMaskImmediate :: Integer -> Bool - isBitMaskImmediate i = i `elem` [0b0000_0001, 0b0000_0010, 0b0000_0100, 0b0000_1000, 0b0001_0000, 0b0010_0000, 0b0100_0000, 0b1000_0000 - ,0b0000_0011, 0b0000_0110, 0b0000_1100, 0b0001_1000, 0b0011_0000, 0b0110_0000, 0b1100_0000 - ,0b0000_0111, 0b0000_1110, 0b0001_1100, 0b0011_1000, 0b0111_0000, 0b1110_0000 - ,0b0000_1111, 0b0001_1110, 0b0011_1100, 0b0111_1000, 0b1111_0000 - ,0b0001_1111, 0b0011_1110, 0b0111_1100, 0b1111_1000 - ,0b0011_1111, 0b0111_1110, 0b1111_1100 - ,0b0111_1111, 0b1111_1110 - ,0b1111_1111] - -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register do_mul_may_oflo w at W64 x y = do @@ -984,35 +969,49 @@ getRegister' config plat expr mul (OpReg tmp_w tmp) (OpReg w reg_x) (OpReg w reg_y) `snocOL` CSET (OpReg w dst) (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) NE) +-- TODO: Some cases can surely be implemented with shifts and SEXT.W. This would +-- save 2 (expensive) memory accesses! -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) -signExtendReg w w' r = - case w of - W64 -> noop - W32 - | w' == W32 -> noop - | otherwise -> extend SXTH - W16 -> extend SXTH - W8 -> extend SXTB - _ -> panic "intOp" - where - noop = return (r, nilOL) - extend instr = do - r' <- getNewRegNat II64 - return (r', unitOL $ instr (OpReg w' r') (OpReg w' r)) +signExtendReg w _w' r | w == W64 = pure (r, nilOL) +signExtendReg _w w' _r | w' > W64 = pprPanic "Cannot sign extend to width bigger than register size:" (ppr w') +signExtendReg w _w' r | w > W64 = pprPanic "Unexpected register size (max is 64bit):" $ text (show r) <> char ':' <+> ppr w +signExtendReg w w' r | w == W32 && w' == W64 = + -- `ADDIW r r 0` is the pseudo-op SEXT.W + pure (r, unitOL $ + ann (text "sign-extend register" <+> ppr r <+> ppr w <> text "->" <> ppr w') + (ADD (OpReg w' r) (OpReg w r) (OpImm (ImmInt 0))) + ) +signExtendReg w w' r = do + r' <- getNewRegNat (intFormat w') + let instrs = toOL [ann (text "sign-extend register" <+> ppr r <+> ppr w <> text "->" <> ppr w') + (SUB sp sp (OpImm (ImmInt (widthInBits w)))) + -- loading (LW, LH, LB) sign extends to 64bit + , STR (intFormat w) (OpReg w r) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) + , LDR (intFormat w) (OpReg w r) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) + , ADD sp sp (OpImm (ImmInt (widthInBits w))) + -- ADD to move the result to r', which has the correct width / format + , ADD (OpReg w' r') (OpReg w r) zero + ] + pure (r', instrs) -- | Instructions to truncate the value in the given register from width @w@ -- down to width @w'@. +-- N.B.: This ignores signedness! truncateReg :: Width -> Width -> Reg -> OrdList Instr -truncateReg w _w' _r | w == W64 = nilOL +truncateReg _w w' _r | w' == W64 = nilOL +truncateReg _w w' r | w' > W64 = pprPanic "Cannot truncate to width bigger than register size (max is 64bit):" $ text (show r) <> char ':' <+> ppr w' +truncateReg w _w' r | w > W64 = pprPanic "Unexpected register size (max is 64bit):" $ text (show r) <> char ':' <+> ppr w +truncateReg w w' _r | w < w' = pprPanic "This is not a truncation." $ ppr w <+> char '<' <+> ppr w' truncateReg w w' _r | w == w' = nilOL -truncateReg w w' r = - toOL [ SUB sp sp (OpImm (ImmInt (widthInBits w))) - , STR (intFormat w) (OpReg w r) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , LDR (intFormat w') (OpReg w' r) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , ADD sp sp (OpImm (ImmInt (widthInBits w))) - ] +truncateReg w w' r = toOL [ann (text "truncate register" <+> ppr r <+> ppr w <> text "->" <> ppr w') + (LSL (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift))) + -- SHL ignores signedness! + , LSR (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift)) + ] + where + shift = 64 - (widthInBits w - widthInBits w') -- ----------------------------------------------------------------------------- -- The 'Amode' type: Memory addressing modes passed up the tree. ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -94,7 +94,6 @@ regUsageOfInstr platform instr = case instr of -- 2. Bit Manipulation Instructions ------------------------------------------ SBFM dst src _ _ -> usage (regOp src, regOp dst) UBFM dst src _ _ -> usage (regOp src, regOp dst) - SBFX dst src _ _ -> usage (regOp src, regOp dst) UBFX dst src _ _ -> usage (regOp src, regOp dst) SXTB dst src -> usage (regOp src, regOp dst) UXTB dst src -> usage (regOp src, regOp dst) @@ -234,7 +233,6 @@ patchRegsOfInstr instr env = case instr of -- 2. Bit Manipulation Instructions ---------------------------------------- SBFM o1 o2 o3 o4 -> SBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) UBFM o1 o2 o3 o4 -> UBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) - SBFX o1 o2 o3 o4 -> SBFX (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) UBFX o1 o2 o3 o4 -> UBFX (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) SXTB o1 o2 -> SXTB (patchOp o1) (patchOp o2) UXTB o1 o2 -> UXTB (patchOp o1) (patchOp o2) @@ -632,7 +630,6 @@ data Instr -- UXTB = UBFM , , #0, #7 -- UXTH = UBFM , , #0, #15 -- Signed/Unsigned bitfield extract - | SBFX Operand Operand Operand Operand -- rd = rn[i,j] | UBFX Operand Operand Operand Operand -- rd = rn[i,j] -- 3. Logical and Move Instructions ---------------------------------------- @@ -717,7 +714,6 @@ instrCon i = UDIV{} -> "UDIV" SBFM{} -> "SBFM" UBFM{} -> "UBFM" - SBFX{} -> "SBFX" UBFX{} -> "UBFX" AND{} -> "AND" -- ANDS{} -> "ANDS" ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -456,6 +456,8 @@ pprInstr platform instr = case instr of -- 1. Arithmetic Instructions ------------------------------------------------ ADD o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd") o1 o2 o3 + -- This case is used for sign extension. + | OpReg W64 _ <- o1 , OpReg w _ <- o2, w < W64, isImmOp o3 -> op3 (text "\taddiw") o1 o2 o3 | otherwise -> op3 (text "\tadd") o1 o2 o3 -- CMN o1 o2 -> op2 (text "\tcmn") o1 o2 -- CMP o1 o2 @@ -487,7 +489,6 @@ pprInstr platform instr = case instr of SBFM o1 o2 o3 o4 -> op4 (text "\tsbfm") o1 o2 o3 o4 UBFM o1 o2 o3 o4 -> op4 (text "\tubfm") o1 o2 o3 o4 -- signed and unsigned bitfield extract - SBFX o1 o2 o3 o4 -> op4 (text "\tsbfx") o1 o2 o3 o4 UBFX o1 o2 o3 o4 -> op4 (text "\tubfx") o1 o2 o3 o4 SXTB o1 o2 -> op2 (text "\tsxtb") o1 o2 UXTB o1 o2 -> op2 (text "\tuxtb") o1 o2 ===================================== tests/compiler/cmm/shift_right.cmm ===================================== @@ -0,0 +1,24 @@ +// RUN: "$HC" -debug -dppr-debug -cpp -dcmm-lint -keep-s-file -O0 -c "$1" && cat "${1%%.*}.s" | FileCheck "$1" -check-prefix=CHECK-RV64 +// RUN: "$CC" "${1%%.*}.o" -o "${1%%.*}.exe" +// RUN: "$EXEC" "${1%%.cmm}.exe" + +#include "Cmm.h" +#include "Types.h" + +main() { + I64 buffer; + I32 a, b, c, d; + + I64 arr; + (arr) = foreign "C" malloc(1024); + bits64[arr] = 2; + + a = I32[arr]; + b = %mul(a, 32 :: I32); + c = %neg(b); + d = %shra(c, 4::I64); + + foreign "C" printf("a: %hd b: %hd c: %hd d: %hd", a, b, c, d); + + foreign "C" exit(d == -4 :: I32); +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c908960575d8a0bc0cc65897ff347260503d7d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c908960575d8a0bc0cc65897ff347260503d7d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 17:41:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 13:41:25 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 2 commits: compiler: Rework ShowSome Message-ID: <646a57c5a7dc2_9760a4abfdc78810518@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 8dde41ea by Ben Gamari at 2023-05-21T13:41:18-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - a063fb2c by Ben Gamari at 2023-05-21T13:41:18-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 14 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - testsuite/tests/ghci/scripts/ghci008.stdout - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -762,10 +762,13 @@ When printing an interface file (--show-iface), we want to print everything unqualified, so we can just print the OccName directly. -} +-- | Show a declaration but not its RHS. showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing , ss_forall = ShowForAllWhen } +-- | Show declaration and its RHS, including GHc-internal information (e.g. +-- for @--show-iface@). showToIface :: ShowSub showToIface = ShowSub { ss_how_much = ShowIface , ss_forall = ShowForAllWhen } @@ -776,18 +779,20 @@ ppShowIface _ _ = Outputable.empty -- show if all sub-components or the complete interface is shown ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- See Note [Minimal complete definition] -ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc -ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowAllSubs _ _ = Outputable.empty +ppShowAllSubs (ShowSub { ss_how_much = ShowSome Nothing _ }) doc + = doc +ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc +ppShowAllSubs _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool -showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False -showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing -showSub (ShowSub { ss_how_much = _ }) _ = True +showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False +showSub (ShowSub { ss_how_much = ShowSome (Just f) _ }) thing + = f (occName thing) +showSub (ShowSub { ss_how_much = _ }) _ = True ppr_trim :: [Maybe SDoc] -> [SDoc] -- Collapse a group of Nothings to a single "..." ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1328,21 +1328,18 @@ data ShowSub newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) data ShowHowMuch - = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment + = ShowHeader AltPpr -- ^ Header information only, not rhs + | ShowSome (Maybe (OccName -> Bool)) AltPpr + -- ^ Show the declaration and its RHS. The @Maybe@ predicate + -- allows filtering of the sub-components which should be printing; + -- any sub-components filtered out will be elided with @... at . | ShowIface - -- ^Everything including GHC-internal information (used in --show-iface) + -- ^ Everything including GHC-internal information (used in --show-iface) instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome _ _) = text "ShowSome" pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc pprIfaceSigmaType show_forall ty ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -145,16 +145,24 @@ pprTyThingHdr = pprTyThing showToHeader -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing - = go [] thing + = case parents thing of + -- If there are no parents print everything. + [] -> print_it Nothing thing + -- If `thing` has a parent, print the parent and only its child `thing` + thing':rest -> let subs = map getOccName (thing:rest) + filt = (`elem` subs) + in print_it (Just filt) thing' where - go ss thing - = case tyThingParent_maybe thing of - Just parent -> - go (getOccName thing : ss) parent - Nothing -> - pprTyThing - (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) - thing + parents = go + where + go thing = + case tyThingParent_maybe thing of + Just parent -> parent : go parent + Nothing -> [] + + print_it :: Maybe (OccName -> Bool) -> TyThing -> SDoc + print_it mb_filt thing = + pprTyThing (show_sub { ss_how_much = ShowSome mb_filt (AltPpr Nothing) }) thing -- | Like 'pprTyThingInContext', but adds the defining location. pprTyThingInContextLoc :: TyThing -> SDoc @@ -171,8 +179,8 @@ pprTyThing ss ty_thing pprIfaceDecl ss' (tyThingToIfaceDecl show_linear_types ty_thing) where ss' = case ss_how_much ss of - ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } - ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' } + ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } + ShowSome filt (AltPpr Nothing) -> ss { ss_how_much = ShowSome filt ppr' } _ -> ss ppr' = AltPpr $ ppr_bndr $ getName ty_thing ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/ghci/scripts/ghci008.stdout ===================================== @@ -40,5 +40,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ -base-4.16.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘base-4.16.0.0:Data.OldList’ +base-4.18.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.18.0.0:Data.OldList’ ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elem` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just is_exported) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4969745069e658978e74b8b6a99cf8d601413963...a063fb2c31f0633f7c75b65d244913a575949eeb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4969745069e658978e74b8b6a99cf8d601413963...a063fb2c31f0633f7c75b65d244913a575949eeb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 17:47:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 13:47:03 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 10 commits: compiler: Rework ShowSome Message-ID: <646a59175949d_9760a650832d88112c6@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 8dde41ea by Ben Gamari at 2023-05-21T13:41:18-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - a063fb2c by Ben Gamari at 2023-05-21T13:41:18-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 2cbb61fa by Ben Gamari at 2023-05-21T13:46:46-04:00 base: Introduce Data.Enum - - - - - d368d293 by Ben Gamari at 2023-05-21T13:46:46-04:00 base: Add export list to GHC.Num.Integer - - - - - 031ead73 by Ben Gamari at 2023-05-21T13:46:46-04:00 base: Add export list to GHC.Num - - - - - a0cbafc5 by Ben Gamari at 2023-05-21T13:46:46-04:00 base: Add export list to GHC.Num.Natural - - - - - 287ecd5c by Ben Gamari at 2023-05-21T13:46:46-04:00 base: Introduce Data.Show - - - - - 7580336e by Ben Gamari at 2023-05-21T13:46:46-04:00 base: Add export list to GHC.Float - - - - - 52e78847 by Ben Gamari at 2023-05-21T13:46:46-04:00 base: Add export list to GHC.Real - - - - - 075cc9eb by Ben Gamari at 2023-05-21T13:46:46-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 23 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - + libraries/base/Data/Enum.hs - + libraries/base/Data/Show.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/mk/boilerplate.mk - testsuite/tests/ghci/scripts/ghci008.stdout - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -762,10 +762,13 @@ When printing an interface file (--show-iface), we want to print everything unqualified, so we can just print the OccName directly. -} +-- | Show a declaration but not its RHS. showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing , ss_forall = ShowForAllWhen } +-- | Show declaration and its RHS, including GHc-internal information (e.g. +-- for @--show-iface@). showToIface :: ShowSub showToIface = ShowSub { ss_how_much = ShowIface , ss_forall = ShowForAllWhen } @@ -776,18 +779,20 @@ ppShowIface _ _ = Outputable.empty -- show if all sub-components or the complete interface is shown ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- See Note [Minimal complete definition] -ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc -ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowAllSubs _ _ = Outputable.empty +ppShowAllSubs (ShowSub { ss_how_much = ShowSome Nothing _ }) doc + = doc +ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc +ppShowAllSubs _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool -showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False -showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing -showSub (ShowSub { ss_how_much = _ }) _ = True +showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False +showSub (ShowSub { ss_how_much = ShowSome (Just f) _ }) thing + = f (occName thing) +showSub (ShowSub { ss_how_much = _ }) _ = True ppr_trim :: [Maybe SDoc] -> [SDoc] -- Collapse a group of Nothings to a single "..." ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1328,21 +1328,18 @@ data ShowSub newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) data ShowHowMuch - = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment + = ShowHeader AltPpr -- ^ Header information only, not rhs + | ShowSome (Maybe (OccName -> Bool)) AltPpr + -- ^ Show the declaration and its RHS. The @Maybe@ predicate + -- allows filtering of the sub-components which should be printing; + -- any sub-components filtered out will be elided with @... at . | ShowIface - -- ^Everything including GHC-internal information (used in --show-iface) + -- ^ Everything including GHC-internal information (used in --show-iface) instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome _ _) = text "ShowSome" pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc pprIfaceSigmaType show_forall ty ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -145,16 +145,24 @@ pprTyThingHdr = pprTyThing showToHeader -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing - = go [] thing + = case parents thing of + -- If there are no parents print everything. + [] -> print_it Nothing thing + -- If `thing` has a parent, print the parent and only its child `thing` + thing':rest -> let subs = map getOccName (thing:rest) + filt = (`elem` subs) + in print_it (Just filt) thing' where - go ss thing - = case tyThingParent_maybe thing of - Just parent -> - go (getOccName thing : ss) parent - Nothing -> - pprTyThing - (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) - thing + parents = go + where + go thing = + case tyThingParent_maybe thing of + Just parent -> parent : go parent + Nothing -> [] + + print_it :: Maybe (OccName -> Bool) -> TyThing -> SDoc + print_it mb_filt thing = + pprTyThing (show_sub { ss_how_much = ShowSome mb_filt (AltPpr Nothing) }) thing -- | Like 'pprTyThingInContext', but adds the defining location. pprTyThingInContextLoc :: TyThing -> SDoc @@ -171,8 +179,8 @@ pprTyThing ss ty_thing pprIfaceDecl ss' (tyThingToIfaceDecl show_linear_types ty_thing) where ss' = case ss_how_much ss of - ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } - ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' } + ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } + ShowSome filt (AltPpr Nothing) -> ss { ss_how_much = ShowSome filt ppr' } _ -> ss ppr' = AltPpr $ ppr_bndr $ getName ty_thing ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== libraries/base/Data/Enum.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum ===================================== libraries/base/Data/Show.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Show +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Show' class. +-- +----------------------------------------------------------------------------- + +module Data.Show + ( Show(..) + -- * 'ShowS' + , ShowS + , shows + , showChar, showString, showMultiLineString + , showParen, showCommaSpace, showSpace + , showLitChar, showLitString + ) where + +import GHC.Show + ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,109 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int + , int2Float + , word2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorFloat + , ceilingFloat + , truncateFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , eqFloat, gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , powerFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , word2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , eqDouble, gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , powerDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Internal + , stgFloatToWord32 + , stgWord32ToFloat + , stgDoubleToWord64 + , stgWord64ToDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Num.hs ===================================== @@ -18,7 +18,9 @@ module GHC.Num - ( module GHC.Num + ( Num(..) + , subtract + , quotRemInteger , module GHC.Num.Integer , module GHC.Num.Natural -- reexported for backward compatibility ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,68 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + , mkRationalWithExponentBase + , FractionalExponentBase(..) + ) where #include "MachDeps.h" ===================================== libraries/base/base.cabal ===================================== @@ -127,6 +127,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 @@ -151,6 +152,7 @@ Library Data.Proxy Data.Ratio Data.Semigroup + Data.Show Data.STRef Data.STRef.Lazy Data.STRef.Strict ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -20,7 +20,131 @@ -- -- The 'Integer' type. -module GHC.Num.Integer where +module GHC.Num.Integer + ( Integer(..) + , integerCheck + , integerCheck# + + -- * Useful constants + , integerZero + , integerOne + + -- * Conversion with... + -- ** 'Int' + , integerFromInt# + , integerFromInt + , integerToInt# + , integerToInt + -- ** 'BigNat' + , integerFromBigNat# + , integerFromBigNatNeg# + , integerFromBigNatSign# + , integerToBigNatSign# + , integerToBigNatClamp# + -- ** 'Word' + , integerFromWord# + , integerFromWord + , integerFromWordNeg# + , integerFromWordSign# + , integerToWord# + , integerToWord + -- ** 'Natural' + , integerFromNatural + , integerToNaturalClamp + , integerToNatural + , integerToNaturalThrow + -- ** 'Int64'/'Word64' + , integerFromInt64# + , integerFromWord64# + , integerToInt64# + , integerToWord64# + -- ** Floating-point + , integerDecodeDouble# + , integerEncodeDouble# + , integerEncodeDouble + , integerEncodeFloat# + -- ** 'Addr#' + , integerToAddr# + , integerToAddr + , integerFromAddr# + , integerFromAddr + -- ** Limbs + , integerFromWordList + , integerToMutableByteArray# + , integerToMutableByteArray + , integerFromByteArray# + , integerFromByteArray + + -- * Predicates + , integerIsNegative# + , integerIsNegative + , integerIsZero + , integerIsOne + + -- * Comparison + , integerNe + , integerEq + , integerLe + , integerLt + , integerGt + , integerGe + , integerEq# + , integerNe# + , integerGt# + , integerLe# + , integerLt# + , integerGe# + , integerCompare + + -- * Arithmetic + , integerSub + , integerAdd + , integerMul + , integerNegate + , integerAbs + , integerSignum + , integerSignum# + , integerQuotRem# + , integerQuotRem + , integerQuot + , integerRem + , integerDivMod# + , integerDivMod + , integerDiv + , integerMod + , integerGcd + , integerLcm + , integerSqr + , integerLog2# + , integerLog2 + , integerLogBaseWord# + , integerLogBaseWord + , integerLogBase# + , integerLogBase + , integerIsPowerOf2# + , integerGcde# + , integerGcde + , integerRecipMod# + , integerPowMod# + + -- * Bit operations + , integerPopCount# + , integerBit# + , integerBit + , integerTestBit# + , integerTestBit + , integerShiftR# + , integerShiftR + , integerShiftL# + , integerShiftL + , integerOr + , integerXor + , integerAnd + , integerComplement + + -- * Miscellaneous + , integerSizeInBase# + ) where #include "MachDeps.h" #include "WordSize.h" ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -8,7 +8,109 @@ #include "MachDeps.h" #include "WordSize.h" -module GHC.Num.Natural where +module GHC.Num.Natural + ( Natural(..) + , naturalCheck# + , naturalCheck + + -- * Useful constants + , naturalZero + , naturalOne + + -- * Predicates + , naturalIsZero + , naturalIsOne + , naturalIsPowerOf2# + + -- * Conversion with... + -- ** 'BigNat' + , naturalFromBigNat# + , naturalToBigNat# + -- ** 'Word' + , naturalFromWord# + , naturalFromWord2# + , naturalFromWord + , naturalToWord# + , naturalToWord + , naturalToWordClamp# + , naturalToWordClamp + , naturalToWordMaybe# + -- ** Limbs + , naturalFromWordList + , naturalToMutableByteArray# + , naturalFromByteArray# + -- ** Floating point + , naturalEncodeDouble# + , naturalEncodeFloat# + -- ** 'Addr#' + , naturalToAddr# + , naturalToAddr + , naturalFromAddr# + , naturalFromAddr + + -- * Comparison + , naturalEq# + , naturalEq + , naturalNe# + , naturalNe + , naturalGe# + , naturalGe + , naturalLe# + , naturalLe + , naturalGt# + , naturalGt + , naturalLt# + , naturalLt + , naturalCompare + + -- * Bit operations + , naturalPopCount# + , naturalPopCount + , naturalShiftR# + , naturalShiftR + , naturalShiftL# + , naturalShiftL + , naturalAnd + , naturalAndNot + , naturalOr + , naturalXor + , naturalTestBit# + , naturalTestBit + , naturalBit# + , naturalBit + , naturalSetBit# + , naturalSetBit + , naturalClearBit# + , naturalClearBit + , naturalComplementBit# + , naturalComplementBit + + -- * Arithmetic + , naturalAdd + , naturalSub + , naturalSubThrow + , naturalSubUnsafe + , naturalMul + , naturalSqr + , naturalSignum + , naturalNegate + , naturalQuotRem# + , naturalQuotRem + , naturalQuot + , naturalRem + , naturalGcd + , naturalLcm + , naturalLog2# + , naturalLog2 + , naturalLogBaseWord# + , naturalLogBaseWord + , naturalLogBase# + , naturalLogBase + , naturalPowMod + + -- * Miscellaneous + , naturalSizeInBase# + ) where import GHC.Prim import GHC.Types ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/ghci/scripts/ghci008.stdout ===================================== @@ -40,5 +40,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ -base-4.16.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘base-4.16.0.0:Data.OldList’ +base-4.18.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.18.0.0:Data.OldList’ ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elem` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just is_exported) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/437a38c2edad016c8841327f3884177b00312b38...075cc9ebe94795f8661c4ff1085e514e2f58c5b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/437a38c2edad016c8841327f3884177b00312b38...075cc9ebe94795f8661c4ff1085e514e2f58c5b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 18:10:32 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 14:10:32 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.6-gc Message-ID: <646a5e988548b_9760a4b504b7882049@gitlab.mail> Ben Gamari deleted branch wip/backports-9.6-gc at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 18:10:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 14:10:34 -0400 Subject: [Git][ghc/ghc][ghc-9.6] 44 commits: nonmoving: Fix style Message-ID: <646a5e9a82c1_9760a4dab370c8206fb@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: 14414247 by Ben Gamari at 2023-05-18T16:00:10-04:00 nonmoving: Fix style (cherry picked from commit abb6070f488120aef113b686e91b439fe6c3d272) - - - - - 4200590a by Ben Gamari at 2023-05-18T16:00:10-04:00 nonmoving: Deduplicate assertion (cherry picked from commit be2789014b208db5c471ab187e7dba2ebc59f8c8) - - - - - 80208941 by Ben Gamari at 2023-05-18T16:00:10-04:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. (cherry picked from commit b90346392f5455bc4a6f6d86700296babc429a98) - - - - - 0a25b9df by Ben Gamari at 2023-05-18T16:00:10-04:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. (cherry picked from commit da7b2b941d235a284d5685829c235a9e671a0336) - - - - - a70c277a by Ben Gamari at 2023-05-18T16:00:10-04:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. (cherry picked from commit 5b7f65767fbc2967e01a13ee580598e976f5d225) - - - - - b4e5489f by Ben Gamari at 2023-05-18T16:00:10-04:00 rts/Sanity: Mark pinned_object_blocks (cherry picked from commit 6283144fb2e98f4c774950567e55575c1747d136) - - - - - 2ab18a83 by Ben Gamari at 2023-05-18T16:00:11-04:00 rts/Sanity: Look at nonmoving saved_filled lists (cherry picked from commit 9b52840412c920a1a1eed26df37262bc6c82c171) - - - - - 556c2544 by Ben Gamari at 2023-05-18T16:00:11-04:00 Evac: Squash data race in eval_selector_chain (cherry picked from commit 0edc543834d8172e54020c5272af1cf2d0b3437c) - - - - - 4023f814 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. (cherry picked from commit 7eab831a7d17eda3108da4702a447656cd62334c) - - - - - 88cc3f94 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Clarify comment (cherry picked from commit 532262b95b2eaa685a22279a8e54cc2e379e21ef) - - - - - f5a48ce6 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Add missing no-op in busy-wait loop (cherry picked from commit bd9cd84bbbb51f21c7b2b478e1f5971e2659b9fd) - - - - - 5c4aa7e2 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. (cherry picked from commit c4e6bfc801a79b73e94d363db1d3e65076e17981) - - - - - 661da5ee by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. (cherry picked from commit 92227b6022b35d87f6366c75e09ed495b7c3603e) - - - - - 568b2523 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Sanity check nonmoving large objects and compacts (cherry picked from commit ba7e7972ae14848a9ac41d5c6200d0aa5727ed72) - - - - - ce560ce4 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. (cherry picked from commit 71b038a1261754c38cf984f7c578621c3217c3bf) - - - - - a01dc8ab by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Don't show occupancy if we didn't collect live words (cherry picked from commit 99d144d56598965daba30aa73e6c598b3245bb0f) - - - - - 762f6ae1 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. (cherry picked from commit 81d6cc551c7a843002495d3ffd2373ad00a52766) - - - - - 395b8572 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Assert state of swept segments (cherry picked from commit 58e53bc4d33dad76b3250997f1a8300d0041f387) - - - - - 6208cbae by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. (cherry picked from commit 2db92e015655e7fc22e559020572bf23233ffaae) - - - - - 471b5fdc by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. (cherry picked from commit e4c3249f00a406a406b6f1190ca8be628b643042) - - - - - 229ae7e4 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. (cherry picked from commit 1b06967176559d6b2b530dd16e127fa4479ae47f) - - - - - 8f39f2b3 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Post-sweep sanity checking (cherry picked from commit d4032690a8bf638f6d134cc6592d138eb018f102) - - - - - 6a25c84f by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Avoid n_caps race (cherry picked from commit 0baa8752aaefe80ca428fbfa0cbd4e620d67e1a7) - - - - - 7213e435 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Don't push if nonmoving collector isn't enabled (cherry picked from commit 5d3232baa78dd6f00fc040f75d8e9a8075bfbc07) - - - - - 251e2b4a by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. (cherry picked from commit 0a7eb0aa0bf7e7464e68ab9b6f4176771dcc3590) - - - - - 81fb5149 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. (cherry picked from commit 7c817c0a4ab857e03d09526a481f63e313598c5b) - - - - - d8ad8043 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Allow pinned gen0 objects to be WEAK keys (cherry picked from commit ce22a3e2f2e8168f80d77807d79214e1cfbccb44) - - - - - d6deed34 by Ben Gamari at 2023-05-18T16:00:11-04:00 rts: Reenable assertion (cherry picked from commit 78746906d133765a9a4219eb34ed01e78f31344c) - - - - - d6826083 by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. (cherry picked from commit b500867a9eae6381e5c686aaa71ae069398eacb9) - - - - - 02289f9a by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. (cherry picked from commit 56e669c11208bba136c44ee7154b59e0d4d39c87) - - - - - 4b75a239 by Ben Gamari at 2023-05-18T16:00:11-04:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. (cherry picked from commit 4a7650d75752fcde2fc5bc23913e4116ae2ec582) - - - - - 4275ccfb by Ben Gamari at 2023-05-18T16:00:11-04:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. (cherry picked from commit 96a5aaede899f95fb06dcdb9d0439bbea0f93e14) - - - - - 873df322 by Ben Gamari at 2023-05-18T16:00:11-04:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. (cherry picked from commit 6c6674cafefbb72f1b9c5b8a005fc62f905c50ea) - - - - - 8805864d by Ben Gamari at 2023-05-18T16:00:11-04:00 testsuite: Skip some tests when sanity checking is enabled (cherry picked from commit e84f716798e0d3431aa7ec42b243dc0998cb6444) - - - - - f01df851 by Ben Gamari at 2023-05-18T16:00:12-04:00 nonmoving: Fix unregisterised build (cherry picked from commit 3ae0f368542b24b2ee2cd102cf65db8db705c83c) - - - - - 3bc83d81 by Ben Gamari at 2023-05-18T16:00:12-04:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments (cherry picked from commit 4eb9d06b00043e52be3cf828ccb92f0bb4c9e438) - - - - - 7c5657fc by Ben Gamari at 2023-05-18T16:00:12-04:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. (cherry picked from commit f0cf384db038ff3b83770dbf11a89ecd20178899) - - - - - 04e8de8a by Ben Gamari at 2023-05-18T16:00:12-04:00 nonmoving: Move allocator into new source file (cherry picked from commit 487a8b580581e8f9b40974cf0e0a4e93f95e8665) - - - - - a7716f0b by Ben Gamari at 2023-05-18T16:00:12-04:00 nonmoving: Split out nonmovingAllocateGC (cherry picked from commit 8f374139f0b5f0a39861a7f9432070f78f9fbba0) - - - - - 01f2fef1 by Ben Gamari at 2023-05-18T16:00:12-04:00 testsuite: Mark ffi023 as broken due to #23089 (cherry picked from commit f1fd3ffbdccf471c43f3c36d6ecb4bd5da33c097) - - - - - db8e4d61 by Ben Gamari at 2023-05-18T16:00:12-04:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. (cherry picked from commit a57f12b3f06afe29cbbc6eb0a887bcbe319f17f6) - - - - - 75fd54fe by Ben Gamari at 2023-05-18T16:00:12-04:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. (cherry picked from commit f6f12a36346e19de7eed330537350d0b7420764a) - - - - - 19ad1ae5 by Ben Gamari at 2023-05-18T16:00:12-04:00 nonmoving: Non-concurrent collection (cherry picked from commit ba73a807edbb444c49e0cf21ab2ce89226a77f2e) - - - - - 15da0925 by Ben Gamari at 2023-05-18T16:00:12-04:00 gitlab-ci: Add job bootstrapping with nonmoving GC (cherry picked from commit 581e58ac80f98a9f5292ad13a9a984c2f5a1de21) - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Flavour.hs - libraries/ghc-heap/tests/all.T - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/Schedule.c - rts/Sparks.h - rts/ThreadLabels.c - rts/include/rts/storage/GC.h - rts/include/rts/storage/MBlock.h - rts/rts.cabal.in - rts/sm/BlockAlloc.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GC.h - rts/sm/GCUtils.c - rts/sm/GCUtils.h - rts/sm/HeapAlloc.h - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - + rts/sm/NonMovingAllocate.c - + rts/sm/NonMovingAllocate.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eaadcaa7ca2b7bb1d4d214339092dd9e6df12a96...15da0925a866aac4c8773daf03d4322c0e21a923 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eaadcaa7ca2b7bb1d4d214339092dd9e6df12a96...15da0925a866aac4c8773daf03d4322c0e21a923 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 19:01:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 15:01:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.6 Message-ID: <646a6a9329cc3_9760a4b15327c8669cc@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 19:03:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 15:03:40 -0400 Subject: [Git][ghc/ghc][wip/backports-9.6] configure: Release 9.6.2 Message-ID: <646a6b0c436d5_9760a4b504b78867161@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: 07243d1b by Ben Gamari at 2023-05-21T15:03:36-04:00 configure: Release 9.6.2 - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.1], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07243d1b1ad92c98f4728afb31fc9c39573c14f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07243d1b1ad92c98f4728afb31fc9c39573c14f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 20:52:11 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 21 May 2023 16:52:11 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] Avoid an assertion failure in abstractFloats Message-ID: <646a847b83ea0_9760a4af5e3408798dc@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 432b0361 by Simon Peyton Jones at 2023-05-21T21:51:15+01:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 3 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - + testsuite/tests/simplCore/should_compile/T23426.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2143,6 +2143,9 @@ abstractFloats uf_opts top_lvl main_tvs floats body get_tvs var free_tvs | isTyVar var -- CoVars have been substituted away = extendVarSet free_tvs var + | isCoVar var -- CoVars can be free in the RHS, but they are never let-bound; + = free_tvs -- Do not call lookupIdSubst_maybe, though (#23426) + -- because it has a non-CoVar precondition | Just poly_app <- GHC.Core.Subst.lookupIdSubst_maybe subst var = -- 'var' is like 'x' in (AB4) exprSomeFreeVars isTyVar poly_app `unionVarSet` free_tvs ===================================== testsuite/tests/simplCore/should_compile/T23426.hs ===================================== @@ -0,0 +1,8 @@ +module T23426 where + +class (Char ~ a) => ListLike a where + mnull :: a -> b + +indent :: forall a. (ListLike a) => a -> Bool +indent x = let doText y = const (mnull y) doText + in const (doText x) doText ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -483,4 +483,4 @@ test('T23307', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) test('T23307b', normal, compile, ['-O']) test('T23307c', normal, compile, ['-O']) - +test('T23426', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/432b03612ea005a0925f3b33164893eeb1e891f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/432b03612ea005a0925f3b33164893eeb1e891f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 21:23:23 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 17:23:23 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <646a8bcb4e75c_9760a64fb7ac089201d@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: fb717957 by Ben Gamari at 2023-05-21T17:23:11-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,233 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}" + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb717957562e20358dc3e4e138434cd661651985 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb717957562e20358dc3e4e138434cd661651985 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 21:24:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 17:24:06 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 9 commits: testsuite: Add test to catch changes in core libraries Message-ID: <646a8bf6fce9_9760a4b504b8c89270@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: fb717957 by Ben Gamari at 2023-05-21T17:23:11-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - dc40f18d by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Introduce Data.Enum - - - - - e85137bf by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Num.Integer - - - - - a4a71b53 by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Num - - - - - 519165d9 by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Num.Natural - - - - - e89886ea by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Introduce Data.Show - - - - - 89365938 by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Float - - - - - 8ebf2135 by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Real - - - - - cb04f82c by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 19 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - + libraries/base/Data/Enum.hs - + libraries/base/Data/Show.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== libraries/base/Data/Enum.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum ===================================== libraries/base/Data/Show.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Show +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Show' class. +-- +----------------------------------------------------------------------------- + +module Data.Show + ( Show(..) + -- * 'ShowS' + , ShowS + , shows + , showChar, showString, showMultiLineString + , showParen, showCommaSpace, showSpace + , showLitChar, showLitString + ) where + +import GHC.Show + ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,109 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int + , int2Float + , word2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorFloat + , ceilingFloat + , truncateFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , eqFloat, gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , powerFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , word2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , eqDouble, gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , powerDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Internal + , stgFloatToWord32 + , stgWord32ToFloat + , stgDoubleToWord64 + , stgWord64ToDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Num.hs ===================================== @@ -18,7 +18,9 @@ module GHC.Num - ( module GHC.Num + ( Num(..) + , subtract + , quotRemInteger , module GHC.Num.Integer , module GHC.Num.Natural -- reexported for backward compatibility ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,68 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + , mkRationalWithExponentBase + , FractionalExponentBase(..) + ) where #include "MachDeps.h" ===================================== libraries/base/base.cabal ===================================== @@ -127,6 +127,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 @@ -151,6 +152,7 @@ Library Data.Proxy Data.Ratio Data.Semigroup + Data.Show Data.STRef Data.STRef.Lazy Data.STRef.Strict ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -20,7 +20,131 @@ -- -- The 'Integer' type. -module GHC.Num.Integer where +module GHC.Num.Integer + ( Integer(..) + , integerCheck + , integerCheck# + + -- * Useful constants + , integerZero + , integerOne + + -- * Conversion with... + -- ** 'Int' + , integerFromInt# + , integerFromInt + , integerToInt# + , integerToInt + -- ** 'BigNat' + , integerFromBigNat# + , integerFromBigNatNeg# + , integerFromBigNatSign# + , integerToBigNatSign# + , integerToBigNatClamp# + -- ** 'Word' + , integerFromWord# + , integerFromWord + , integerFromWordNeg# + , integerFromWordSign# + , integerToWord# + , integerToWord + -- ** 'Natural' + , integerFromNatural + , integerToNaturalClamp + , integerToNatural + , integerToNaturalThrow + -- ** 'Int64'/'Word64' + , integerFromInt64# + , integerFromWord64# + , integerToInt64# + , integerToWord64# + -- ** Floating-point + , integerDecodeDouble# + , integerEncodeDouble# + , integerEncodeDouble + , integerEncodeFloat# + -- ** 'Addr#' + , integerToAddr# + , integerToAddr + , integerFromAddr# + , integerFromAddr + -- ** Limbs + , integerFromWordList + , integerToMutableByteArray# + , integerToMutableByteArray + , integerFromByteArray# + , integerFromByteArray + + -- * Predicates + , integerIsNegative# + , integerIsNegative + , integerIsZero + , integerIsOne + + -- * Comparison + , integerNe + , integerEq + , integerLe + , integerLt + , integerGt + , integerGe + , integerEq# + , integerNe# + , integerGt# + , integerLe# + , integerLt# + , integerGe# + , integerCompare + + -- * Arithmetic + , integerSub + , integerAdd + , integerMul + , integerNegate + , integerAbs + , integerSignum + , integerSignum# + , integerQuotRem# + , integerQuotRem + , integerQuot + , integerRem + , integerDivMod# + , integerDivMod + , integerDiv + , integerMod + , integerGcd + , integerLcm + , integerSqr + , integerLog2# + , integerLog2 + , integerLogBaseWord# + , integerLogBaseWord + , integerLogBase# + , integerLogBase + , integerIsPowerOf2# + , integerGcde# + , integerGcde + , integerRecipMod# + , integerPowMod# + + -- * Bit operations + , integerPopCount# + , integerBit# + , integerBit + , integerTestBit# + , integerTestBit + , integerShiftR# + , integerShiftR + , integerShiftL# + , integerShiftL + , integerOr + , integerXor + , integerAnd + , integerComplement + + -- * Miscellaneous + , integerSizeInBase# + ) where #include "MachDeps.h" #include "WordSize.h" ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -8,7 +8,109 @@ #include "MachDeps.h" #include "WordSize.h" -module GHC.Num.Natural where +module GHC.Num.Natural + ( Natural(..) + , naturalCheck# + , naturalCheck + + -- * Useful constants + , naturalZero + , naturalOne + + -- * Predicates + , naturalIsZero + , naturalIsOne + , naturalIsPowerOf2# + + -- * Conversion with... + -- ** 'BigNat' + , naturalFromBigNat# + , naturalToBigNat# + -- ** 'Word' + , naturalFromWord# + , naturalFromWord2# + , naturalFromWord + , naturalToWord# + , naturalToWord + , naturalToWordClamp# + , naturalToWordClamp + , naturalToWordMaybe# + -- ** Limbs + , naturalFromWordList + , naturalToMutableByteArray# + , naturalFromByteArray# + -- ** Floating point + , naturalEncodeDouble# + , naturalEncodeFloat# + -- ** 'Addr#' + , naturalToAddr# + , naturalToAddr + , naturalFromAddr# + , naturalFromAddr + + -- * Comparison + , naturalEq# + , naturalEq + , naturalNe# + , naturalNe + , naturalGe# + , naturalGe + , naturalLe# + , naturalLe + , naturalGt# + , naturalGt + , naturalLt# + , naturalLt + , naturalCompare + + -- * Bit operations + , naturalPopCount# + , naturalPopCount + , naturalShiftR# + , naturalShiftR + , naturalShiftL# + , naturalShiftL + , naturalAnd + , naturalAndNot + , naturalOr + , naturalXor + , naturalTestBit# + , naturalTestBit + , naturalBit# + , naturalBit + , naturalSetBit# + , naturalSetBit + , naturalClearBit# + , naturalClearBit + , naturalComplementBit# + , naturalComplementBit + + -- * Arithmetic + , naturalAdd + , naturalSub + , naturalSubThrow + , naturalSubUnsafe + , naturalMul + , naturalSqr + , naturalSignum + , naturalNegate + , naturalQuotRem# + , naturalQuotRem + , naturalQuot + , naturalRem + , naturalGcd + , naturalLcm + , naturalLog2# + , naturalLog2 + , naturalLogBaseWord# + , naturalLogBaseWord + , naturalLogBase# + , naturalLogBase + , naturalPowMod + + -- * Miscellaneous + , naturalSizeInBase# + ) where import GHC.Prim import GHC.Types ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,233 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}" + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/075cc9ebe94795f8661c4ff1085e514e2f58c5b3...cb04f82c51612d52b7494b260007513a1358b3cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/075cc9ebe94795f8661c4ff1085e514e2f58c5b3...cb04f82c51612d52b7494b260007513a1358b3cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 23:47:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 19:47:24 -0400 Subject: [Git][ghc/ghc][ghc-9.6] 4 commits: nonmoving: Account for mutator allocations in bytes_allocated Message-ID: <646aad8c506f9_9760a4b504b8c9056a5@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: 7b39870b by Ben Gamari at 2023-05-21T14:30:51-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. (cherry picked from commit b2cdb7dacc095142e29c0f28a956b7fa97cdb4b1) - - - - - 3d0a7cd3 by Teo Camarasu at 2023-05-21T14:45:11-04:00 Add regression test for #17574 This test currently fails in the nonmoving way (cherry picked from commit a56141a69842a78d56ec11be85a775eb703219bf) - - - - - f0f96536 by Teo Camarasu at 2023-05-21T14:45:20-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 (cherry picked from commit 20c6669fc46c567e00d3cdf22aa84479b6d8dc17) - - - - - 07243d1b by Ben Gamari at 2023-05-21T15:03:36-04:00 configure: Release 9.6.2 - - - - - 11 changed files: - configure.ac - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingAllocate.c - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Storage.c - rts/sm/Storage.h - + testsuite/tests/rts/T17574.hs - + testsuite/tests/rts/T17574.stdout - testsuite/tests/rts/all.T Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.1], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.2], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are ===================================== rts/sm/NonMoving.c ===================================== @@ -395,7 +395,8 @@ Mutex concurrent_coll_finished_lock; * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * The nonmoving collector uses an approximate heuristic for reporting live * data quantity. Specifically, during mark we record how much live data we - * find in nonmoving_live_words. At the end of mark we declare this amount to + * find in nonmoving_segment_live_words. At the end of mark this is combined with nonmoving_large_words + * and nonmoving_compact_words, and we declare this amount to * be how much live data we have on in the nonmoving heap (by setting * oldest_gen->live_estimate). * @@ -540,7 +541,7 @@ Mutex concurrent_coll_finished_lock; * */ -memcount nonmoving_live_words = 0; +memcount nonmoving_segment_live_words = 0; // See Note [Sync phase marking budget]. MarkBudget sync_phase_marking_budget = 200000; @@ -682,10 +683,11 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_large_objects); } n_nonmoving_large_blocks += oldest_gen->n_large_blocks; + nonmoving_large_words += oldest_gen->n_large_words; oldest_gen->large_objects = NULL; oldest_gen->n_large_words = 0; oldest_gen->n_large_blocks = 0; - nonmoving_live_words = 0; + nonmoving_segment_live_words = 0; // Clear compact object mark bits for (bdescr *bd = nonmoving_compact_objects; bd; bd = bd->link) { @@ -700,6 +702,7 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_compact_objects); } n_nonmoving_compact_blocks += oldest_gen->n_compact_blocks; + nonmoving_compact_words += oldest_gen->n_compact_blocks * BLOCK_SIZE_W; oldest_gen->n_compact_blocks = 0; oldest_gen->compact_objects = NULL; // TODO (osa): what about "in import" stuff?? @@ -1053,7 +1056,9 @@ concurrent_marking: freeMarkQueue(mark_queue); stgFree(mark_queue); - oldest_gen->live_estimate = nonmoving_live_words; + nonmoving_large_words = countOccupied(nonmoving_marked_large_objects); + nonmoving_compact_words = n_nonmoving_marked_compact_blocks * BLOCK_SIZE_W; + oldest_gen->live_estimate = nonmoving_segment_live_words + nonmoving_large_words + nonmoving_compact_words; oldest_gen->n_old_blocks = 0; resizeGenerations(); ===================================== rts/sm/NonMoving.h ===================================== @@ -120,7 +120,7 @@ struct NonmovingHeap { extern struct NonmovingHeap nonmovingHeap; -extern memcount nonmoving_live_words; +extern memcount nonmoving_segment_live_words; #if defined(THREADED_RTS) extern bool concurrent_coll_running; ===================================== rts/sm/NonMovingAllocate.c ===================================== @@ -253,5 +253,9 @@ void *nonmovingAllocateGC(Capability *cap, StgWord sz) GNUC_ATTR_HOT void *nonmovingAllocate(Capability *cap, StgWord sz) { + // Handle "bytes allocated" accounting in the same way we + // do in Storage.c:allocate. See #23312. + accountAllocation(cap, sz); + cap->total_allocated += sz; return nonmovingAllocate_(SM_LOCK, cap, sz); } ===================================== rts/sm/NonMovingMark.c ===================================== @@ -76,6 +76,10 @@ static bool is_nonmoving_weak(StgWeak *weak); * consequently will trace the pointers of only one object per block. However, * this is okay since the only type of pinned object supported by GHC is the * pinned ByteArray#, which has no pointers. + * + * We need to take care that the stats department is made aware of the amount of + * live large (and compact) objects, since they no longer live on gen[i]->large_objects. + * Failing to do so caused #17574. */ bdescr *nonmoving_large_objects = NULL; @@ -83,6 +87,9 @@ bdescr *nonmoving_marked_large_objects = NULL; memcount n_nonmoving_large_blocks = 0; memcount n_nonmoving_marked_large_blocks = 0; +memcount nonmoving_large_words = 0; +memcount nonmoving_compact_words = 0; + bdescr *nonmoving_compact_objects = NULL; bdescr *nonmoving_marked_compact_objects = NULL; memcount n_nonmoving_compact_blocks = 0; @@ -1745,7 +1752,7 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); nonmoving_block_idx block_idx = nonmovingGetBlockIdx((StgPtr) p); nonmovingSetMark(seg, block_idx); - nonmoving_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); + nonmoving_segment_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); } // If we found a indirection to shortcut keep going. ===================================== rts/sm/NonMovingMark.h ===================================== @@ -128,6 +128,11 @@ extern bdescr *nonmoving_large_objects, *nonmoving_marked_large_objects, extern memcount n_nonmoving_large_blocks, n_nonmoving_marked_large_blocks, n_nonmoving_compact_blocks, n_nonmoving_marked_compact_blocks; +// The size of live large/compact objects in words. +// Only updated at the end of nonmoving GC. +extern memcount nonmoving_large_words, + nonmoving_compact_words; + extern StgTSO *nonmoving_old_threads; extern StgWeak *nonmoving_old_weak_ptr_list; extern StgTSO *nonmoving_threads; ===================================== rts/sm/Storage.c ===================================== @@ -42,6 +42,7 @@ #include "GC.h" #include "Evac.h" #include "NonMovingAllocate.h" +#include "sm/NonMovingMark.h" #if defined(ios_HOST_OS) || defined(darwin_HOST_OS) #include "Hash.h" #endif @@ -965,7 +966,7 @@ move_STACK (StgStack *src, StgStack *dest) dest->sp = (StgPtr)dest->sp + diff; } -STATIC_INLINE void +void accountAllocation(Capability *cap, W_ n) { TICK_ALLOC_HEAP_NOCTR(WDS(n)); @@ -1615,7 +1616,12 @@ W_ genLiveWords (generation *gen) W_ genLiveBlocks (generation *gen) { - return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks; + W_ nonmoving_blocks = 0; + // The nonmoving heap contains some blocks that live outside the regular generation structure. + if (gen == oldest_gen && RtsFlags.GcFlags.useNonmoving){ + nonmoving_blocks = n_nonmoving_large_blocks + n_nonmoving_marked_large_blocks + n_nonmoving_compact_blocks + n_nonmoving_marked_compact_blocks; + } + return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks; } W_ gcThreadLiveWords (uint32_t i, uint32_t g) @@ -1711,6 +1717,9 @@ StgWord calcTotalLargeObjectsW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_large_words; } + + totalW += nonmoving_large_words; + return totalW; } @@ -1722,6 +1731,9 @@ StgWord calcTotalCompactW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_compact_blocks * BLOCK_SIZE_W; } + + totalW += nonmoving_compact_words; + return totalW; } ===================================== rts/sm/Storage.h ===================================== @@ -125,6 +125,8 @@ StgWord genLiveBlocks (generation *gen); StgWord calcTotalLargeObjectsW (void); StgWord calcTotalCompactW (void); +void accountAllocation(Capability *cap, W_ n); + /* ---------------------------------------------------------------------------- Storage manager internal APIs and globals ------------------------------------------------------------------------- */ ===================================== testsuite/tests/rts/T17574.hs ===================================== @@ -0,0 +1,40 @@ +-- | Check that large objects are properly accounted for by GHC.Stats +module Main (main) where + +import Control.Monad +import Control.Exception +import Control.Concurrent +import System.Mem +import System.Exit +import GHC.Stats +import GHC.Compact +import Data.List (replicate) + +import qualified Data.ByteString.Char8 as BS + +doGC :: IO () +doGC = do + performMajorGC + threadDelay 1000 -- small delay to allow GC to run when using concurrent gc + +main :: IO () +main = do + let size = 4096*2 + largeString <- evaluate $ BS.replicate size 'A' + compactString <- compact $ replicate size 'A' + doGC + doGC -- run GC twice to make sure the objects end up in the oldest gen + stats <- getRTSStats + let large_obj_bytes = gcdetails_large_objects_bytes $ gc stats + let compact_obj_bytes = gcdetails_compact_bytes $ gc stats + -- assert that large_obj_bytes is at least as big as size + -- this indicates that `largeString` is being accounted for by the stats department + when (large_obj_bytes < fromIntegral size) $ do + putStrLn $ "large_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + when (compact_obj_bytes < fromIntegral size) $ do + putStrLn $ "compact_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + -- keep them alive + print $ BS.length largeString + print $ length $ getCompact compactString ===================================== testsuite/tests/rts/T17574.stdout ===================================== @@ -0,0 +1,2 @@ +8192 +8192 ===================================== testsuite/tests/rts/all.T ===================================== @@ -568,3 +568,5 @@ test('decodeMyStack_emptyListForMissingFlag', , ignore_stderr , js_broken(22261) # cloneMyStack# not yet implemented ], compile_and_run, ['']) + +test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/15da0925a866aac4c8773daf03d4322c0e21a923...07243d1b1ad92c98f4728afb31fc9c39573c14f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/15da0925a866aac4c8773daf03d4322c0e21a923...07243d1b1ad92c98f4728afb31fc9c39573c14f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 21 23:47:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 21 May 2023 19:47:25 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.6 Message-ID: <646aad8d9b8c2_9760a75c42aa090587b@gitlab.mail> Ben Gamari deleted branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 03:31:48 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sun, 21 May 2023 23:31:48 -0400 Subject: [Git][ghc/ghc][wip/expand-do] Fixes #18324 #23147 Message-ID: <646ae2241e359_9760a75b6d6e892071b@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 150dea75 by Apoorv Ingle at 2023-05-21T22:31:39-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Basic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/150dea755bbf8cf364bc6b52c2272d8f445ef248 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/150dea755bbf8cf364bc6b52c2272d8f445ef248 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 03:35:44 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sun, 21 May 2023 23:35:44 -0400 Subject: [Git][ghc/ghc][wip/expand-do] Fixes #18324 #23147 Message-ID: <646ae31023a41_9760a75b6d6e89233fe@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 2b8ea93a by Apoorv Ingle at 2023-05-21T22:35:38-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Basic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b8ea93adb9a7b969ac9fa01a2f4b5f6f6439d05 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b8ea93adb9a7b969ac9fa01a2f4b5f6f6439d05 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 04:02:49 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 22 May 2023 00:02:49 -0400 Subject: [Git][ghc/ghc][wip/expand-do] Fixes #18324 #23147 Message-ID: <646ae969a1831_9760a4dab370c9260c3@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 7d24628a by Apoorv Ingle at 2023-05-21T23:02:41-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Basic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d24628a5268e66f94d89fa3d51fe751d6792f30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d24628a5268e66f94d89fa3d51fe751d6792f30 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 08:28:23 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 22 May 2023 04:28:23 -0400 Subject: [Git][ghc/ghc][wip/or-pats] 378 commits: Export getSolo from Data.Tuple Message-ID: <646b27a7ea133_9760a75b6ae5c946275@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - bfacb34f by David Knothe at 2023-05-19T14:15:36+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. - - - - - faef4286 by David Knothe at 2023-05-19T14:15:38+02:00 stuff - - - - - a8989041 by David Knothe at 2023-05-19T14:15:38+02:00 Implement empty one of - - - - - 443fb188 by David Knothe at 2023-05-19T14:15:38+02:00 Prohibit TyApps - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - + a.out - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c070b086e8bc7c79117ee3764dc0ae13ba2fa95...443fb18838effd895e82df02c7db21fa461083f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c070b086e8bc7c79117ee3764dc0ae13ba2fa95...443fb18838effd895e82df02c7db21fa461083f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 08:44:13 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 22 May 2023 04:44:13 -0400 Subject: [Git][ghc/ghc][wip/or-pats-amendment] Remove unused Message-ID: <646b2b5d873aa_9760a75c42aa09544a2@gitlab.mail> David pushed to branch wip/or-pats-amendment at Glasgow Haskell Compiler / GHC Commits: b3dd3dbc by David Knothe at 2023-05-22T10:44:02+02:00 Remove unused - - - - - 2 changed files: - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Utils/Zonk.hs Changes: ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -362,17 +362,6 @@ tc_lpats tys penv pats penv (zipEqual "tc_lpats" pats tys) --- NB: do not require tys and pats to have the same length -tc_lpats_ne :: NonEmpty (Scaled ExpSigmaTypeFRR) - -> Checker (NonEmpty (LPat GhcRn)) (NonEmpty (LPat GhcTc)) -tc_lpats_ne (ty:|tys) penv (pat:|pats) ti = do - err_ctxt <- getErrCtxt - (p, (ps, res)) <- - tc_lpat ty penv pat $ - setErrCtxt err_ctxt $ - tcMultiple (\ penv' (p,t) -> tc_lpat t penv' p) penv (zip pats tys) ti - return (p:|ps, res) - -------------------- -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. checkManyPattern :: Scaled a -> TcM HsWrapper ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -93,7 +93,6 @@ import GHC.Data.Bag import Control.Monad import Data.List ( partition ) import Control.Arrow ( second ) -import Data.List.NonEmpty (NonEmpty(..)) {- ********************************************************************* * * @@ -1344,7 +1343,7 @@ zonk_pat env (TuplePat tys pats boxed) ; (env', pats') <- zonkPats env pats ; return (env', TuplePat tys' pats' boxed) } -zonk_pat env p@(OrPat ty pats) +zonk_pat env (OrPat ty pats) = do { ty' <- zonkTcTypeToTypeX env ty ; (env', pats') <- zonkPats env pats ; return (env', OrPat ty' pats') } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3dd3dbc62d539f38ee9da3a4063d016dbad20b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3dd3dbc62d539f38ee9da3a4063d016dbad20b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 08:44:22 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 22 May 2023 04:44:22 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Remove unused Message-ID: <646b2b66eaba7_9760a75c42a64954679@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: b3dd3dbc by David Knothe at 2023-05-22T10:44:02+02:00 Remove unused - - - - - 2 changed files: - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Utils/Zonk.hs Changes: ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -362,17 +362,6 @@ tc_lpats tys penv pats penv (zipEqual "tc_lpats" pats tys) --- NB: do not require tys and pats to have the same length -tc_lpats_ne :: NonEmpty (Scaled ExpSigmaTypeFRR) - -> Checker (NonEmpty (LPat GhcRn)) (NonEmpty (LPat GhcTc)) -tc_lpats_ne (ty:|tys) penv (pat:|pats) ti = do - err_ctxt <- getErrCtxt - (p, (ps, res)) <- - tc_lpat ty penv pat $ - setErrCtxt err_ctxt $ - tcMultiple (\ penv' (p,t) -> tc_lpat t penv' p) penv (zip pats tys) ti - return (p:|ps, res) - -------------------- -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. checkManyPattern :: Scaled a -> TcM HsWrapper ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -93,7 +93,6 @@ import GHC.Data.Bag import Control.Monad import Data.List ( partition ) import Control.Arrow ( second ) -import Data.List.NonEmpty (NonEmpty(..)) {- ********************************************************************* * * @@ -1344,7 +1343,7 @@ zonk_pat env (TuplePat tys pats boxed) ; (env', pats') <- zonkPats env pats ; return (env', TuplePat tys' pats' boxed) } -zonk_pat env p@(OrPat ty pats) +zonk_pat env (OrPat ty pats) = do { ty' <- zonkTcTypeToTypeX env ty ; (env', pats') <- zonkPats env pats ; return (env', OrPat ty' pats') } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3dd3dbc62d539f38ee9da3a4063d016dbad20b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3dd3dbc62d539f38ee9da3a4063d016dbad20b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 09:00:28 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 22 May 2023 05:00:28 -0400 Subject: [Git][ghc/ghc][wip/or-pats-amendment] Remove unused Message-ID: <646b2f2c689bb_9760a75b6d6e896737e@gitlab.mail> David pushed to branch wip/or-pats-amendment at Glasgow Haskell Compiler / GHC Commits: 4c9dab63 by David Knothe at 2023-05-22T10:59:57+02:00 Remove unused - - - - - 3 changed files: - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Utils/Zonk.hs Changes: ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -44,7 +44,7 @@ import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr ) import {-# SOURCE #-} GHC.Rename.Splice ( rnSplicePat ) import GHC.Hs -import GHC.Hs.Pat ( patHasTyAppsL ) +-- import GHC.Hs.Pat ( patHasTyAppsL ) import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( hsOverLitName ) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -74,7 +74,6 @@ import Control.Arrow ( second ) import Control.Monad import GHC.Data.FastString import qualified Data.List.NonEmpty as NE -import Data.List.NonEmpty (NonEmpty (..)) import GHC.Data.List.SetOps ( getNth ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) @@ -362,17 +361,6 @@ tc_lpats tys penv pats penv (zipEqual "tc_lpats" pats tys) --- NB: do not require tys and pats to have the same length -tc_lpats_ne :: NonEmpty (Scaled ExpSigmaTypeFRR) - -> Checker (NonEmpty (LPat GhcRn)) (NonEmpty (LPat GhcTc)) -tc_lpats_ne (ty:|tys) penv (pat:|pats) ti = do - err_ctxt <- getErrCtxt - (p, (ps, res)) <- - tc_lpat ty penv pat $ - setErrCtxt err_ctxt $ - tcMultiple (\ penv' (p,t) -> tc_lpat t penv' p) penv (zip pats tys) ti - return (p:|ps, res) - -------------------- -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. checkManyPattern :: Scaled a -> TcM HsWrapper ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -93,7 +93,6 @@ import GHC.Data.Bag import Control.Monad import Data.List ( partition ) import Control.Arrow ( second ) -import Data.List.NonEmpty (NonEmpty(..)) {- ********************************************************************* * * @@ -1344,7 +1343,7 @@ zonk_pat env (TuplePat tys pats boxed) ; (env', pats') <- zonkPats env pats ; return (env', TuplePat tys' pats' boxed) } -zonk_pat env p@(OrPat ty pats) +zonk_pat env (OrPat ty pats) = do { ty' <- zonkTcTypeToTypeX env ty ; (env', pats') <- zonkPats env pats ; return (env', OrPat ty' pats') } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c9dab63bd9b16deb539a3cbf3ae95b096a4ba5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c9dab63bd9b16deb539a3cbf3ae95b096a4ba5f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 09:00:40 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 22 May 2023 05:00:40 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Remove unused Message-ID: <646b2f381a50a_9760a75c42aa09675b0@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 4c9dab63 by David Knothe at 2023-05-22T10:59:57+02:00 Remove unused - - - - - 3 changed files: - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Utils/Zonk.hs Changes: ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -44,7 +44,7 @@ import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr ) import {-# SOURCE #-} GHC.Rename.Splice ( rnSplicePat ) import GHC.Hs -import GHC.Hs.Pat ( patHasTyAppsL ) +-- import GHC.Hs.Pat ( patHasTyAppsL ) import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( hsOverLitName ) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -74,7 +74,6 @@ import Control.Arrow ( second ) import Control.Monad import GHC.Data.FastString import qualified Data.List.NonEmpty as NE -import Data.List.NonEmpty (NonEmpty (..)) import GHC.Data.List.SetOps ( getNth ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) @@ -362,17 +361,6 @@ tc_lpats tys penv pats penv (zipEqual "tc_lpats" pats tys) --- NB: do not require tys and pats to have the same length -tc_lpats_ne :: NonEmpty (Scaled ExpSigmaTypeFRR) - -> Checker (NonEmpty (LPat GhcRn)) (NonEmpty (LPat GhcTc)) -tc_lpats_ne (ty:|tys) penv (pat:|pats) ti = do - err_ctxt <- getErrCtxt - (p, (ps, res)) <- - tc_lpat ty penv pat $ - setErrCtxt err_ctxt $ - tcMultiple (\ penv' (p,t) -> tc_lpat t penv' p) penv (zip pats tys) ti - return (p:|ps, res) - -------------------- -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. checkManyPattern :: Scaled a -> TcM HsWrapper ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -93,7 +93,6 @@ import GHC.Data.Bag import Control.Monad import Data.List ( partition ) import Control.Arrow ( second ) -import Data.List.NonEmpty (NonEmpty(..)) {- ********************************************************************* * * @@ -1344,7 +1343,7 @@ zonk_pat env (TuplePat tys pats boxed) ; (env', pats') <- zonkPats env pats ; return (env', TuplePat tys' pats' boxed) } -zonk_pat env p@(OrPat ty pats) +zonk_pat env (OrPat ty pats) = do { ty' <- zonkTcTypeToTypeX env ty ; (env', pats') <- zonkPats env pats ; return (env', OrPat ty' pats') } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c9dab63bd9b16deb539a3cbf3ae95b096a4ba5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c9dab63bd9b16deb539a3cbf3ae95b096a4ba5f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 09:14:16 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 05:14:16 -0400 Subject: [Git][ghc/ghc][wip/T23146] 5 commits: Make LFInfos for DataCons on construction Message-ID: <646b3268adebb_9760a4b31b03c9739e1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 13618c23 by Rodrigo Mesquita at 2023-05-22T10:13:50+01:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - c6a44a69 by Rodrigo Mesquita at 2023-05-22T10:13:53+01:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - dbd56880 by Rodrigo Mesquita at 2023-05-22T10:13:53+01:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - 66bda456 by Rodrigo Mesquita at 2023-05-22T10:13:53+01:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - c662a2d4 by Rodrigo Mesquita at 2023-05-22T10:13:53+01:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 12 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,36 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In Core, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConRep`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -209,7 +221,8 @@ Note [Data constructor workers and wrappers] * See Note [Data Constructor Naming] for how the worker and wrapper are named -* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments +* The workers don't take the dcStupidTheta dicts as arguments, while the + wrappers currently do * The wrapper (if it exists) takes dcOrigArgTys as its arguments. The worker takes dataConRepArgTys as its arguments @@ -528,7 +541,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -586,12 +599,22 @@ Function call 'dataConKindEqSpec' returns [k'~k] Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~ -A `DataCon`'s source arity and core representation arity may differ: -`dcSourceArity` does not take constraints into account, but `dcRepArity` does. - -The additional arguments taken into account by `dcRepArity` include quantified -dictionaries and coercion arguments, lifted and unlifted (despite the unlifted -coercion arguments having a zero-width runtime representation). +A `DataCon`'s source and core representation may differ, meaning the source +arity (`dcSourceArity`) and the core representation arity (`dcRepArity`) may +differ too. + +Note that the source arity isn't exactly the number of arguments the data con +/wrapper/ has, since `dcSourceArity` doesn't count constraints -- which may +appear in the wrapper through `DatatypeContexts`, or if the constructor stores a +dictionary. In this sense, the source arity counts the number of non-constraint +arguments that appear at the source level. + On the other hand, the Core representation arity is the number of arguments +of the data constructor in its Core representation, which is also the number +of arguments of the data con /worker/. + +The arity might differ since `dcRepArity` takes into account arguments such as +quantified dictionaries and coercion arguments, lifted and unlifted (despite +the unlifted coercion arguments having a zero-width runtime representation). For example: MkT :: Ord a => a -> T a dcSourceArity = 1 @@ -601,6 +624,15 @@ For example: dcSourceArity = 0 dcRepArity = 1 +The arity might also differ due to unpacking, for example, consider the +following datatype and its wrapper and worker's type: + data V = MkV !() !Int + $WMkV :: () -> Int -> V + MkV :: Int# -> V +As you see, because of unpacking we have both dropped the unit argument and +unboxed the Int. In this case, the source arity (which is the arity of the +wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. + Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -969,51 +1001,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Note that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (mkLFImported) +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -271,11 +271,11 @@ isTagged v = do TagProper -> True TagTagged -> True TagTuple _ -> True -- Consider unboxed tuples tagged. - False -- Imported - -> return $! + -- Imported + False -> return $! -- Determine whether it is tagged from the LFInfo of the imported id. -- See Note [The LFInfo of Imported Ids] - case mkLFImported v of + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,52 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After the unarisation pass: +* In `StgConApp` and `StgRhsCon` and `StgAlt` we filter out the void arguments, + leaving only non-void ones. +* In `StgApp` and `StgOpApp` we retain void arguments. + +We can do this because we know that `StgConApp` and `StgRhsCon` are saturated applications, +so we lose no information by dropping those void args. In contrast, in `StgApp` we need the + void argument to compare the number of args in the call with the arity of the function. + +This is an open design choice. We could instead choose to treat all these applications +consistently (keeping the void args). But for some reason we don't, and this Note simply +documents that design choice. + +As an example, consider: + + data T a = MkT !Int a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WMkT :: Int -> a -> Void# -> T a + MkT :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = MkT 1# y + in ... + case x of + MkT int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +291,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated. (After Unarisation, [NonVoid StgArg]) + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -422,7 +468,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] Type -- Type, for rewriting to an StgRhsClosure -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList $! reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -867,7 +869,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1660,9 +1662,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2117,7 +2118,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2125,13 +2126,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2189,8 +2190,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -96,6 +96,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import GHC.Data.Maybe (isNothing) import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 @@ -255,130 +256,67 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +-- | The 'LambdaFormInfo' of an imported Id. +-- See Note [The LFInfo of Imported Ids] +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of Just lf_info -> - -- Use the LambdaFormInfo from the interface + -- Use the existing LambdaFormInfo lf_info Nothing - -- Interface doesn't have a LambdaFormInfo, so make a conservative one from the type. - -- See Note [The LFInfo of Imported Ids]; The order of the guards musn't be changed! + -- Doesn't have a LambdaFormInfo, but we know it must be 'LFReEntrant' from its arity | arity > 0 -> LFReEntrant TopLevel arity True ArgUnknown - | Just con <- isDataConId_maybe id - -- See Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] in GHC.StgToCmm.Types - -- and Note [The LFInfo of Imported Ids] below - -> assert (hasNoNonZeroWidthArgs con) $ - LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - + -- We can't be sure of the LambdaFormInfo of this imported Id, + -- so make a conservative one from the type. | otherwise - -> mkLFArgument id -- Not sure of exact arity + -> assert (isNothing (isDataConId_maybe id)) $ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make + mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id - hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys {- Note [The LFInfo of Imported Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As explained in Note [Conveying CAF-info and LFInfo between modules] and -Note [Imported unlifted nullary datacon wrappers must have correct LFInfo], the -LambdaFormInfo records the details of a closure representation and is often, -when optimisations are enabled, serialized to the interface of a module. - -In particular, the `lfInfo` field of the `IdInfo` field of an `Id` -* For Ids defined in this module: is `Nothing` -* For imported Ids: +As explained in Note [Conveying CAF-info and LFInfo between modules] +the LambdaFormInfo records the details of a closure representation and is +often, when optimisations are enabled, serialized to the interface of a module. + +In particular, the `lfInfo` field of the `IdInfo` field of an `Id`: +* For DataCon workers and wrappers is populated as described in +Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make +* For other Ids defined in the module being compiled: is `Nothing` +* For other imported Ids: * is (Just lf_info) if the LFInfo was serialised into the interface file (typically, when the exporting module was compiled with -O) * is Nothing if it wasn't serialised -However, when an interface doesn't have a LambdaFormInfo for some imported Id -(so that its `lfInfo` field is `Nothing`), we can conservatively create one -using `mkLFImported`. - The LambdaFormInfo we give an Id is used in determining how to tag its pointer -(see `litIdInfo`). Therefore, it's crucial we re-construct a LambdaFormInfo as -faithfully as possible or otherwise risk having pointers incorrectly tagged, -which can lead to performance issues and even segmentation faults (see #23231 -and #23146). In particular, saturated data constructor applications *must* be -unambiguously given `LFCon`, and the invariant - - If the LFInfo (serialised or built with mkLFImported) says LFCon, then it - really is a static data constructor, and similar for LFReEntrant - -must be upheld. - -In `mkLFImported`, we make a conservative approximation to the real -LambdaFormInfo as follows: - -(1) Ids with an `idFunRepArity > 0` are `LFReEntrant` and pointers to them are -tagged (by `litIdInfo`) with the corresponding arity. - - This is also true of data con wrappers and workers with arity > 0, - regardless of the runtime relevance of the arguments - - For example, `Just :: a -> Maybe a` is given `LFReEntrant` - and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too - -(2) Data constructors with `idFunRepArity == 0` should be given `LFCon` because -they are fully saturated data constructor applications and pointers to them -should be tagged with the constructor index. - -(2.1) A datacon *wrapper* with zero arity must be a fully saturated application -of the worker to zero-width arguments only (which are dropped after unarisation) - -(2.2) A datacon *worker* with zero arity is trivially fully saturated, it takes -no arguments whatsoever (not even zero-width args) - -To ensure we properly give `LFReEntrant` to data constructors with some arity, -and `LFCon` only to data constructors with zero arity, we must first check for -`arity > 0` and only afterwards `isDataConId` -- the order of the guards in -`mkLFImported` is quite important. - -As an example, consider the following data constructors: - - data T1 a where - TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a - - data T2 a where - TCon2 :: {-# UNPACK #-} !() -> T2 a - - data T3 a where - TCon3 :: T3 '[] - -`TCon1`'s wrapper has a lifted equality argument, which is non-zero-width, while -the worker has an unlifted equality argument, which is zero-width. - -`TCon2`'s wrapper has a lifted equality argument, which is non-zero-width, -while the worker has no arguments. - -`TCon3`'s wrapper has no arguments, and the worker has 1 zero-width argument; -their Core representation: - - $WTCon3 :: T3 '[] - $WTCon3 = TCon3 @[] - - TCon3 :: forall (a :: * -> *). (a ~# []) => T a - TCon3 = /\a. \(co :: a~#[]). TCon3 co - -For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they -both have arity == 1. - -For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 -while the worker is `LFCon` since its arity == 0 - -For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the -worker `LFReEntrant` since its arity == 1 - -One might think we could give *workers* with only zero-width-args the `LFCon` -LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. -However, these workers, albeit rarely used, are unambiguously functions --- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. -See also the discussion in #23158. +(see `litIdInfo` and `lfDynTag`). Therefore, it's crucial we attribute a correct +LambdaFormInfo to imported Ids, or otherwise risk having pointers incorrectly +tagged which can lead to performance issues and even segmentation faults (see +#23231 and Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]). + +In particular, saturated data constructor applications *must* be unambiguously +given `LFCon`, and if the LFInfo says LFCon, then it really is a static data +constructor, and similar for LFReEntrant. + +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: + +(1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is +correct by construction (the invariant being that if it exists, it is correct): + (1.1) Either it was serialised to the interface we're importing the Id from, + (1.2) Or it's a DataCon worker or wrapper and its LFInfo was constructed + according to Note [LFInfo of DataCon workers and wrappers] +(2) When the `lfInfo` field is `Nothing` + (2.1) If the `idFunRepArity` of the Id is known and is greater than 0, then + the Id is unambiguously a function and is given `LFReEntrant`, and pointers + to this Id will be tagged (by `litIdInfo`) with the corresponding arity. + (2.2) Otherwise, we can make a conservative estimate from the type. -} ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -149,7 +149,7 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: @@ -75,9 +75,25 @@ Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As described in `Note [Conveying CAF-info and LFInfo between modules]`, imported unlifted nullary datacons must have their LambdaFormInfo set to -reflect the fact that they are evaluated . This is necessary as otherwise +reflect the fact that they are evaluated. This is necessary as otherwise references to them may be passed untagged to code that expects tagged -references. +references because of the unlifted nature of the argument. + +For example, in + + type T :: UnliftedType + data T = T1 + | T2 + + f :: T -> Int + f x = case x of T1 -> 1; T2 -> 2 + +`f` expects `x` to be evaluated and properly tagged due to its unliftedness. +We can guarantee all occurrences of `T1` and `T2` are considered evaluated and +are properly tagged by giving them the `LFCon` LambdaFormInfo which indicates +they are fully saturated constructor applications. +(The LambdaFormInfo is used to tag the pointer with the tag of the +constructor, in `litIdInfo`) What may be less obvious is that this must be done for not only datacon workers but also *wrappers*. The reason is found in this program @@ -109,11 +125,9 @@ pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage of the unlifted nature of its arguments by omitting handling of the zero tag when scrutinising them. -The fix is straightforward: extend the logic in `mkLFImported` to cover -(nullary) datacon wrappers as well as workers. This is safe because we -know that the wrapper of a nullary datacon will be in WHNF, even if it -includes equalities evidence (since such equalities are not runtime -relevant). This fixed #23146. +The fix is straightforward: ensure we always construct a /correct/ LFInfo for +datacon workers and wrappers, and populate the `lfInfo` with it. See +Note [LFInfo of DataCon workers and wrappers]. This fixed #23146. See also Note [The LFInfo of Imported Ids] -} ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -123,7 +123,8 @@ infixl 1 `setRuleInfo`, `setCafInfo`, `setDmdSigInfo`, `setCprSigInfo`, - `setDemandInfo` + `setDemandInfo`, + `setLFInfo` {- ************************************************************************ * * @@ -401,7 +402,12 @@ data IdInfo -- -- See documentation of the getters for what these packed fields mean. lfInfo :: !(Maybe LambdaFormInfo), - -- ^ See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- ^ If lfInfo = Just info, then the `info` is guaranteed /correct/. + -- If lfInfo = Nothing, then we do not have a `LambdaFormInfo` for this Id, + -- so (for imported Ids) we make a conservative version. + -- See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- For locally-defined Ids other than DataCons, the `lfInfo` field is always Nothing. + -- See also Note [LFInfo of DataCon workers and wrappers] -- See documentation of the getters for what these packed fields mean. tagSig :: !(Maybe TagSig) ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Types.SourceText +import GHC.Types.RepType ( countFunRepArgs ) import GHC.Types.Name.Set import GHC.Types.Name import GHC.Types.ForeignCall @@ -87,6 +88,10 @@ import GHC.Data.FastString import GHC.Data.List.SetOps import Data.List ( zipWith4 ) +-- A bit of a shame we must import these here +import GHC.StgToCmm.Types (LambdaFormInfo(..)) +import GHC.Runtime.Heap.Layout (ArgDescr(ArgUnknown)) + {- ************************************************************************ * * @@ -595,11 +600,18 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setLFInfo` wkr_lf_info -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + -- See Note [LFInfo of DataCon workers and wrappers] + wkr_lf_info + | wkr_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wkr_arity wkr_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con ex_tcvs = dataConExTyCoVars data_con @@ -608,6 +620,8 @@ mkDataConWorkId wkr_name data_con `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma `setUnfoldingInfo` newtype_unf + -- See W1 in Note [LFInfo of DataCon workers and wrappers] + `setLFInfo` (panic "mkDataConWorkId: we shouldn't look at LFInfo for newtype worker ids") id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) @@ -618,6 +632,89 @@ mkDataConWorkId wkr_name data_con wrapNewTypeBody tycon res_ty_args (Var id_arg1) {- +Note [LFInfo of DataCon workers and wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As noted in Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure, it's +crucial that saturated data con applications are given an LFInfo of `LFCon`. + +Since for data constructors we never serialise the worker and the wrapper (only +the data type declaration), we never serialise their lambda form info either. + +Therefore, when making data constructors workers and wrappers, we construct a +correct `LFInfo` for them right away, and put it it in the `lfInfo` field of the +worker/wrapper Id, ensuring that: + + The `lfInfo` field of a DataCon worker or wrapper is always populated with the correct LFInfo. + +How do we construct a /correct/ LFInfo for workers and wrappers? +(Remember: `LFCon` means "a saturated constructor application") + +(1) Data constructor workers and wrappers with arity > 0 are unambiguously +functions and should be given `LFReEntrant`, regardless of the runtime +relevance of the arguments. + - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, + and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + +(2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes +no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + +(3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. +A datacon /wrapper/ with zero arity must be a fully saturated application of +the worker to zero-width arguments only (which are dropped after unarisation), +and therefore is also given `LFCon`. + +For example, consider the following data constructors: + + data T1 a where + TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a + + data T2 a where + TCon2 :: {-# UNPACK #-} !() -> T2 a + + data T3 a where + TCon3 :: T3 '[] + +`TCon1`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has an unlifted equality argument, which is zero-width. + +`TCon2`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has no arguments. + +Wrinkle (W1). Perhaps surprisingly, it is possible for the /wrapper/ to be an +`LFCon` even though the /worker/ is not. Consider `T3` above. Here is the +Core representation of the worker and wrapper: + + $WTCon3 :: T3 '[] -- Wrapper + $WTCon3 = TCon3 @[] -- A saturated constructor application: LFCon + + TCon3 :: forall (a :: * -> *). (a ~# []) => T a -- Worker + TCon3 = /\a. \(co :: a~#[]). TCon3 co -- A function: LFReEntrant + +For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they +both have arity == 1. + +For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 +while the worker is `LFCon` since its arity == 0 + +For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the +worker `LFReEntrant` since its arity == 1 + +One might think we could give *workers* with only zero-width-args the `LFCon` +LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. +However, these workers are unambiguously functions +-- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. +See also the discussion in #23158. + +Wrinkles: + +(W1) Why do we panic when generating `LFInfo` for newtype workers and wrappers? + + We don't generate code for newtype workers/wrappers, so we should never have to + look at their LFInfo (and in general we can't; they may be representation-polymorphic). + +See also the Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +in GHC.StgToCmm.Types. + ------------------------------------------------- -- Data constructor representation -- @@ -709,11 +806,20 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + `setLFInfo` wrap_lf_info -- The signature is purely for passes like the Simplifier, not for -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv + -- See Note [LFInfo of DataCon workers and wrappers] + wrap_lf_info + | wrap_arity == 0 = LFCon data_con + -- See W1 in Note [LFInfo of DataCon workers and wrappers] + | isNewTyCon tycon = panic "mkDataConRep: we shouldn't look at LFInfo for newtype wrapper ids" + | otherwise = LFReEntrant TopLevel (countFunRepArgs wrap_arity wrap_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + wrap_arg_dmds = replicate (length theta) topDmd ++ map mk_dmd arg_ibangs -- Don't forget the dictionary arguments when building ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty @@ -124,6 +123,10 @@ unwrapType ty | otherwise = NS_Done +-- | Count the arity of a function post-unarisation, including zero-width arguments. +-- +-- The post-unarisation arity may be larger than the arity of the original +-- function type. See Note [Unarisation]. countFunRepArgs :: Arity -> Type -> RepArity countFunRepArgs 0 _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d5cd5acadba24f41b74f8fc559bae25abd4e9bc...c662a2d40fe5bdf5fad003b5bf77f75776cc5397 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d5cd5acadba24f41b74f8fc559bae25abd4e9bc...c662a2d40fe5bdf5fad003b5bf77f75776cc5397 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 10:01:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 06:01:18 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646b3d6ea2cff_9760a75b6d6e899056b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: d1609865 by Rodrigo Mesquita at 2023-05-22T11:00:20+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]) Cleanup: Hadrian no longer needs to pass the CPP configuration through -optP Closes #23422 - - - - - 16 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -393,6 +393,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -96,10 +96,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +215,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -171,10 +174,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = True , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,32 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,9 +94,8 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) - | otherwise = GHC.SysTools.runCpp logger dflags args + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args + | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags targetArch = stringEncodeArch $ platformArch platform ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,40 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and initial args + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args = do + let (p,args0) = getPgm dflags + args1 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] + mb_env <- getGccEnv args1 + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = (getOpts dflags opt_P) + args0 = map Option (augmentImports dflags opts) + in run_some_cpp logger dflags "Haskell C pre-processor" pgmP (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -92,7 +92,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +106,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +192,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +204,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,12 +1,12 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], @@ -58,7 +58,7 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], @@ -97,3 +97,31 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + + # We can't use AC_PROG_CPP here, since CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + AC_ARG_VAR(CPP,[Use as the path to cpp]) + + AS_VAR_IF(CPP,[],[ + # If CPP is not set, use CC with -E + CPP_CMD=$1 + CPP_ARGS="-E $CPPFLAGS" + ],[ + # Otherwise, use whatever was set + CPP_CMD="$CPP" + CPP_ARGS="$CPPFLAGS" + ]) + + $2=$CPP_CMD + $3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1609865b5906dd2358536f4fe8c5d7091359efe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1609865b5906dd2358536f4fe8c5d7091359efe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 10:10:57 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 06:10:57 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646b3fb1266b1_9760a4dab370c997780@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 0ec214c1 by Rodrigo Mesquita at 2023-05-22T11:10:44+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]) Cleanup: Hadrian no longer needs to pass the CPP configuration through -optP Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -393,6 +393,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -96,10 +96,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +215,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -171,10 +174,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,40 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and initial args + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args = do + let (p,args0) = getPgm dflags + args1 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] + mb_env <- getGccEnv args1 + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = (getOpts dflags opt_P) + args0 = map Option (augmentImports dflags opts) + in run_some_cpp logger dflags "Haskell C pre-processor" pgmP (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -92,7 +92,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +106,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +192,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +204,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,12 +1,12 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], @@ -58,7 +58,7 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], @@ -97,3 +97,31 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + + # We can't use AC_PROG_CPP here, since CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + AC_ARG_VAR(CPP,[Use as the path to cpp]) + + AS_VAR_IF(CPP,[],[ + # If CPP is not set, use CC with -E + CPP_CMD=$1 + CPP_ARGS="-E $CPPFLAGS" + ],[ + # Otherwise, use whatever was set + CPP_CMD="$CPP" + CPP_ARGS="$CPPFLAGS" + ]) + + $2=$CPP_CMD + $3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ec214c116948360d139ea668affe9fa1a5fefb3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ec214c116948360d139ea668affe9fa1a5fefb3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 10:14:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 06:14:42 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646b409280f0c_9760a4b31b03c99807@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: c66f20aa by Rodrigo Mesquita at 2023-05-22T11:14:08+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]) Cleanup: Hadrian no longer needs to pass the CPP configuration through -optP Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -171,10 +174,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,40 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and initial args + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args = do + let (p,args0) = getPgm dflags + args1 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] + mb_env <- getGccEnv args1 + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = (getOpts dflags opt_P) + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -92,7 +92,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +106,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +192,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +204,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,12 +1,12 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], @@ -58,7 +58,7 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], @@ -97,3 +97,31 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + + # We can't use AC_PROG_CPP here, since CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + AC_ARG_VAR(CPP,[Use as the path to cpp]) + + AS_VAR_IF(CPP,[],[ + # If CPP is not set, use CC with -E + CPP_CMD=$1 + CPP_ARGS="-E $CPPFLAGS" + ],[ + # Otherwise, use whatever was set + CPP_CMD="$CPP" + CPP_ARGS="$CPPFLAGS" + ]) + + $2=$CPP_CMD + $3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c66f20aab079c53e575a8b12b1562add5b993854 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c66f20aab079c53e575a8b12b1562add5b993854 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 10:24:01 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 22 May 2023 06:24:01 -0400 Subject: [Git][ghc/ghc][wip/T23156] 3 commits: testsuite: fix predicate on rdynamic test Message-ID: <646b42c1e8cbd_9760a4dab370c10022cd@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23156 at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - 52abb868 by Simon Peyton Jones at 2023-05-22T11:25:56+01:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 9 changed files: - docs/users_guide/9.8.1-notes.rst - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/using-optimisation.rst - testsuite/tests/rts/linker/all.T - + testsuite/tests/typecheck/should_compile/T23156.hs - + testsuite/tests/typecheck/should_compile/T23156.stderr - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -33,11 +33,10 @@ Compiler - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking - the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket - #22448 for further details. + the specification described in the documentation of the `INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. - Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. - See GHC ticket #23049. + See :ghc-ticket:`23049`. - The ``-Wno-⟨wflag⟩``, ``-Werror=⟨wflag⟩`` and ``-Wwarn=⟨wflag⟩`` options are now defined systematically for all warning groups (for example, @@ -121,7 +120,7 @@ Runtime system ~~~~~~~~~~~~~~ - On POSIX systems that support timerfd, RTS shutdown no longer has to wait for - the next RTS 'tick' to occur before continuing the shutdown process. See #22692. + the next RTS 'tick' to occur before continuing the shutdown process. See :ghc-ticket:`22692`. ``base`` library ~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -287,7 +287,7 @@ would invoke GHC like this: Plugins can be also be loaded from libraries directly. It allows plugins to be -loaded in cross-compilers (as a workaround for #14335). +loaded in cross-compilers (as a workaround for :ghc-ticket:`14335`). .. ghc-flag:: -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩ :shortdesc: Load a pre-compiled static plugin from an external library ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -262,7 +262,7 @@ From a semantic point of view: {-# RULES forall @m (x :: KnownNat m => Proxy m). g x = blah #-} - See `#21093 `_ for discussion. + See :ghc-ticket:`21093` for discussion. .. _rules-inline: ===================================== docs/users_guide/exts/template_haskell.rst ===================================== @@ -135,7 +135,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under spliced expression must have type ``Code Q a`` **NOTE**: Currently typed splices may inhibit the unused identifier warning for - identifiers in scope. See `#16524 ` + identifiers in scope. See :ghc-ticket:`16524`. - A *typed* expression quotation is written as ``[|| ... ||]``, or ``[e|| ... ||]``, where the "..." is an expression; if the "..." ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1691,7 +1691,7 @@ as such you shouldn't need to set any of them explicitly. A flag overhead for the check disappears completely. This can cause slight codesize increases. It will also cause many more functions - to get a worker/wrapper split which can play badly with rules (see Ticket #20364) + to get a worker/wrapper split which can play badly with rules (see :ghc-ticket:`20364`) which is why it's currently disabled by default. In particular if you depend on rules firing on functions marked as NOINLINE without marking use sites of these functions as INLINE or INLINEABLE then things will break ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -131,7 +131,7 @@ test('linker_error3', [extra_files(['linker_error.c']), ###################################### test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) - , req_rts_linker + , unless(have_dynamic(), skip) # this needs runtime infrastructure to do in ghci: # '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more. , omit_ways(['ghci']) ===================================== testsuite/tests/typecheck/should_compile/T23156.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds, TypeFamilies, PartialTypeSignatures #-} +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T23156 where + +import Prelude +import GHC.TypeLits +import Data.Kind + +type BooleanOf2 :: Type -> Type +type family BooleanOf2 a + +type instance BooleanOf2 Double = Double + +-- Needs to be a type family, changing this to a datatype makes it fast +type TensorOf2 :: Nat -> Type -> Type +type family TensorOf2 k a + +type instance TensorOf2 n Double = Double + + +-- With GHC 9.4 and 9.6, typechecking was +-- exponential in the size of this tuple +type ADReady r = + ( BooleanOf2 r ~ BooleanOf2 (TensorOf2 1 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 2 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 3 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 4 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 5 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 6 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 7 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 8 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 9 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 10 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 11 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 12 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 13 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 14 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 15 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 16 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 17 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 18 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 19 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 20 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 21 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 22 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 23 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 24 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 25 r) + ) + +f :: forall r . (ADReady r) => () +f = undefined + +-- This uses a lot of memory +g :: _ => () +g = f + +-- This is fine +g' = f @Double ===================================== testsuite/tests/typecheck/should_compile/T23156.stderr ===================================== @@ -0,0 +1,25 @@ + +T23156.hs:51:6: warning: [GHC-05617] [-Wdeferred-type-errors (in -Wdefault)] + • Could not deduce ‘BooleanOf2 (TensorOf2 1 r0) ~ BooleanOf2 r0’ + from the context: ADReady r + bound by the type signature for: + f :: forall r. ADReady r => () + at T23156.hs:51:6-33 + NB: ‘BooleanOf2’ is a non-injective type family + The type variables ‘r0’, ‘r0’ are ambiguous + • In the ambiguity check for ‘f’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: f :: forall r. (ADReady r) => () + +T23156.hs:55:6: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] + • Found extra-constraints wildcard standing for ‘() :: Constraint’ + • In the type signature: g :: _ => () + +T23156.hs:56:5: warning: [GHC-18872] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type: BooleanOf2 (TensorOf2 1 r0) + with: BooleanOf2 r0 + arising from a use of ‘f’ + NB: ‘BooleanOf2’ is a non-injective type family + The type variables ‘r0’, ‘r0’ are ambiguous + • In the expression: f + In an equation for ‘g’: g = f ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -874,3 +874,4 @@ test('QualifiedRecordUpdate', test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) +test('T23156', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8787dbee8d23d33211d172a9e0c1d06dc2640db...52abb8685b85b4031a7bbfad7f7948d4d58df0b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8787dbee8d23d33211d172a9e0c1d06dc2640db...52abb8685b85b4031a7bbfad7f7948d4d58df0b5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 10:32:33 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Mon, 22 May 2023 06:32:33 -0400 Subject: [Git][ghc/ghc][wip/t22884] 77 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <646b44c162f1e_9760a75c42a8c100827a@gitlab.mail> sheaf pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - a0a02bf4 by Matthew Pickering at 2023-05-22T12:28:17+02:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 891098c9 by Matthew Pickering at 2023-05-22T12:32:16+02:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - ecc3d6c4 by Matthew Pickering at 2023-05-22T12:32:19+02:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - e105b2a9 by Matthew Pickering at 2023-05-22T12:32:19+02:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 8f51bb53 by Matthew Pickering at 2023-05-22T12:32:19+02:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf113d74d7da6cedc897ebb5536e1f162cd7c4e1...8f51bb53388f54641c3cb1196aeda8e938d109ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf113d74d7da6cedc897ebb5536e1f162cd7c4e1...8f51bb53388f54641c3cb1196aeda8e938d109ff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 10:44:29 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Mon, 22 May 2023 06:44:29 -0400 Subject: [Git][ghc/ghc][wip/t22884] Apply 1 suggestion(s) to 1 file(s) Message-ID: <646b478ded0a7_9760a4b31b03c10141be@gitlab.mail> sheaf pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: 60c30150 by sheaf at 2023-05-22T10:44:27+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - compiler/GHC/Types/Error.hs Changes: ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -285,7 +285,7 @@ data NoDiagnosticOpts = NoDiagnosticOpts instance HasDefaultDiagnosticOpts NoDiagnosticOpts where defaultOpts = NoDiagnosticOpts --- | Make a "simple" unknown diagnostic which doesn't have +-- | Make a "simple" unknown diagnostic which doesn't have any configuration options. mkSimpleUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) => a -> UnknownDiagnostic b mkSimpleUnknownDiagnostic = UnknownDiagnostic (const NoDiagnosticOpts) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60c301500086068ae9f3230ff6174595d1f16a0c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60c301500086068ae9f3230ff6174595d1f16a0c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 10:44:59 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Mon, 22 May 2023 06:44:59 -0400 Subject: [Git][ghc/ghc][wip/t22884] 4 commits: Generalise UnknownDiagnostic to allow embedded diagnostics to access Message-ID: <646b47ab5a533_9760a75c42aa010145f0@gitlab.mail> sheaf pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC Commits: 0d86c126 by Matthew Pickering at 2023-05-22T12:44:51+02:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - 80c82029 by Matthew Pickering at 2023-05-22T12:44:51+02:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - c87ea852 by Matthew Pickering at 2023-05-22T12:44:51+02:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 3bbd45bb by Matthew Pickering at 2023-05-22T12:44:51+02:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 30 changed files: - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - + testsuite/tests/package/T22884.hs - + testsuite/tests/package/T22884.stderr - + testsuite/tests/package/T22884_interactive.script The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60c301500086068ae9f3230ff6174595d1f16a0c...3bbd45bb4d85bd996f6662058ee204a63fe0bf38 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60c301500086068ae9f3230ff6174595d1f16a0c...3bbd45bb4d85bd996f6662058ee204a63fe0bf38 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 11:24:01 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 22 May 2023 07:24:01 -0400 Subject: [Git][ghc/ghc][wip/or-pats] update submodule haddock Message-ID: <646b50d1c4c05_9760a4dab370c102504c@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 009d33f5 by David Knothe at 2023-05-22T13:23:57+02:00 update submodule haddock - - - - - 2 changed files: - compiler/GHC/Rename/Pat.hs - utils/haddock Changes: ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -44,7 +44,6 @@ import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr ) import {-# SOURCE #-} GHC.Rename.Splice ( rnSplicePat ) import GHC.Hs --- import GHC.Hs.Pat ( patHasTyAppsL ) import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( hsOverLitName ) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 +Subproject commit bd13cd688bebe1e6afa53d30ccf70339166c08e2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/009d33f5d56a1a8aeb172b59f1be961afb88dc11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/009d33f5d56a1a8aeb172b59f1be961afb88dc11 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 11:43:46 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 22 May 2023 07:43:46 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-hline Message-ID: <646b55729d5d_9760a4dab370c102972d@gitlab.mail> Josh Meredith pushed new branch wip/js-hline at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-hline You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 12:19:01 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 22 May 2023 08:19:01 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 16 commits: Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <646b5db5d67d5_9760a4dab370c10417c1@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - e8a5ea6f by Ben Gamari at 2023-05-22T12:18:59+00:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.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/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0190e9fe6f6f5989fbd016881388c20a7fde3bcb...e8a5ea6fd4d22acc169672663056c19bdcb1ad32 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0190e9fe6f6f5989fbd016881388c20a7fde3bcb...e8a5ea6fd4d22acc169672663056c19bdcb1ad32 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 13:33:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 May 2023 09:33:21 -0400 Subject: [Git][ghc/ghc][wip/ghc-internals] 58 commits: Replace the implementation of CodeBuffers with unboxed types Message-ID: <646b6f2132437_9760a7a5e39ac1077962@gitlab.mail> Ben Gamari pushed to branch wip/ghc-internals at Glasgow Haskell Compiler / GHC Commits: fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - a5b2dfde by Ben Gamari at 2023-05-19T14:02:19-04:00 compiler: Make OccSet opaque - - - - - 8dde41ea by Ben Gamari at 2023-05-21T13:41:18-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - fb717957 by Ben Gamari at 2023-05-21T17:23:11-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - dc40f18d by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Introduce Data.Enum - - - - - e85137bf by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Num.Integer - - - - - a4a71b53 by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Num - - - - - 519165d9 by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Num.Natural - - - - - e89886ea by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Introduce Data.Show - - - - - 89365938 by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Float - - - - - 8ebf2135 by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Add export list to GHC.Real - - - - - cb04f82c by Ben Gamari at 2023-05-21T17:23:54-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 3330919f by Ben Gamari at 2023-05-21T18:13:36-04:00 base: Break up GHC.Base - - - - - 3bdd2cfd by Ben Gamari at 2023-05-21T20:45:02-04:00 base: Prefer use of GHC.Maybe to Data.Maybe `GHC.Maybe` is significantly lower in the dependency graph and consequently less likely to introduce import cycles; use it where possible. To facilitate this we move a few simple `Maybe` combinators from `Data.Maybe` to `GHC.Maybe1`. - - - - - 684873e0 by Ben Gamari at 2023-05-21T20:45:10-04:00 base: Move integer showing functions from Numeric to GHC.Show.Integer These functions are needed in GHC.Show and Numeric brings in quite a bit more than strictly necessary. - - - - - 654c3374 by Ben Gamari at 2023-05-21T21:19:36-04:00 base: Move Generic ByteOrder instance into GHC.Generics GHC.Generics is rather high in the dependency tree. - - - - - bb5bd309 by Ben Gamari at 2023-05-21T21:34:12-04:00 Break dependence on Generics from Semigroup - - - - - 19c15ab2 by Ben Gamari at 2023-05-21T21:49:50-04:00 Eliminate boot for GHC.ByteOrder - - - - - bd7bf1b3 by Ben Gamari at 2023-05-21T22:03:44-04:00 compiler: Don't import GHC.Base - - - - - 81cebc31 by Ben Gamari at 2023-05-21T22:15:48-04:00 base: Drop re-export of GHC.Maybe from GHC.Base - - - - - b9b73808 by Ben Gamari at 2023-05-22T03:51:51-04:00 base: Drop re-export of GHC.Base.NonEmpty from GHC.Base - - - - - addcd699 by Ben Gamari at 2023-05-22T09:33:03-04:00 base: Drop re-export of GHC.Err from GHC.Base - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c446d19c2b9a943ecbbb094a613df3693f2bab5d...addcd699666dbc3718fb10e2f3c786926a8e74cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c446d19c2b9a943ecbbb094a613df3693f2bab5d...addcd699666dbc3718fb10e2f3c786926a8e74cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 13:53:31 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 09:53:31 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 78 commits: rts: Ensure non-moving gc is not running when pausing Message-ID: <646b73db873a2_9760a75c42a781086611@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - c66f20aa by Rodrigo Mesquita at 2023-05-22T11:14:08+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]) Cleanup: Hadrian no longer needs to pass the CPP configuration through -optP Closes #23422 - - - - - b956eda8 by Ben Gamari at 2023-05-22T11:39:49+01:00 ghc-toolchain: Initial commit - - - - - 4f7ebc49 by Ben Gamari at 2023-05-22T11:39:49+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 39978e97 by Ben Gamari at 2023-05-22T11:39:49+01:00 Move via-C flags into GHC - - - - - 4aba7fdd by Ben Gamari at 2023-05-22T11:57:16+01:00 Rip out runtime linker/compiler checks - - - - - 74f03f24 by Ben Gamari at 2023-05-22T11:57:18+01:00 configure: Rip out toolchain selection logic - - - - - d52ec4a9 by Ben Gamari at 2023-05-22T11:57:18+01:00 Fixes - - - - - 691a520d by Rodrigo Mesquita at 2023-05-22T11:57:18+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 062f4a03 by Rodrigo Mesquita at 2023-05-22T11:57:18+01:00 Re-introduce ld-override option - - - - - fb9ad740 by Rodrigo Mesquita at 2023-05-22T11:57:18+01:00 ROMES:WIP - - - - - 1fbf500e by Rodrigo Mesquita at 2023-05-22T11:57:18+01:00 ghc-toolchain library and usage in hadrian flags - - - - - e1232993 by Rodrigo Mesquita at 2023-05-22T12:16:30+01:00 ROMES: WIP - - - - - 6d681e97 by Rodrigo Mesquita at 2023-05-22T12:16:33+01:00 Re-introduce flags in hadrian config - - - - - 0606659f by Rodrigo Mesquita at 2023-05-22T12:16:33+01:00 ROMES WIP - - - - - 71991d5f by Rodrigo Mesquita at 2023-05-22T12:16:33+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 773de27a by Rodrigo Mesquita at 2023-05-22T12:24:46+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - 01f5d4b4 by Rodrigo Mesquita at 2023-05-22T12:30:16+01:00 Rip more of configure that is no longer being used - - - - - 0ee8287a by Rodrigo Mesquita at 2023-05-22T12:30:18+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - dffbc61d by Rodrigo Mesquita at 2023-05-22T12:30:18+01:00 Rip out more from hadrians system.config.in - - - - - a524ffad by Rodrigo Mesquita at 2023-05-22T12:42:33+01:00 Configure CLink supports response files - - - - - e4dfaacb by Rodrigo Mesquita at 2023-05-22T12:42:34+01:00 Read deleted keys from host and target's target - - - - - 351c63ab by Rodrigo Mesquita at 2023-05-22T12:42:34+01:00 ROMES: WIP 3 - - - - - 1a2bbe7c by Rodrigo Mesquita at 2023-05-22T14:51:50+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 91959e0d by Rodrigo Mesquita at 2023-05-22T14:53:19+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - 08483b70 by Rodrigo Mesquita at 2023-05-22T14:53:20+01:00 Handle unspecified vs specified flags and commands better - - - - - 92220af9 by Rodrigo Mesquita at 2023-05-22T14:53:20+01:00 ROMES: WIP 4 - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Backend.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2fff8d824663f128ca31420b1fdcbf50e9af1df4...92220af9f75e84a06647ff21642707ed4d3e38c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2fff8d824663f128ca31420b1fdcbf50e9af1df4...92220af9f75e84a06647ff21642707ed4d3e38c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 14:05:58 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 22 May 2023 10:05:58 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23427 Message-ID: <646b76c633691_9760a75c42a781093179@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23427 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23427 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 14:16:45 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 10:16:45 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646b794d42201_9760a75b6ae5c109811b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 6f36115c by Rodrigo Mesquita at 2023-05-22T15:16:31+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]) Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,44 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- rOMES:TODO: potential causes of bug: + -- not using runSomethingResponseFile + -- ~~not passing userOptC~~ (trying...) + -- not filtering clobbering warnings + run_some_cpp logger dflags "C pre-processor" pgm_cpp (getOpts dflags opt_c ++ args) + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,12 +1,12 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], @@ -58,7 +58,7 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], @@ -97,3 +97,31 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + + # We can't use AC_PROG_CPP here, since CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + AC_ARG_VAR(CPP,[Use as the path to cpp]) + + AS_VAR_IF(CPP,[],[ + # If CPP is not set, use CC with -E + CPP_CMD=$1 + CPP_ARGS="-E $CPPFLAGS" + ],[ + # Otherwise, use whatever was set + CPP_CMD="$CPP" + CPP_ARGS="$CPPFLAGS" + ]) + + $2=$CPP_CMD + $3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f36115c50b9b7176272b49780008e40b5441045 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f36115c50b9b7176272b49780008e40b5441045 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 14:32:02 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 10:32:02 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Configure Cpp and HsCpp separately Message-ID: <646b7ce224bd_9760a75c42aa0109909e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: d6e52272 by Rodrigo Mesquita at 2023-05-22T15:31:55+01:00 Configure Cpp and HsCpp separately - - - - - 4 changed files: - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs Changes: ===================================== m4/ghc_toolchain.m4 ===================================== @@ -21,12 +21,14 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--cc=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - # We can't use $CPP, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - echo "--cpp=$HaskellCPPCmd" >> acargs - # ROMES:TODO: CONF_CPP_OPTS_STAGE1 vs HaskellCPPArgs + # CPP flags + echo "--cpp=$CPPCmd" >> acargs ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) + # HS CPP flags + echo "--hs-cpp=$HaskellCPPCmd" >> acargs + ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs]) + echo "--cc-link=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) echo "--cxx=$CXX" >> acargs ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -35,6 +35,7 @@ data Opts = Opts , optCc :: ProgOpt , optCxx :: ProgOpt , optCpp :: ProgOpt + , optHsCpp :: ProgOpt , optCcLink :: ProgOpt , optAr :: ProgOpt , optRanlib :: ProgOpt @@ -58,6 +59,7 @@ emptyOpts = Opts , optCc = po0 , optCxx = po0 , optCpp = po0 + , optHsCpp = po0 , optCcLink = po0 , optAr = po0 , optRanlib = po0 @@ -76,12 +78,13 @@ emptyOpts = Opts where po0 = emptyProgOpt -_optCc, _optCxx, _optCpp, _optCcLink, _optAr, _optRanlib, _optNm, +_optCc, _optCxx, _optCpp, _optHsCpp, _optCcLink, _optAr, _optRanlib, _optNm, _optReadelf, _optMergeObjs, _optDllwrap, _optWindres :: Lens Opts ProgOpt _optCc = Lens optCc (\x o -> o {optCc=x}) _optCxx = Lens optCxx (\x o -> o {optCxx=x}) _optCpp = Lens optCpp (\x o -> o {optCpp=x}) +_optHsCpp = Lens optHsCpp (\x o -> o {optHsCpp=x}) _optCcLink = Lens optCcLink (\x o -> o {optCcLink=x}) _optAr = Lens optAr (\x o -> o {optAr=x}) _optRanlib = Lens optRanlib (\x o -> o {optRanlib=x}) @@ -131,6 +134,7 @@ options = concat [ progOpts "cc" "C compiler" _optCc , progOpts "cpp" "C preprocessor" _optCpp + , progOpts "hs-cpp" "Haskell C preprocessor" _optHsCpp , progOpts "cxx" "C++ compiler" _optCxx , progOpts "cc-link" "C compiler for linking" _optCcLink , progOpts "ar" "ar archiver" _optAr @@ -289,6 +293,7 @@ mkTarget opts = do cc0 <- findCc (optCc opts) cxx <- findCxx (optCxx opts) cpp <- findCpp (optCpp opts) cc0 + hsCpp <- findHsCpp (optHsCpp opts) cc0 archOs <- parseTriple cc0 (optTriple opts) cc <- addPlatformDepCcFlags archOs cc0 readelf <- optional $ findReadelf (optReadelf opts) @@ -338,6 +343,7 @@ mkTarget opts = do , tgtCCompiler = cc , tgtCxxCompiler = cxx , tgtCPreprocessor = cpp + , tgtHsCPreprocessor = hsCpp , tgtAr = ar , tgtCCompilerLink = ccLink , tgtRanlib = ranlib ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -48,7 +48,8 @@ data Target = Target -- C toolchain , tgtCCompiler :: Cc , tgtCxxCompiler :: Cxx - , tgtCPreprocessor :: Cpp -- if hadrian depends on Cpp (not HsCpp flags) then this isn't sufficient + , tgtCPreprocessor :: Cpp + , tgtHsCPreprocessor :: HsCpp , tgtCCompilerLink :: CcLink -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -1,6 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} -module GHC.Toolchain.Tools.Cpp (Cpp(..), findCpp) where +module GHC.Toolchain.Tools.Cpp (HsCpp(..), findHsCpp, Cpp(..), findCpp) where import Control.Monad import System.FilePath @@ -12,22 +12,28 @@ import GHC.Toolchain.Utils (withTempDir) import GHC.Toolchain.Tools.Cc newtype Cpp = Cpp { cppProgram :: Program - } + } deriving (Show, Read, Eq, Ord) -findCpp :: ProgOpt -> Cc -> M Cpp -findCpp progOpt cc = checking "for C preprocessor" $ do - -- Use the specified CPP or try to find one (candidate is the c compiler) - foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] +newtype HsCpp = HsCpp { hsCppProgram :: Program + } + deriving (Show, Read, Eq, Ord) + +----- Haskell Preprocessor ----- + +findHsCpp :: ProgOpt -> Cc -> M HsCpp +findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do + -- Use the specified HS CPP or try to find one (candidate is the c compiler) + foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [prgPath $ ccProgram cc] case poFlags progOpt of - -- If the user specified CPP flags don't second-guess them - Just _ -> return Cpp{cppProgram=foundCppProg} - -- Otherwise, configure the CPP flags for this CPP program + -- If the user specified HS CPP flags don't second-guess them + Just _ -> return HsCpp{hsCppProgram=foundHsCppProg} + -- Otherwise, configure the HS CPP flags for this CPP program Nothing -> do - let rawCppProgram = over _prgFlags (["-E"]++) foundCppProg - hppArgs <- findHsCppArgs rawCppProgram - let cppProgram = over _prgFlags (++hppArgs) rawCppProgram - return Cpp{cppProgram} + let rawHsCppProgram = over _prgFlags (["-E"]++) foundHsCppProg + hppArgs <- findHsCppArgs rawHsCppProgram + let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram + return HsCpp{hsCppProgram} -- | Given a C preprocessor, figure out how it should be invoked to preprocess -- Haskell source. @@ -51,3 +57,16 @@ findHsCppArgs cpp = withTempDir $ \dir -> do , tryFlag "-Wno-trigraphs" ] +----- C preprocessor ----- + +findCpp :: ProgOpt -> Cc -> M Cpp +findCpp progOpt cc = checking "for C preprocessor" $ do + -- Use the specified HS CPP or try to find one (candidate is the c compiler) + foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] + case poFlags progOpt of + -- If the user specified CPP flags don't second-guess them + Just _ -> return Cpp{cppProgram=foundCppProg} + -- Otherwise, configure the CPP flags for this CPP program + Nothing -> do + let cppProgram = over _prgFlags (["-E"]++) foundCppProg + return Cpp{cppProgram} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6e52272a44055d4f3487c91514cfd27bf20fd3b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6e52272a44055d4f3487c91514cfd27bf20fd3b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 14:36:09 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 10:36:09 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Configure Cpp and HsCpp separately Message-ID: <646b7dd9ef113_9760a75b6d6e810997dc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f93a2dcd by Rodrigo Mesquita at 2023-05-22T15:36:00+01:00 Configure Cpp and HsCpp separately - - - - - 6 changed files: - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/HsCpp.hs - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -189,7 +189,7 @@ settingsFileSetting key = case key of ToolchainSetting_CCompilerCommand -> queryHostTargetConfig (cmd . ccProgram . tgtCCompiler) ToolchainSetting_CxxCompilerCommand -> queryHostTargetConfig (cmd . cxxProgram . tgtCxxCompiler) ToolchainSetting_CPPCommand -> queryHostTargetConfig (cmd . cppProgram . tgtCPreprocessor) - ToolchainSetting_CPPCommand -> queryHostTargetConfig (flags . cppProgram . tgtCPreprocessor) + ToolchainSetting_CPPFlags -> queryHostTargetConfig (flags . cppProgram . tgtCPreprocessor) ToolchainSetting_HaskellCPPCommand -> queryHostTargetConfig (cmd . hsCppProgram . tgtHsCPreprocessor) ToolchainSetting_HaskellCPPFlags -> queryHostTargetConfig (flags . hsCppProgram . tgtHsCPreprocessor) ToolchainSetting_CCompilerFlags -> queryHostTargetConfig (flags . ccProgram . tgtCCompiler) ===================================== hadrian/src/Settings/Builders/HsCpp.hs ===================================== @@ -2,14 +2,14 @@ module Settings.Builders.HsCpp (hsCppBuilderArgs) where import Packages import Settings.Builders.Common -import GHC.Toolchain +import qualified GHC.Toolchain as T import GHC.Toolchain.Program hsCppBuilderArgs :: Args hsCppBuilderArgs = builder HsCpp ? do stage <- getStage ghcPath <- expr $ buildPath (vanillaContext stage compiler) - mconcat [ prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig -- ROMES:TODO: HsCppArgs, not CppArgs, make sure this is the case + mconcat [ prgFlags . T.hsCppProgram . T.tgtHsCPreprocessor <$> getStagedTargetConfig , arg "-P" , arg "-Irts/include" , arg $ "-I" ++ ghcPath ===================================== m4/ghc_toolchain.m4 ===================================== @@ -21,12 +21,14 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--cc=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - # We can't use $CPP, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - echo "--cpp=$HaskellCPPCmd" >> acargs - # ROMES:TODO: CONF_CPP_OPTS_STAGE1 vs HaskellCPPArgs + # CPP flags + echo "--cpp=$CPPCmd" >> acargs ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) + # HS CPP flags + echo "--hs-cpp=$HaskellCPPCmd" >> acargs + ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs]) + echo "--cc-link=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) echo "--cxx=$CXX" >> acargs ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -35,6 +35,7 @@ data Opts = Opts , optCc :: ProgOpt , optCxx :: ProgOpt , optCpp :: ProgOpt + , optHsCpp :: ProgOpt , optCcLink :: ProgOpt , optAr :: ProgOpt , optRanlib :: ProgOpt @@ -58,6 +59,7 @@ emptyOpts = Opts , optCc = po0 , optCxx = po0 , optCpp = po0 + , optHsCpp = po0 , optCcLink = po0 , optAr = po0 , optRanlib = po0 @@ -76,12 +78,13 @@ emptyOpts = Opts where po0 = emptyProgOpt -_optCc, _optCxx, _optCpp, _optCcLink, _optAr, _optRanlib, _optNm, +_optCc, _optCxx, _optCpp, _optHsCpp, _optCcLink, _optAr, _optRanlib, _optNm, _optReadelf, _optMergeObjs, _optDllwrap, _optWindres :: Lens Opts ProgOpt _optCc = Lens optCc (\x o -> o {optCc=x}) _optCxx = Lens optCxx (\x o -> o {optCxx=x}) _optCpp = Lens optCpp (\x o -> o {optCpp=x}) +_optHsCpp = Lens optHsCpp (\x o -> o {optHsCpp=x}) _optCcLink = Lens optCcLink (\x o -> o {optCcLink=x}) _optAr = Lens optAr (\x o -> o {optAr=x}) _optRanlib = Lens optRanlib (\x o -> o {optRanlib=x}) @@ -131,6 +134,7 @@ options = concat [ progOpts "cc" "C compiler" _optCc , progOpts "cpp" "C preprocessor" _optCpp + , progOpts "hs-cpp" "Haskell C preprocessor" _optHsCpp , progOpts "cxx" "C++ compiler" _optCxx , progOpts "cc-link" "C compiler for linking" _optCcLink , progOpts "ar" "ar archiver" _optAr @@ -289,6 +293,7 @@ mkTarget opts = do cc0 <- findCc (optCc opts) cxx <- findCxx (optCxx opts) cpp <- findCpp (optCpp opts) cc0 + hsCpp <- findHsCpp (optHsCpp opts) cc0 archOs <- parseTriple cc0 (optTriple opts) cc <- addPlatformDepCcFlags archOs cc0 readelf <- optional $ findReadelf (optReadelf opts) @@ -338,6 +343,7 @@ mkTarget opts = do , tgtCCompiler = cc , tgtCxxCompiler = cxx , tgtCPreprocessor = cpp + , tgtHsCPreprocessor = hsCpp , tgtAr = ar , tgtCCompilerLink = ccLink , tgtRanlib = ranlib ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -48,7 +48,8 @@ data Target = Target -- C toolchain , tgtCCompiler :: Cc , tgtCxxCompiler :: Cxx - , tgtCPreprocessor :: Cpp -- if hadrian depends on Cpp (not HsCpp flags) then this isn't sufficient + , tgtCPreprocessor :: Cpp + , tgtHsCPreprocessor :: HsCpp , tgtCCompilerLink :: CcLink -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -1,6 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} -module GHC.Toolchain.Tools.Cpp (Cpp(..), findCpp) where +module GHC.Toolchain.Tools.Cpp (HsCpp(..), findHsCpp, Cpp(..), findCpp) where import Control.Monad import System.FilePath @@ -12,22 +12,28 @@ import GHC.Toolchain.Utils (withTempDir) import GHC.Toolchain.Tools.Cc newtype Cpp = Cpp { cppProgram :: Program - } + } deriving (Show, Read, Eq, Ord) -findCpp :: ProgOpt -> Cc -> M Cpp -findCpp progOpt cc = checking "for C preprocessor" $ do - -- Use the specified CPP or try to find one (candidate is the c compiler) - foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] +newtype HsCpp = HsCpp { hsCppProgram :: Program + } + deriving (Show, Read, Eq, Ord) + +----- Haskell Preprocessor ----- + +findHsCpp :: ProgOpt -> Cc -> M HsCpp +findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do + -- Use the specified HS CPP or try to find one (candidate is the c compiler) + foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [prgPath $ ccProgram cc] case poFlags progOpt of - -- If the user specified CPP flags don't second-guess them - Just _ -> return Cpp{cppProgram=foundCppProg} - -- Otherwise, configure the CPP flags for this CPP program + -- If the user specified HS CPP flags don't second-guess them + Just _ -> return HsCpp{hsCppProgram=foundHsCppProg} + -- Otherwise, configure the HS CPP flags for this CPP program Nothing -> do - let rawCppProgram = over _prgFlags (["-E"]++) foundCppProg - hppArgs <- findHsCppArgs rawCppProgram - let cppProgram = over _prgFlags (++hppArgs) rawCppProgram - return Cpp{cppProgram} + let rawHsCppProgram = over _prgFlags (["-E"]++) foundHsCppProg + hppArgs <- findHsCppArgs rawHsCppProgram + let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram + return HsCpp{hsCppProgram} -- | Given a C preprocessor, figure out how it should be invoked to preprocess -- Haskell source. @@ -51,3 +57,16 @@ findHsCppArgs cpp = withTempDir $ \dir -> do , tryFlag "-Wno-trigraphs" ] +----- C preprocessor ----- + +findCpp :: ProgOpt -> Cc -> M Cpp +findCpp progOpt cc = checking "for C preprocessor" $ do + -- Use the specified HS CPP or try to find one (candidate is the c compiler) + foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] + case poFlags progOpt of + -- If the user specified CPP flags don't second-guess them + Just _ -> return Cpp{cppProgram=foundCppProg} + -- Otherwise, configure the CPP flags for this CPP program + Nothing -> do + let cppProgram = over _prgFlags (["-E"]++) foundCppProg + return Cpp{cppProgram} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f93a2dcdfde076b33d5587dc05ee8f977b35b5eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f93a2dcdfde076b33d5587dc05ee8f977b35b5eb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 14:41:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 May 2023 10:41:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: testsuite: fix predicate on rdynamic test Message-ID: <646b7f0d5c5fe_9760a4b31b03c11053bc@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - e26e1a22 by Sylvain Henry at 2023-05-22T10:41:09-04:00 NCG: remove useless .align directive (#20758) - - - - - a94db291 by Simon Peyton Jones at 2023-05-22T10:41:10-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 11 changed files: - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/rewrite_rules.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/using-optimisation.rst - testsuite/tests/rts/linker/all.T - + testsuite/tests/typecheck/should_compile/T23156.hs - + testsuite/tests/typecheck/should_compile/T23156.stderr - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -18,7 +18,6 @@ import GHC.CmmToAsm.Utils import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Label -import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes) import GHC.Cmm.BlockId import GHC.Cmm.CLabel @@ -29,18 +28,12 @@ import GHC.Utils.Outputable import GHC.Utils.Panic -pprProcAlignment :: IsDoc doc => NCGConfig -> doc -pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config) - where - platform = ncgPlatform config - pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc pprNatCmmDecl config (CmmData section dats) = pprSectionAlign config section $$ pprDatas config dats pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = let platform = ncgPlatform config in - pprProcAlignment config $$ case topInfoTable proc of Nothing -> -- special case for code without info table: @@ -80,10 +73,6 @@ pprLabel platform lbl = $$ pprTypeDecl platform lbl $$ line (pprAsmLabel platform lbl <> char ':') -pprAlign :: IsDoc doc => Platform -> Alignment -> doc -pprAlign _platform alignment - = line $ text "\t.balign " <> int (alignmentBytes alignment) - -- | Print appropriate alignment for the given section type. pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc pprAlignForSection _platform _seg ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -74,7 +74,6 @@ pprNatCmmDecl config (CmmData section dats) = pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = let platform = ncgPlatform config in - pprProcAlignment config $$ case topInfoTable proc of Nothing -> -- special case for code without info table: ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -33,11 +33,10 @@ Compiler - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking - the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket - #22448 for further details. + the specification described in the documentation of the `INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. - Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. - See GHC ticket #23049. + See :ghc-ticket:`23049`. - The ``-Wno-⟨wflag⟩``, ``-Werror=⟨wflag⟩`` and ``-Wwarn=⟨wflag⟩`` options are now defined systematically for all warning groups (for example, @@ -121,7 +120,7 @@ Runtime system ~~~~~~~~~~~~~~ - On POSIX systems that support timerfd, RTS shutdown no longer has to wait for - the next RTS 'tick' to occur before continuing the shutdown process. See #22692. + the next RTS 'tick' to occur before continuing the shutdown process. See :ghc-ticket:`22692`. ``base`` library ~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -287,7 +287,7 @@ would invoke GHC like this: Plugins can be also be loaded from libraries directly. It allows plugins to be -loaded in cross-compilers (as a workaround for #14335). +loaded in cross-compilers (as a workaround for :ghc-ticket:`14335`). .. ghc-flag:: -fplugin-library=⟨file-path⟩;⟨unit-id⟩;⟨module⟩;⟨args⟩ :shortdesc: Load a pre-compiled static plugin from an external library ===================================== docs/users_guide/exts/rewrite_rules.rst ===================================== @@ -262,7 +262,7 @@ From a semantic point of view: {-# RULES forall @m (x :: KnownNat m => Proxy m). g x = blah #-} - See `#21093 `_ for discussion. + See :ghc-ticket:`21093` for discussion. .. _rules-inline: ===================================== docs/users_guide/exts/template_haskell.rst ===================================== @@ -135,7 +135,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under spliced expression must have type ``Code Q a`` **NOTE**: Currently typed splices may inhibit the unused identifier warning for - identifiers in scope. See `#16524 ` + identifiers in scope. See :ghc-ticket:`16524`. - A *typed* expression quotation is written as ``[|| ... ||]``, or ``[e|| ... ||]``, where the "..." is an expression; if the "..." ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1691,7 +1691,7 @@ as such you shouldn't need to set any of them explicitly. A flag overhead for the check disappears completely. This can cause slight codesize increases. It will also cause many more functions - to get a worker/wrapper split which can play badly with rules (see Ticket #20364) + to get a worker/wrapper split which can play badly with rules (see :ghc-ticket:`20364`) which is why it's currently disabled by default. In particular if you depend on rules firing on functions marked as NOINLINE without marking use sites of these functions as INLINE or INLINEABLE then things will break ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -131,7 +131,7 @@ test('linker_error3', [extra_files(['linker_error.c']), ###################################### test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) - , req_rts_linker + , unless(have_dynamic(), skip) # this needs runtime infrastructure to do in ghci: # '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more. , omit_ways(['ghci']) ===================================== testsuite/tests/typecheck/should_compile/T23156.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds, TypeFamilies, PartialTypeSignatures #-} +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T23156 where + +import Prelude +import GHC.TypeLits +import Data.Kind + +type BooleanOf2 :: Type -> Type +type family BooleanOf2 a + +type instance BooleanOf2 Double = Double + +-- Needs to be a type family, changing this to a datatype makes it fast +type TensorOf2 :: Nat -> Type -> Type +type family TensorOf2 k a + +type instance TensorOf2 n Double = Double + + +-- With GHC 9.4 and 9.6, typechecking was +-- exponential in the size of this tuple +type ADReady r = + ( BooleanOf2 r ~ BooleanOf2 (TensorOf2 1 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 2 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 3 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 4 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 5 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 6 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 7 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 8 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 9 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 10 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 11 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 12 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 13 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 14 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 15 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 16 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 17 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 18 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 19 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 20 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 21 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 22 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 23 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 24 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 25 r) + ) + +f :: forall r . (ADReady r) => () +f = undefined + +-- This uses a lot of memory +g :: _ => () +g = f + +-- This is fine +g' = f @Double ===================================== testsuite/tests/typecheck/should_compile/T23156.stderr ===================================== @@ -0,0 +1,25 @@ + +T23156.hs:51:6: warning: [GHC-05617] [-Wdeferred-type-errors (in -Wdefault)] + • Could not deduce ‘BooleanOf2 (TensorOf2 1 r0) ~ BooleanOf2 r0’ + from the context: ADReady r + bound by the type signature for: + f :: forall r. ADReady r => () + at T23156.hs:51:6-33 + NB: ‘BooleanOf2’ is a non-injective type family + The type variables ‘r0’, ‘r0’ are ambiguous + • In the ambiguity check for ‘f’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: f :: forall r. (ADReady r) => () + +T23156.hs:55:6: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] + • Found extra-constraints wildcard standing for ‘() :: Constraint’ + • In the type signature: g :: _ => () + +T23156.hs:56:5: warning: [GHC-18872] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type: BooleanOf2 (TensorOf2 1 r0) + with: BooleanOf2 r0 + arising from a use of ‘f’ + NB: ‘BooleanOf2’ is a non-injective type family + The type variables ‘r0’, ‘r0’ are ambiguous + • In the expression: f + In an equation for ‘g’: g = f ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -874,3 +874,4 @@ test('QualifiedRecordUpdate', test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) +test('T23156', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d74a11115ee26942262f95a0f617945835cf2ed2...a94db291bc8deb3c25bf077c5d656bbd6ffd9473 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d74a11115ee26942262f95a0f617945835cf2ed2...a94db291bc8deb3c25bf077c5d656bbd6ffd9473 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 14:51:19 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 10:51:19 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Configure Cpp and HsCpp separately Message-ID: <646b81672a252_9760a75c42aa011104ce@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: fad8a5ed by Rodrigo Mesquita at 2023-05-22T15:51:10+01:00 Configure Cpp and HsCpp separately - - - - - 7 changed files: - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/HsCpp.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -189,7 +189,7 @@ settingsFileSetting key = case key of ToolchainSetting_CCompilerCommand -> queryHostTargetConfig (cmd . ccProgram . tgtCCompiler) ToolchainSetting_CxxCompilerCommand -> queryHostTargetConfig (cmd . cxxProgram . tgtCxxCompiler) ToolchainSetting_CPPCommand -> queryHostTargetConfig (cmd . cppProgram . tgtCPreprocessor) - ToolchainSetting_CPPCommand -> queryHostTargetConfig (flags . cppProgram . tgtCPreprocessor) + ToolchainSetting_CPPFlags -> queryHostTargetConfig (flags . cppProgram . tgtCPreprocessor) ToolchainSetting_HaskellCPPCommand -> queryHostTargetConfig (cmd . hsCppProgram . tgtHsCPreprocessor) ToolchainSetting_HaskellCPPFlags -> queryHostTargetConfig (flags . hsCppProgram . tgtHsCPreprocessor) ToolchainSetting_CCompilerFlags -> queryHostTargetConfig (flags . ccProgram . tgtCCompiler) ===================================== hadrian/src/Settings/Builders/HsCpp.hs ===================================== @@ -2,14 +2,14 @@ module Settings.Builders.HsCpp (hsCppBuilderArgs) where import Packages import Settings.Builders.Common -import GHC.Toolchain +import qualified GHC.Toolchain as T import GHC.Toolchain.Program hsCppBuilderArgs :: Args hsCppBuilderArgs = builder HsCpp ? do stage <- getStage ghcPath <- expr $ buildPath (vanillaContext stage compiler) - mconcat [ prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig -- ROMES:TODO: HsCppArgs, not CppArgs, make sure this is the case + mconcat [ prgFlags . T.hsCppProgram . T.tgtHsCPreprocessor <$> getStagedTargetConfig , arg "-P" , arg "-Irts/include" , arg $ "-I" ++ ghcPath ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -52,7 +52,8 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> (prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig)) - , prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig + -- Either "-E" is not part of the configured cpp args, or we can't add those args to invocations of things like this + -- ROMES:TODO: , prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/ghc_toolchain.m4 ===================================== @@ -21,12 +21,14 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--cc=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - # We can't use $CPP, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - echo "--cpp=$HaskellCPPCmd" >> acargs - # ROMES:TODO: CONF_CPP_OPTS_STAGE1 vs HaskellCPPArgs + # CPP flags + echo "--cpp=$CPPCmd" >> acargs ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) + # HS CPP flags + echo "--hs-cpp=$HaskellCPPCmd" >> acargs + ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs]) + echo "--cc-link=$CC" >> acargs ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) echo "--cxx=$CXX" >> acargs ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -35,6 +35,7 @@ data Opts = Opts , optCc :: ProgOpt , optCxx :: ProgOpt , optCpp :: ProgOpt + , optHsCpp :: ProgOpt , optCcLink :: ProgOpt , optAr :: ProgOpt , optRanlib :: ProgOpt @@ -58,6 +59,7 @@ emptyOpts = Opts , optCc = po0 , optCxx = po0 , optCpp = po0 + , optHsCpp = po0 , optCcLink = po0 , optAr = po0 , optRanlib = po0 @@ -76,12 +78,13 @@ emptyOpts = Opts where po0 = emptyProgOpt -_optCc, _optCxx, _optCpp, _optCcLink, _optAr, _optRanlib, _optNm, +_optCc, _optCxx, _optCpp, _optHsCpp, _optCcLink, _optAr, _optRanlib, _optNm, _optReadelf, _optMergeObjs, _optDllwrap, _optWindres :: Lens Opts ProgOpt _optCc = Lens optCc (\x o -> o {optCc=x}) _optCxx = Lens optCxx (\x o -> o {optCxx=x}) _optCpp = Lens optCpp (\x o -> o {optCpp=x}) +_optHsCpp = Lens optHsCpp (\x o -> o {optHsCpp=x}) _optCcLink = Lens optCcLink (\x o -> o {optCcLink=x}) _optAr = Lens optAr (\x o -> o {optAr=x}) _optRanlib = Lens optRanlib (\x o -> o {optRanlib=x}) @@ -131,6 +134,7 @@ options = concat [ progOpts "cc" "C compiler" _optCc , progOpts "cpp" "C preprocessor" _optCpp + , progOpts "hs-cpp" "Haskell C preprocessor" _optHsCpp , progOpts "cxx" "C++ compiler" _optCxx , progOpts "cc-link" "C compiler for linking" _optCcLink , progOpts "ar" "ar archiver" _optAr @@ -289,6 +293,7 @@ mkTarget opts = do cc0 <- findCc (optCc opts) cxx <- findCxx (optCxx opts) cpp <- findCpp (optCpp opts) cc0 + hsCpp <- findHsCpp (optHsCpp opts) cc0 archOs <- parseTriple cc0 (optTriple opts) cc <- addPlatformDepCcFlags archOs cc0 readelf <- optional $ findReadelf (optReadelf opts) @@ -338,6 +343,7 @@ mkTarget opts = do , tgtCCompiler = cc , tgtCxxCompiler = cxx , tgtCPreprocessor = cpp + , tgtHsCPreprocessor = hsCpp , tgtAr = ar , tgtCCompilerLink = ccLink , tgtRanlib = ranlib ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -48,7 +48,8 @@ data Target = Target -- C toolchain , tgtCCompiler :: Cc , tgtCxxCompiler :: Cxx - , tgtCPreprocessor :: Cpp -- if hadrian depends on Cpp (not HsCpp flags) then this isn't sufficient + , tgtCPreprocessor :: Cpp + , tgtHsCPreprocessor :: HsCpp , tgtCCompilerLink :: CcLink -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -1,6 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} -module GHC.Toolchain.Tools.Cpp (Cpp(..), findCpp) where +module GHC.Toolchain.Tools.Cpp (HsCpp(..), findHsCpp, Cpp(..), findCpp) where import Control.Monad import System.FilePath @@ -12,22 +12,28 @@ import GHC.Toolchain.Utils (withTempDir) import GHC.Toolchain.Tools.Cc newtype Cpp = Cpp { cppProgram :: Program - } + } deriving (Show, Read, Eq, Ord) -findCpp :: ProgOpt -> Cc -> M Cpp -findCpp progOpt cc = checking "for C preprocessor" $ do - -- Use the specified CPP or try to find one (candidate is the c compiler) - foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] +newtype HsCpp = HsCpp { hsCppProgram :: Program + } + deriving (Show, Read, Eq, Ord) + +----- Haskell Preprocessor ----- + +findHsCpp :: ProgOpt -> Cc -> M HsCpp +findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do + -- Use the specified HS CPP or try to find one (candidate is the c compiler) + foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [prgPath $ ccProgram cc] case poFlags progOpt of - -- If the user specified CPP flags don't second-guess them - Just _ -> return Cpp{cppProgram=foundCppProg} - -- Otherwise, configure the CPP flags for this CPP program + -- If the user specified HS CPP flags don't second-guess them + Just _ -> return HsCpp{hsCppProgram=foundHsCppProg} + -- Otherwise, configure the HS CPP flags for this CPP program Nothing -> do - let rawCppProgram = over _prgFlags (["-E"]++) foundCppProg - hppArgs <- findHsCppArgs rawCppProgram - let cppProgram = over _prgFlags (++hppArgs) rawCppProgram - return Cpp{cppProgram} + let rawHsCppProgram = over _prgFlags (["-E"]++) foundHsCppProg + hppArgs <- findHsCppArgs rawHsCppProgram + let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram + return HsCpp{hsCppProgram} -- | Given a C preprocessor, figure out how it should be invoked to preprocess -- Haskell source. @@ -51,3 +57,16 @@ findHsCppArgs cpp = withTempDir $ \dir -> do , tryFlag "-Wno-trigraphs" ] +----- C preprocessor ----- + +findCpp :: ProgOpt -> Cc -> M Cpp +findCpp progOpt cc = checking "for C preprocessor" $ do + -- Use the specified HS CPP or try to find one (candidate is the c compiler) + foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] + case poFlags progOpt of + -- If the user specified CPP flags don't second-guess them + Just _ -> return Cpp{cppProgram=foundCppProg} + -- Otherwise, configure the CPP flags for this CPP program + Nothing -> do + let cppProgram = over _prgFlags (["-E"]++) foundCppProg + return Cpp{cppProgram} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fad8a5ed808b5e56b51983f546cc0453bdb7d278 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fad8a5ed808b5e56b51983f546cc0453bdb7d278 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 14:59:10 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 22 May 2023 10:59:10 -0400 Subject: [Git][ghc/ghc][wip/expand-do] PopSrcSpan as a XXExprGhcRn Message-ID: <646b833e3e7b6_9760a4dab370c111094e@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: f78b3ddc by Apoorv Ingle at 2023-05-22T09:58:38-05:00 PopSrcSpan as a XXExprGhcRn - - - - - 15 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/Language/Haskell/Syntax/Expr.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -441,7 +441,7 @@ tupArgPresent (Missing {}) = False ********************************************************************* -} type instance XXExpr GhcPs = DataConCantHappen -type instance XXExpr GhcRn = HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) +type instance XXExpr GhcRn = XXExprGhcRn type instance XXExpr GhcTc = XXExprGhcTc -- HsExpansion: see Note [Rebindable syntax and HsExpansion] below @@ -454,6 +454,19 @@ type instance XXExpr GhcTc = XXExprGhcTc * * ********************************************************************* -} +type HsExprOrStmt a = Either (HsExpr a) (ExprLStmt a) + +data XXExprGhcRn + = ExpansionExprRn !(HsExpansion (HsExprOrStmt GhcRn) (HsExpr GhcRn)) + | PopSrcSpan !(LHsExpr GhcRn) + -- Placeholder for identifying generated source locations in GhcRn phase + -- Should not presist post typechecking + -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match + + +mkPopSrcSpanExpr :: LHsExpr GhcRn -> HsExpr GhcRn +mkPopSrcSpanExpr a = XExpr (PopSrcSpan a) + -- | Build a 'HsExpansion' out of an extension constructor, -- and the two components of the expansion: original and -- desugared expressions. @@ -461,7 +474,7 @@ mkExpandedExpr :: HsExpr GhcRn -- ^ source expression -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedExpr a b = XExpr (HsExpanded a b) +mkExpandedExpr a b = XExpr (ExpansionExprRn (HsExpanded (Left a) b)) data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions @@ -726,10 +739,9 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcRn -> ppr x GhcTc -> ppr x -ppr_expr (PopSrcSpan x) = case ghcPass @p of - GhcPs -> panic "ppr_expr Ps HsPopSrcSpan" - GhcRn -> ppr x - GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" +instance Outputable XXExprGhcRn where + ppr (ExpansionExprRn e) = ppr e + ppr (PopSrcSpan e) = ppr e instance Outputable XXExprGhcTc where @@ -770,8 +782,10 @@ ppr_infix_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr_infix_expr_tc x ppr_infix_expr _ = Nothing -ppr_infix_expr_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Maybe SDoc -ppr_infix_expr_rn (HsExpanded a _) = ppr_infix_expr a +ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc +ppr_infix_expr_rn (ExpansionExprRn (HsExpanded (Left a) _)) = ppr_infix_expr a +ppr_infix_expr_rn (ExpansionExprRn _) = Nothing +ppr_infix_expr_rn (PopSrcSpan (L _ a)) = ppr_infix_expr a ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc ppr_infix_expr_tc (WrapExpr (HsWrap _ e)) = ppr_infix_expr e @@ -851,7 +865,6 @@ hsExprNeedsParens prec = go go (HsDo _ sc _) | isDoComprehensionContext sc = False | otherwise = prec > topPrec - go (PopSrcSpan{}) = prec > topPrec go (ExplicitList{}) = False go (RecordUpd{}) = False go (ExprWithTySig{}) = prec >= sigPrec @@ -881,8 +894,10 @@ hsExprNeedsParens prec = go go_x_tc (HsTick _ (L _ e)) = hsExprNeedsParens prec e go_x_tc (HsBinTick _ _ (L _ e)) = hsExprNeedsParens prec e - go_x_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Bool - go_x_rn (HsExpanded a _) = hsExprNeedsParens prec a + go_x_rn :: XXExprGhcRn -> Bool + go_x_rn (ExpansionExprRn (HsExpanded (Left a) _)) = hsExprNeedsParens prec a + go_x_rn (ExpansionExprRn _) = False + go_x_rn (PopSrcSpan (L _ a)) = hsExprNeedsParens prec a -- | Parenthesize an expression without token information @@ -924,8 +939,10 @@ isAtomicHsExpr (XExpr x) go_x_tc (HsTick {}) = False go_x_tc (HsBinTick {}) = False - go_x_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Bool - go_x_rn (HsExpanded a _) = isAtomicHsExpr a + go_x_rn :: XXExprGhcRn -> Bool + go_x_rn (ExpansionExprRn (HsExpanded (Left a) _)) = isAtomicHsExpr a + go_x_rn (ExpansionExprRn (HsExpanded _ _)) = False + go_x_rn (PopSrcSpan (L _ a)) = isAtomicHsExpr a isAtomicHsExpr _ = False ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -556,6 +556,7 @@ deriving instance Eq (IE GhcTc) -- --------------------------------------------------------------------- +deriving instance Data XXExprGhcRn deriving instance Data XXExprGhcTc deriving instance Data XXPatGhcTc ===================================== compiler/GHC/Hs/Syn/Type.hs ===================================== @@ -120,7 +120,6 @@ hsExprType (HsIf _ _ t _) = lhsExprType t hsExprType (HsMultiIf ty _) = ty hsExprType (HsLet _ _ _ _ body) = lhsExprType body hsExprType (HsDo ty _ _) = ty -hsExprType (PopSrcSpan expr) = pprPanic "hsExprType" (text "impossible happened PopSrcSpan" <+> ppr expr) hsExprType (ExplicitList ty _) = mkListTy ty hsExprType (RecordCon con_expr _ _) = hsExprType con_expr hsExprType (RecordUpd v _ _) = dataConCantHappen v ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -279,7 +279,7 @@ mkHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) => [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -mkHsLamDoExp pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches)) +mkHsLamDoExp pats body = mkHsPar (noLocA $ HsLam noExtField matches) where matches = mkMatchGroup (Generated DoExpansion) (noLocA [mkSimpleMatch LambdaExpr pats' body]) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -259,8 +259,6 @@ dsExpr (HsOverLit _ lit) = do { warnAboutOverflowedOverLit lit ; dsOverLit lit } -dsExpr e@(PopSrcSpan {}) = pprPanic "dsExpr" (ppr e) - dsExpr e@(XExpr ext_expr_tc) = case ext_expr_tc of ExpansionExpr (HsExpanded _ b) -> dsExpr b ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1654,16 +1654,19 @@ repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ (FieldLabelString f))))) = do e1 <- repLE e repGetField e1 f repE (HsProjection _ xs) = repProjection (fmap (field_label . unLoc . dfoLabel . unLoc) xs) -repE (XExpr (HsExpanded orig_expr ds_expr)) +repE (XExpr (ExpansionExprRn (HsExpanded orig_expr_or_stmt ds_expr))) = do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax ; if rebindable_on -- See Note [Quotation and rebindable syntax] then repE ds_expr - else repE orig_expr } + else case orig_expr_or_stmt of + Left e -> repE e + Right st -> pprPanic "repE: unexpected do stmt" (ppr st)} +repE (XExpr (PopSrcSpan (L _ e))) = repE e repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e) repE e@(HsTypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsUntypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsProc{}) = notHandled (ThExpressionForm e) -repE e@(PopSrcSpan{}) = notHandled (ThExpressionForm e) + {- Note [Quotation and rebindable syntax] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -605,7 +605,6 @@ addTickHsExpr (XExpr (HsTick t e)) = liftM (XExpr . HsTick t) (addTickLHsExprNever e) addTickHsExpr (XExpr (HsBinTick t0 t1 e)) = liftM (XExpr . HsBinTick t0 t1) (addTickLHsExprNever e) -addTickHsExpr e@(PopSrcSpan _) = pprPanic "addTickHsExpr: impossible happen PopSrcSpan" (ppr e) addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc) addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1234,7 +1234,6 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where ] HsGetField {} -> [] HsProjection {} -> [] - PopSrcSpan {} -> [] XExpr x | HieTc <- hiePass @p -> case x of ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -561,8 +561,6 @@ rnExpr (ArithSeq _ _ seq) else return (ArithSeq noExtField Nothing new_seq, fvs) } -rnExpr (PopSrcSpan _) = panic "impossible happened rnExpr PopSrcSpan" - {- ************************************************************************ * * ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -206,7 +206,7 @@ tcExpr e@(OpApp {}) res_ty = tcApp e res_ty tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty -tcExpr e@(XExpr (HsExpanded {})) res_ty = tcApp e res_ty +tcExpr e@(XExpr (ExpansionExprRn (HsExpanded {}))) res_ty = tcApp e res_ty tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty @@ -431,7 +431,7 @@ tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty tcExpr (HsDo _ do_or_lc stmts) res_ty = tcDoStmts do_or_lc stmts res_ty -tcExpr (PopSrcSpan (L _ expr)) res_ty = popErrCtxt $ tcExpr expr res_ty +tcExpr (XExpr (PopSrcSpan (L _ expr))) res_ty = popErrCtxt $ tcExpr expr res_ty tcExpr (HsProc x pat cmd) res_ty = do { (pat', cmd', coi) <- tcProc pat cmd res_ty ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -290,9 +290,9 @@ splitHsApps e = go e (top_ctxt 0 e) [] -- See Note [AppCtxt] top_ctxt n (HsPar _ _ fun _) = top_lctxt n fun top_ctxt n (HsPragE _ _ fun) = top_lctxt n fun - top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun + top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun top_ctxt n (HsApp _ fun _) = top_lctxt (n+1) fun - top_ctxt n (XExpr (HsExpanded orig _)) = VACall orig n noSrcSpan + top_ctxt n (XExpr (ExpansionExprRn (HsExpanded (Left orig) _))) = VACall orig n noSrcSpan top_ctxt n other_fun = VACall other_fun n noSrcSpan top_lctxt n (L _ fun) = top_ctxt n fun @@ -306,7 +306,7 @@ splitHsApps e = go e (top_ctxt 0 e) [] go (HsApp _ (L l fun) arg) ctxt args = go fun (dec l ctxt) (mkEValArg ctxt arg : args) -- See Note [Looking through HsExpanded] - go (XExpr (HsExpanded orig fun)) ctxt args + go (XExpr (ExpansionExprRn (HsExpanded (Left orig) fun))) ctxt args = go fun (VAExpansion orig (appCtxtLoc ctxt)) (EWrap (EExpand orig) : args) ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1233,7 +1233,7 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) expand_stmts <- expand_do_stmts do_or_lc lstmts return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ e - , mkHsLamDoExp [pat] (noLocA $ PopSrcSpan expand_stmts) -- (\ x -> stmts') + , mkHsLamDoExp [pat] (noLocA $ mkPopSrcSpanExpr expand_stmts) -- (\ x -> stmts') ] expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = @@ -1244,13 +1244,13 @@ expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (expand_stmts)) -expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +expand_do_stmts do_or_lc ((L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ noLocA (PopSrcSpan (mkHsApps (wrapGenSpan f) -- (>>) + return $ L loc (mkPopSrcSpanExpr (mkHsApps (wrapGenSpan f) -- (>>) [ e -- e , expand_stmts ])) -- stmts' @@ -1276,7 +1276,7 @@ expand_do_stmts do_or_lc return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) , mkHsLamDoExp [ mkBigLHsVarPatTup all_ids ] -- (\ x -> - (noLocA $ PopSrcSpan expand_stmts) -- stmts') + (noLocA $ mkPopSrcSpanExpr expand_stmts) -- stmts') ] where local_only_ids = local_ids \\ later_ids -- get unique local rec ids; @@ -1368,7 +1368,7 @@ mk_failable_lexpr_tcm pat lexpr fail_op = ; if b -- don't decorate with fail statement if -- the pattern is irrefutable - then return $ mkHsLamDoExp [pat] (noLocA (PopSrcSpan lexpr)) + then return $ mkHsLamDoExp [pat] (noLocA (mkPopSrcSpanExpr lexpr)) else mk_fail_lexpr pat lexpr fail_op } @@ -1379,7 +1379,7 @@ mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsEx mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ - (noLocA [ mkHsCaseAlt pat (noLocA $ PopSrcSpan lexpr) -- pat -> expr + (noLocA [ mkHsCaseAlt pat (noLocA $ mkPopSrcSpanExpr lexpr) -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -724,8 +724,9 @@ exprCtOrigin (HsTypedSplice {}) = Shouldn'tHappenOrigin "TH typed splice" exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice" exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" -exprCtOrigin (XExpr (HsExpanded a _)) = exprCtOrigin a -exprCtOrigin (PopSrcSpan (L _ e)) = exprCtOrigin e +exprCtOrigin (XExpr (ExpansionExprRn (HsExpanded (Left a) _))) = exprCtOrigin a +exprCtOrigin (XExpr (ExpansionExprRn _)) = DoOrigin +exprCtOrigin (XExpr (PopSrcSpan (L _ a))) = exprCtOrigin a -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -846,8 +846,6 @@ zonkExpr env (HsDo ty do_or_lc (L l stmts)) new_ty <- zonkTcTypeToTypeX env ty return (HsDo new_ty do_or_lc (L l new_stmts)) -zonkExpr env (PopSrcSpan (L _ exp)) = zonkExpr env exp - zonkExpr env (ExplicitList ty exprs) = do new_ty <- zonkTcTypeToTypeX env ty new_exprs <- zonkLExprs env exprs ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -584,11 +584,6 @@ data HsExpr p -- general idea, and Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr -- for an example of how we use it. - | PopSrcSpan (LHsExpr p) - -- Placeholder for identifying generated source locations in GhcRn phase - -- Should not presist post typechecking - -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match - -- --------------------------------------------------------------------- data DotFieldOcc p View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f78b3ddc002daa8e735ca9f67424b2ee220377fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f78b3ddc002daa8e735ca9f67424b2ee220377fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 15:14:25 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 22 May 2023 11:14:25 -0400 Subject: [Git][ghc/ghc][wip/js-hline] lint Message-ID: <646b86d1c1a31_9760a4b31b03c1111496@gitlab.mail> Josh Meredith pushed to branch wip/js-hline at Glasgow Haskell Compiler / GHC Commits: b0fab2f6 by Josh Meredith at 2023-05-22T15:14:05+00:00 lint - - - - - 1 changed file: - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1864,7 +1864,7 @@ dynamic_flags_deps = [ ------ JavaScript flags ----------------------------------------------- ++ [ make_ord_flag defFlag "ddisable-js-minifier" (NoArg (setGeneralFlag Opt_DisableJsMinifier)) ] - + ------ Language flags ------------------------------------------------- ++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlagsDeps ++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlagsDeps View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0fab2f61c4fed858b79c4abbc2bba4eed4c9000 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0fab2f61c4fed858b79c4abbc2bba4eed4c9000 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 15:18:40 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 22 May 2023 11:18:40 -0400 Subject: [Git][ghc/ghc][wip/expand-do] PopSrcSpan as a XXExprGhcRn Message-ID: <646b87d024327_9760a75c42a8c11119fb@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 9c9e7235 by Apoorv Ingle at 2023-05-22T10:18:22-05:00 PopSrcSpan as a XXExprGhcRn - - - - - 16 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/Language/Haskell/Syntax/Expr.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -441,7 +441,7 @@ tupArgPresent (Missing {}) = False ********************************************************************* -} type instance XXExpr GhcPs = DataConCantHappen -type instance XXExpr GhcRn = HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) +type instance XXExpr GhcRn = XXExprGhcRn type instance XXExpr GhcTc = XXExprGhcTc -- HsExpansion: see Note [Rebindable syntax and HsExpansion] below @@ -454,6 +454,19 @@ type instance XXExpr GhcTc = XXExprGhcTc * * ********************************************************************* -} +type HsExprOrStmt a = Either (HsExpr a) (ExprLStmt a) + +data XXExprGhcRn + = ExpansionExprRn !(HsExpansion (HsExprOrStmt GhcRn) (HsExpr GhcRn)) + | PopSrcSpan !(LHsExpr GhcRn) + -- Placeholder for identifying generated source locations in GhcRn phase + -- Should not presist post typechecking + -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match + + +mkPopSrcSpanExpr :: LHsExpr GhcRn -> HsExpr GhcRn +mkPopSrcSpanExpr a = XExpr (PopSrcSpan a) + -- | Build a 'HsExpansion' out of an extension constructor, -- and the two components of the expansion: original and -- desugared expressions. @@ -461,7 +474,7 @@ mkExpandedExpr :: HsExpr GhcRn -- ^ source expression -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedExpr a b = XExpr (HsExpanded a b) +mkExpandedExpr a b = XExpr (ExpansionExprRn (HsExpanded (Left a) b)) data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions @@ -726,10 +739,9 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcRn -> ppr x GhcTc -> ppr x -ppr_expr (PopSrcSpan x) = case ghcPass @p of - GhcPs -> panic "ppr_expr Ps HsPopSrcSpan" - GhcRn -> ppr x - GhcTc -> panic "ppr_expr Tc HsPopSrcSpan" +instance Outputable XXExprGhcRn where + ppr (ExpansionExprRn e) = ppr e + ppr (PopSrcSpan e) = ppr e instance Outputable XXExprGhcTc where @@ -770,8 +782,10 @@ ppr_infix_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr_infix_expr_tc x ppr_infix_expr _ = Nothing -ppr_infix_expr_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Maybe SDoc -ppr_infix_expr_rn (HsExpanded a _) = ppr_infix_expr a +ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc +ppr_infix_expr_rn (ExpansionExprRn (HsExpanded (Left a) _)) = ppr_infix_expr a +ppr_infix_expr_rn (ExpansionExprRn _) = Nothing +ppr_infix_expr_rn (PopSrcSpan (L _ a)) = ppr_infix_expr a ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc ppr_infix_expr_tc (WrapExpr (HsWrap _ e)) = ppr_infix_expr e @@ -851,7 +865,6 @@ hsExprNeedsParens prec = go go (HsDo _ sc _) | isDoComprehensionContext sc = False | otherwise = prec > topPrec - go (PopSrcSpan{}) = prec > topPrec go (ExplicitList{}) = False go (RecordUpd{}) = False go (ExprWithTySig{}) = prec >= sigPrec @@ -881,8 +894,10 @@ hsExprNeedsParens prec = go go_x_tc (HsTick _ (L _ e)) = hsExprNeedsParens prec e go_x_tc (HsBinTick _ _ (L _ e)) = hsExprNeedsParens prec e - go_x_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Bool - go_x_rn (HsExpanded a _) = hsExprNeedsParens prec a + go_x_rn :: XXExprGhcRn -> Bool + go_x_rn (ExpansionExprRn (HsExpanded (Left a) _)) = hsExprNeedsParens prec a + go_x_rn (ExpansionExprRn _) = False + go_x_rn (PopSrcSpan (L _ a)) = hsExprNeedsParens prec a -- | Parenthesize an expression without token information @@ -924,8 +939,10 @@ isAtomicHsExpr (XExpr x) go_x_tc (HsTick {}) = False go_x_tc (HsBinTick {}) = False - go_x_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Bool - go_x_rn (HsExpanded a _) = isAtomicHsExpr a + go_x_rn :: XXExprGhcRn -> Bool + go_x_rn (ExpansionExprRn (HsExpanded (Left a) _)) = isAtomicHsExpr a + go_x_rn (ExpansionExprRn (HsExpanded _ _)) = False + go_x_rn (PopSrcSpan (L _ a)) = isAtomicHsExpr a isAtomicHsExpr _ = False ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -556,6 +556,7 @@ deriving instance Eq (IE GhcTc) -- --------------------------------------------------------------------- +deriving instance Data XXExprGhcRn deriving instance Data XXExprGhcTc deriving instance Data XXPatGhcTc ===================================== compiler/GHC/Hs/Syn/Type.hs ===================================== @@ -120,7 +120,6 @@ hsExprType (HsIf _ _ t _) = lhsExprType t hsExprType (HsMultiIf ty _) = ty hsExprType (HsLet _ _ _ _ body) = lhsExprType body hsExprType (HsDo ty _ _) = ty -hsExprType (PopSrcSpan expr) = pprPanic "hsExprType" (text "impossible happened PopSrcSpan" <+> ppr expr) hsExprType (ExplicitList ty _) = mkListTy ty hsExprType (RecordCon con_expr _ _) = hsExprType con_expr hsExprType (RecordUpd v _ _) = dataConCantHappen v ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -279,7 +279,7 @@ mkHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) => [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -mkHsLamDoExp pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches)) +mkHsLamDoExp pats body = mkHsPar (noLocA $ HsLam noExtField matches) where matches = mkMatchGroup (Generated DoExpansion) (noLocA [mkSimpleMatch LambdaExpr pats' body]) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -259,8 +259,6 @@ dsExpr (HsOverLit _ lit) = do { warnAboutOverflowedOverLit lit ; dsOverLit lit } -dsExpr e@(PopSrcSpan {}) = pprPanic "dsExpr" (ppr e) - dsExpr e@(XExpr ext_expr_tc) = case ext_expr_tc of ExpansionExpr (HsExpanded _ b) -> dsExpr b ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1654,16 +1654,19 @@ repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ (FieldLabelString f))))) = do e1 <- repLE e repGetField e1 f repE (HsProjection _ xs) = repProjection (fmap (field_label . unLoc . dfoLabel . unLoc) xs) -repE (XExpr (HsExpanded orig_expr ds_expr)) +repE (XExpr (ExpansionExprRn (HsExpanded orig_expr_or_stmt ds_expr))) = do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax ; if rebindable_on -- See Note [Quotation and rebindable syntax] then repE ds_expr - else repE orig_expr } + else case orig_expr_or_stmt of + Left e -> repE e + Right st -> pprPanic "repE: unexpected do stmt" (ppr st)} +repE (XExpr (PopSrcSpan (L _ e))) = repE e repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e) repE e@(HsTypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsUntypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsProc{}) = notHandled (ThExpressionForm e) -repE e@(PopSrcSpan{}) = notHandled (ThExpressionForm e) + {- Note [Quotation and rebindable syntax] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -605,7 +605,6 @@ addTickHsExpr (XExpr (HsTick t e)) = liftM (XExpr . HsTick t) (addTickLHsExprNever e) addTickHsExpr (XExpr (HsBinTick t0 t1 e)) = liftM (XExpr . HsBinTick t0 t1) (addTickLHsExprNever e) -addTickHsExpr e@(PopSrcSpan _) = pprPanic "addTickHsExpr: impossible happen PopSrcSpan" (ppr e) addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc) addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1234,7 +1234,6 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where ] HsGetField {} -> [] HsProjection {} -> [] - PopSrcSpan {} -> [] XExpr x | HieTc <- hiePass @p -> case x of ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -561,8 +561,6 @@ rnExpr (ArithSeq _ _ seq) else return (ArithSeq noExtField Nothing new_seq, fvs) } -rnExpr (PopSrcSpan _) = panic "impossible happened rnExpr PopSrcSpan" - {- ************************************************************************ * * ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -206,7 +206,7 @@ tcExpr e@(OpApp {}) res_ty = tcApp e res_ty tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty -tcExpr e@(XExpr (HsExpanded {})) res_ty = tcApp e res_ty +tcExpr e@(XExpr (ExpansionExprRn (HsExpanded {}))) res_ty = tcApp e res_ty tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty @@ -431,7 +431,7 @@ tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty tcExpr (HsDo _ do_or_lc stmts) res_ty = tcDoStmts do_or_lc stmts res_ty -tcExpr (PopSrcSpan (L _ expr)) res_ty = popErrCtxt $ tcExpr expr res_ty +tcExpr (XExpr (PopSrcSpan (L _ expr))) res_ty = popErrCtxt $ tcExpr expr res_ty tcExpr (HsProc x pat cmd) res_ty = do { (pat', cmd', coi) <- tcProc pat cmd res_ty ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -290,9 +290,9 @@ splitHsApps e = go e (top_ctxt 0 e) [] -- See Note [AppCtxt] top_ctxt n (HsPar _ _ fun _) = top_lctxt n fun top_ctxt n (HsPragE _ _ fun) = top_lctxt n fun - top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun + top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun top_ctxt n (HsApp _ fun _) = top_lctxt (n+1) fun - top_ctxt n (XExpr (HsExpanded orig _)) = VACall orig n noSrcSpan + top_ctxt n (XExpr (ExpansionExprRn (HsExpanded (Left orig) _))) = VACall orig n noSrcSpan top_ctxt n other_fun = VACall other_fun n noSrcSpan top_lctxt n (L _ fun) = top_ctxt n fun @@ -306,7 +306,7 @@ splitHsApps e = go e (top_ctxt 0 e) [] go (HsApp _ (L l fun) arg) ctxt args = go fun (dec l ctxt) (mkEValArg ctxt arg : args) -- See Note [Looking through HsExpanded] - go (XExpr (HsExpanded orig fun)) ctxt args + go (XExpr (ExpansionExprRn (HsExpanded (Left orig) fun))) ctxt args = go fun (VAExpansion orig (appCtxtLoc ctxt)) (EWrap (EExpand orig) : args) ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1233,7 +1233,7 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) expand_stmts <- expand_do_stmts do_or_lc lstmts return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ e - , mkHsLamDoExp [pat] (noLocA $ PopSrcSpan expand_stmts) -- (\ x -> stmts') + , mkHsLamDoExp [pat] (noLocA $ mkPopSrcSpanExpr expand_stmts) -- (\ x -> stmts') ] expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = @@ -1244,13 +1244,13 @@ expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (expand_stmts)) -expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +expand_do_stmts do_or_lc ((L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ noLocA (PopSrcSpan (mkHsApps (wrapGenSpan f) -- (>>) + return $ L loc (mkPopSrcSpanExpr (mkHsApps (wrapGenSpan f) -- (>>) [ e -- e , expand_stmts ])) -- stmts' @@ -1276,7 +1276,7 @@ expand_do_stmts do_or_lc return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) , mkHsLamDoExp [ mkBigLHsVarPatTup all_ids ] -- (\ x -> - (noLocA $ PopSrcSpan expand_stmts) -- stmts') + (noLocA $ mkPopSrcSpanExpr expand_stmts) -- stmts') ] where local_only_ids = local_ids \\ later_ids -- get unique local rec ids; @@ -1368,7 +1368,7 @@ mk_failable_lexpr_tcm pat lexpr fail_op = ; if b -- don't decorate with fail statement if -- the pattern is irrefutable - then return $ mkHsLamDoExp [pat] (noLocA (PopSrcSpan lexpr)) + then return $ mkHsLamDoExp [pat] (noLocA (mkPopSrcSpanExpr lexpr)) else mk_fail_lexpr pat lexpr fail_op } @@ -1379,7 +1379,7 @@ mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsEx mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ - (noLocA [ mkHsCaseAlt pat (noLocA $ PopSrcSpan lexpr) -- pat -> expr + (noLocA [ mkHsCaseAlt pat (noLocA $ mkPopSrcSpanExpr lexpr) -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -724,8 +724,9 @@ exprCtOrigin (HsTypedSplice {}) = Shouldn'tHappenOrigin "TH typed splice" exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice" exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" -exprCtOrigin (XExpr (HsExpanded a _)) = exprCtOrigin a -exprCtOrigin (PopSrcSpan (L _ e)) = exprCtOrigin e +exprCtOrigin (XExpr (ExpansionExprRn (HsExpanded (Left a) _))) = exprCtOrigin a +exprCtOrigin (XExpr (ExpansionExprRn _)) = DoOrigin +exprCtOrigin (XExpr (PopSrcSpan (L _ a))) = exprCtOrigin a -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -846,8 +846,6 @@ zonkExpr env (HsDo ty do_or_lc (L l stmts)) new_ty <- zonkTcTypeToTypeX env ty return (HsDo new_ty do_or_lc (L l new_stmts)) -zonkExpr env (PopSrcSpan (L _ exp)) = zonkExpr env exp - zonkExpr env (ExplicitList ty exprs) = do new_ty <- zonkTcTypeToTypeX env ty new_exprs <- zonkLExprs env exprs ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -584,11 +584,6 @@ data HsExpr p -- general idea, and Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr -- for an example of how we use it. - | PopSrcSpan (LHsExpr p) - -- Placeholder for identifying generated source locations in GhcRn phase - -- Should not presist post typechecking - -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match - -- --------------------------------------------------------------------- data DotFieldOcc p ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2661,7 +2661,6 @@ instance ExactPrint (HsExpr GhcPs) where getAnnotationEntry (HsProc an _ _) = fromAnn an getAnnotationEntry (HsStatic an _) = fromAnn an getAnnotationEntry (HsPragE{}) = NoEntryVal - getAnnotationEntry (PopSrcSpan{}) = NoEntryVal setAnnotationAnchor a@(HsVar{}) _ _s = a setAnnotationAnchor (HsUnboundVar an a) anc cs = (HsUnboundVar (setAnchorEpa an anc cs) a) @@ -2700,7 +2699,6 @@ instance ExactPrint (HsExpr GhcPs) where setAnnotationAnchor (HsProc an a b) anc cs = (HsProc (setAnchorEpa an anc cs) a b) setAnnotationAnchor (HsStatic an a) anc cs = (HsStatic (setAnchorEpa an anc cs) a) setAnnotationAnchor a@(HsPragE{}) _ _s = a - setAnnotationAnchor a@(PopSrcSpan{}) _ _s = a exact (HsVar x n) = do n' <- markAnnotated n View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c9e72353f82ff6db4f163f419957bf0e45dd543 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c9e72353f82ff6db4f163f419957bf0e45dd543 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 15:20:34 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 22 May 2023 11:20:34 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <646b88425b20a_9760a75c42a641112490@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: d89cfd2d by Ben Gamari at 2023-05-22T19:20:23+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - + docs/users_guide/exts/implicit_forall.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/exts/type_signatures.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.stderr - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d89cfd2d61a8517116b4d050a2894230fd5cab3e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d89cfd2d61a8517116b4d050a2894230fd5cab3e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 15:49:59 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 11:49:59 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Fixes for compilation Message-ID: <646b8f2772440_9760a75c42a781118081@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: ad85762c by Rodrigo Mesquita at 2023-05-22T16:23:35+01:00 Fixes for compilation - - - - - 8e044118 by Rodrigo Mesquita at 2023-05-22T16:49:41+01:00 Link is GNU linkerg - - - - - 5 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -289,7 +289,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -309,7 +308,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do = withAtomicRename outputFilename $ \temp_outputFilename -> runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -323,9 +321,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do ++ [ GHC.SysTools.Option "-Wa,--no-type-check" | platformArch (targetPlatform dflags) == ArchWasm32] - ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51] - then [GHC.SysTools.Option "-Qunused-arguments"] - else []) ++ [ GHC.SysTools.Option "-x" , if with_cpp then GHC.SysTools.Option "assembler-with-cpp" ===================================== hadrian/cfg/system.config.in ===================================== @@ -93,7 +93,6 @@ project-git-commit-id = @ProjectGitCommitId@ # See Note [tooldir: How GHC finds mingw on Windows] gcc-extra-via-c-opts = @GccExtraViaCOpts@ -ld-is-gnu-ld = @LdIsGNULd@ # ROMES:TODO: Drop almost every of these from settings. settings-c-compiler-command = @SettingsCCompilerCommand@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -432,8 +432,8 @@ generateSettings = do , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) , ("ld supports compact unwind", expr $ queryTargetTargetConfig linkSupportsCompactUnwind) , ("ld supports filelist", expr $ queryTargetTargetConfig ldSupportsFilelist) - , ("ld supports response files", expr $ queryTargetTargetConfig ldSupportsResponseFiles) - , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") + , ("ld supports response files", expr $ queryTargetTargetConfig linkSupportsResponseFiles) + , ("ld is GNU ld", expr $ queryTargetTargetConfig linkIsGnu) , ("Merge objects command", expr $ settingsFileSetting ToolchainSetting_MergeObjectsCommand) , ("Merge objects flags", expr $ settingsFileSetting ToolchainSetting_MergeObjectsFlags) , ("ar command", expr $ settingsFileSetting ToolchainSetting_ArCommand) @@ -480,9 +480,10 @@ generateSettings = do : ((\s' -> "," ++ showTuple s') <$> ss) ++ ["]"] where - ldSupportsResponseFiles = yesNo . Toolchain.ccLinkSupportsResponseFiles . Toolchain.tgtCCompilerLink - ldSupportsFilelist = yesNo . Toolchain.ccLinkSupportsFilelist . Toolchain.tgtCCompilerLink - linkSupportsCompactUnwind = yesNo . Toolchain.ccLinkSupportsCompactUnwind . Toolchain.tgtCCompilerLink + linkSupportsResponseFiles = yesNo . Toolchain.ccLinkSupportsResponseFiles . Toolchain.tgtCCompilerLink + linkSupportsFilelist = yesNo . Toolchain.ccLinkSupportsFilelist . Toolchain.tgtCCompilerLink + linkSupportsCompactUnwind = yesNo . Toolchain.ccLinkSupportsCompactUnwind . Toolchain.tgtCCompilerLink + linkIsGnu = yesNo . Toolchain.ccLinkIsGnu . Toolchain.tgtCCompilerLink arFlags = unwords . prgFlags . Toolchain.arMkArchive . Toolchain.tgtAr ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -52,7 +52,6 @@ data Target = Target , tgtHsCPreprocessor :: HsCpp , tgtCCompilerLink :: CcLink -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler - -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed) , tgtAr :: Ar , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it , tgtNm :: Nm ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -22,6 +22,7 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsCompactUnwind :: Bool -- Argument to be made about this being part of the cclink flags , ccLinkSupportsFilelist :: Bool -- This too , ccLinkSupportsResponseFiles :: Bool + , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } deriving (Show, Read, Eq, Ord) @@ -40,6 +41,7 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram ccLinkSupportsResponseFiles <- checkSupportsResponseFiles cc ccLinkProgram + ccLinkIsGnu <- checkLinkIsGnu ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles} @@ -153,6 +155,11 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do callProgram ccLink ["-o", out, test_o, main_o] expectFileExists out "linker didn't produce any output" +checkLinkIsGnu :: Program -> M Bool +checkLinkIsGnu ccLink = do + out <- readProgramStdout ccLink ["--version"] + return ("GNU" `isInfixOf` out) + -- | Check for binutils bug #16177 present in some versions of the bfd ld -- implementation affecting ARM relocations. -- https://sourceware.org/bugzilla/show_bug.cgi?id=16177 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fad8a5ed808b5e56b51983f546cc0453bdb7d278...8e0441181af229ed8322efeda00a431df26b13c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fad8a5ed808b5e56b51983f546cc0453bdb7d278...8e0441181af229ed8322efeda00a431df26b13c1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 15:50:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 11:50:34 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Link is GNU linkerg Message-ID: <646b8f4add8f9_9760a7a5e39ac11187e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 7a054eac by Rodrigo Mesquita at 2023-05-22T16:50:27+01:00 Link is GNU linkerg - - - - - 4 changed files: - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== hadrian/cfg/system.config.in ===================================== @@ -93,7 +93,6 @@ project-git-commit-id = @ProjectGitCommitId@ # See Note [tooldir: How GHC finds mingw on Windows] gcc-extra-via-c-opts = @GccExtraViaCOpts@ -ld-is-gnu-ld = @LdIsGNULd@ # ROMES:TODO: Drop almost every of these from settings. settings-c-compiler-command = @SettingsCCompilerCommand@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -432,8 +432,8 @@ generateSettings = do , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) , ("ld supports compact unwind", expr $ queryTargetTargetConfig linkSupportsCompactUnwind) , ("ld supports filelist", expr $ queryTargetTargetConfig ldSupportsFilelist) - , ("ld supports response files", expr $ queryTargetTargetConfig ldSupportsResponseFiles) - , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") + , ("ld supports response files", expr $ queryTargetTargetConfig linkSupportsResponseFiles) + , ("ld is GNU ld", expr $ queryTargetTargetConfig linkIsGnu) , ("Merge objects command", expr $ settingsFileSetting ToolchainSetting_MergeObjectsCommand) , ("Merge objects flags", expr $ settingsFileSetting ToolchainSetting_MergeObjectsFlags) , ("ar command", expr $ settingsFileSetting ToolchainSetting_ArCommand) @@ -480,9 +480,10 @@ generateSettings = do : ((\s' -> "," ++ showTuple s') <$> ss) ++ ["]"] where - ldSupportsResponseFiles = yesNo . Toolchain.ccLinkSupportsResponseFiles . Toolchain.tgtCCompilerLink - ldSupportsFilelist = yesNo . Toolchain.ccLinkSupportsFilelist . Toolchain.tgtCCompilerLink - linkSupportsCompactUnwind = yesNo . Toolchain.ccLinkSupportsCompactUnwind . Toolchain.tgtCCompilerLink + linkSupportsResponseFiles = yesNo . Toolchain.ccLinkSupportsResponseFiles . Toolchain.tgtCCompilerLink + linkSupportsFilelist = yesNo . Toolchain.ccLinkSupportsFilelist . Toolchain.tgtCCompilerLink + linkSupportsCompactUnwind = yesNo . Toolchain.ccLinkSupportsCompactUnwind . Toolchain.tgtCCompilerLink + linkIsGnu = yesNo . Toolchain.ccLinkIsGnu . Toolchain.tgtCCompilerLink arFlags = unwords . prgFlags . Toolchain.arMkArchive . Toolchain.tgtAr ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -52,7 +52,6 @@ data Target = Target , tgtHsCPreprocessor :: HsCpp , tgtCCompilerLink :: CcLink -- , tgtLd :: Program -- needed? probably not, we link always through the c compiler - -- , tgtLdIsGnuLd :: Bool -- After rebase on LdHasGcSections (and renamed) , tgtAr :: Ar , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it , tgtNm :: Nm ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -22,6 +22,7 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsCompactUnwind :: Bool -- Argument to be made about this being part of the cclink flags , ccLinkSupportsFilelist :: Bool -- This too , ccLinkSupportsResponseFiles :: Bool + , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } deriving (Show, Read, Eq, Ord) @@ -40,9 +41,10 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram ccLinkSupportsResponseFiles <- checkSupportsResponseFiles cc ccLinkProgram + ccLinkIsGnu <- checkLinkIsGnu ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram - return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles} + return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles, ccLinkIsGnu} -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program @@ -153,6 +155,11 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do callProgram ccLink ["-o", out, test_o, main_o] expectFileExists out "linker didn't produce any output" +checkLinkIsGnu :: Program -> M Bool +checkLinkIsGnu ccLink = do + out <- readProgramStdout ccLink ["--version"] + return ("GNU" `isInfixOf` out) + -- | Check for binutils bug #16177 present in some versions of the bfd ld -- implementation affecting ARM relocations. -- https://sourceware.org/bugzilla/show_bug.cgi?id=16177 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a054eac8761501d04432f0bc445068480a5bcce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a054eac8761501d04432f0bc445068480a5bcce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 16:05:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 12:05:48 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ROMES: WIP 5 Message-ID: <646b92dc49cd6_9760a4b504b8c1121273@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: a566a0ec by Rodrigo Mesquita at 2023-05-22T17:05:42+01:00 ROMES: WIP 5 - - - - - 5 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -288,7 +288,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -431,7 +431,7 @@ generateSettings = do , ("ld command", expr $ settingsFileSetting ToolchainSetting_LdCommand) , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) , ("ld supports compact unwind", expr $ queryTargetTargetConfig linkSupportsCompactUnwind) - , ("ld supports filelist", expr $ queryTargetTargetConfig ldSupportsFilelist) + , ("ld supports filelist", expr $ queryTargetTargetConfig linkSupportsFilelist) , ("ld supports response files", expr $ queryTargetTargetConfig linkSupportsResponseFiles) , ("ld is GNU ld", expr $ queryTargetTargetConfig linkIsGnu) , ("Merge objects command", expr $ settingsFileSetting ToolchainSetting_MergeObjectsCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -14,7 +14,7 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra -import GHC.Toolchain (ccProgram, tgtCCompiler, cppProgram, tgtCPreprocessor) +import GHC.Toolchain (ccProgram, tgtCCompiler) import GHC.Toolchain.Program ghcBuilderArgs :: Args @@ -294,6 +294,3 @@ includeGhcArgs = do -- Utilities getStagedCCFlags :: Args getStagedCCFlags = prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig - -getStagedCPPFlags :: Args -getStagedCPPFlags = prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -5,7 +5,7 @@ import Hadrian.Haskell.Cabal.Type import Builder import Packages import Settings.Builders.Common -import GHC.Toolchain (tgtCCompiler, ccProgram, tgtCPreprocessor, cppProgram, tgtCCompilerLink, ccLinkProgram) +import GHC.Toolchain (tgtCCompiler, ccProgram, tgtCCompilerLink, ccLinkProgram) import GHC.Toolchain.Program hsc2hsBuilderArgs :: Args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a566a0ecc90cf718d9ba1ee88e5b0ada9312fe66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a566a0ecc90cf718d9ba1ee88e5b0ada9312fe66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 16:18:43 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 22 May 2023 12:18:43 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] 2 commits: Add the SolverStage monad Message-ID: <646b95e3513b2_9760a75b6ae5c1123432@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 4a5f13a1 by Simon Peyton Jones at 2023-05-22T17:19:36+01:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - d1c2ba37 by Simon Peyton Jones at 2023-05-22T17:19:45+01:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 23 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/432b03612ea005a0925f3b33164893eeb1e891f0...d1c2ba37ddd23adbbbfe11985c76ba634a694153 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/432b03612ea005a0925f3b33164893eeb1e891f0...d1c2ba37ddd23adbbbfe11985c76ba634a694153 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 16:22:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 12:22:41 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Revert "Rip more of configure that is no longer being used" Message-ID: <646b96d122973_9760a4dab370c11303c5@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 05a34651 by Rodrigo Mesquita at 2023-05-22T17:21:16+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 1 changed file: - m4/fptools_set_haskell_platform_vars.m4 Changes: ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -1,3 +1,134 @@ +# FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS +# ---------------------------------- +# Drop in shell functions used by FPTOOLS_SET_HASKELL_PLATFORM_VARS +AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS], +[ + checkArch() { + case [$]1 in + i386) + test -z "[$]2" || eval "[$]2=ArchX86" + ;; + x86_64|amd64) + test -z "[$]2" || eval "[$]2=ArchX86_64" + ;; + powerpc) + test -z "[$]2" || eval "[$]2=ArchPPC" + ;; + powerpc64) + test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V1\"" + ;; + powerpc64le) + test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V2\"" + ;; + s390x) + test -z "[$]2" || eval "[$]2=ArchS390X" + ;; + arm) + GET_ARM_ISA() + test -z "[$]2" || eval "[$]2=\"ArchARM \$ARM_ISA \$ARM_ISA_EXT \$ARM_ABI\"" + ;; + aarch64) + test -z "[$]2" || eval "[$]2=ArchAArch64" + ;; + alpha) + test -z "[$]2" || eval "[$]2=ArchAlpha" + ;; + mips|mipseb) + test -z "[$]2" || eval "[$]2=ArchMipseb" + ;; + mipsel) + test -z "[$]2" || eval "[$]2=ArchMipsel" + ;; + riscv64) + test -z "[$]2" || eval "[$]2=ArchRISCV64" + ;; + wasm32) + test -z "[$]2" || eval "[$]2=ArchWasm32" + ;; + loongarch64) + test -z "[$]2" || eval "[$]2=ArchLoongArch64" + ;; + hppa|hppa1_1|ia64|m68k|nios2|riscv32|loongarch32|rs6000|s390|sh4|vax) + test -z "[$]2" || eval "[$]2=ArchUnknown" + ;; + javascript) + test -z "[$]2" || eval "[$]2=ArchJavaScript" + ;; + *) + echo "Unknown arch [$]1" + exit 1 + ;; + esac + } + + checkVendor() { + case [$]1 in + dec|none|unknown|hp|apple|next|sun|sgi|ibm|montavista|portbld|alpine) + ;; + *) + AC_MSG_WARN([Unknown vendor [$]1]) + ;; + esac + } + + checkOS() { + case [$]1 in + linux|linux-android) + test -z "[$]2" || eval "[$]2=OSLinux" + ;; + darwin|ios|watchos|tvos) + test -z "[$]2" || eval "[$]2=OSDarwin" + ;; + solaris2) + test -z "[$]2" || eval "[$]2=OSSolaris2" + ;; + mingw32|windows) + test -z "[$]2" || eval "[$]2=OSMinGW32" + ;; + freebsd) + test -z "[$]2" || eval "[$]2=OSFreeBSD" + ;; + dragonfly) + test -z "[$]2" || eval "[$]2=OSDragonFly" + ;; + kfreebsdgnu) + test -z "[$]2" || eval "[$]2=OSKFreeBSD" + ;; + openbsd) + test -z "[$]2" || eval "[$]2=OSOpenBSD" + ;; + netbsd) + test -z "[$]2" || eval "[$]2=OSNetBSD" + ;; + haiku) + test -z "[$]2" || eval "[$]2=OSHaiku" + ;; + nto-qnx) + test -z "[$]2" || eval "[$]2=OSQNXNTO" + ;; + wasi) + test -z "[$]2" || eval "[$]2=OSWasi" + ;; + dragonfly|hpux|linuxaout|freebsd2|nextstep2|nextstep3|sunos4|ultrix) + test -z "[$]2" || eval "[$]2=OSUnknown" + ;; + aix) + test -z "[$]2" || eval "[$]2=OSAIX" + ;; + gnu) + test -z "[$]2" || eval "[$]2=OSHurd" + ;; + ghcjs|js) + test -z "[$]2" || eval "[$]2=OSGhcjs" + ;; + *) + echo "Unknown OS '[$]1'" + exit 1 + ;; + esac + } +]) + # Note [autoconf assembler checks and -flto] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Autoconf's AC_COMPILE_IFELSE macro is fragile in the case of checks @@ -43,3 +174,13 @@ AC_DEFUN([GHC_SUBSECTIONS_VIA_SYMBOLS], # We might have to generate a bunch of -D CPP flags to satisfy these dependencies (future work). +# FPTOOLS_SET_HASKELL_PLATFORM_VARS +# ---------------------------------- +# Set the Haskell platform variables +AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS], +[ + AC_REQUIRE([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS]) + checkArch "[$]$1Arch" "Haskell$1Arch" + checkVendor "[$]$1Vendor" + checkOS "[$]$1OS" "Haskell$1Os" +]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05a34651b012bb745ca456eca7a70b5b606d16ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05a34651b012bb745ca456eca7a70b5b606d16ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 16:47:39 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 12:47:39 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: ROMES: WIP 5 Message-ID: <646b9cab5f77d_9760a75c42aa0113307a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 77a8e38d by Rodrigo Mesquita at 2023-05-22T17:45:56+01:00 ROMES: WIP 5 - - - - - 11887650 by Rodrigo Mesquita at 2023-05-22T17:46:00+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - dff45613 by Rodrigo Mesquita at 2023-05-22T17:46:00+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 9 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fptools_set_haskell_platform_vars.m4 - + m4/get_arm_isa.m4 Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -113,7 +113,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -288,7 +288,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -123,8 +123,8 @@ data ToolchainSetting -- be part of settings, so they should be moved out setting :: Setting -> Action String setting key = case key of - BuildArch -> systemConf "build-arch" - BuildOs -> systemConf "build-os" + BuildArch -> hostConf archStr -- ROMES:TODO: This is only correct while we assume BUILD=HOST=TARGET + BuildOs -> hostConf osStr -- This too. BuildPlatform -> systemConf "build-platform" BuildVendor -> systemConf "build-vendor" CursesIncludeDir -> systemConf "curses-include-dir" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -431,7 +431,7 @@ generateSettings = do , ("ld command", expr $ settingsFileSetting ToolchainSetting_LdCommand) , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) , ("ld supports compact unwind", expr $ queryTargetTargetConfig linkSupportsCompactUnwind) - , ("ld supports filelist", expr $ queryTargetTargetConfig ldSupportsFilelist) + , ("ld supports filelist", expr $ queryTargetTargetConfig linkSupportsFilelist) , ("ld supports response files", expr $ queryTargetTargetConfig linkSupportsResponseFiles) , ("ld is GNU ld", expr $ queryTargetTargetConfig linkIsGnu) , ("Merge objects command", expr $ settingsFileSetting ToolchainSetting_MergeObjectsCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -14,7 +14,7 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra -import GHC.Toolchain (ccProgram, tgtCCompiler, cppProgram, tgtCPreprocessor) +import GHC.Toolchain (ccProgram, tgtCCompiler) import GHC.Toolchain.Program ghcBuilderArgs :: Args @@ -294,6 +294,3 @@ includeGhcArgs = do -- Utilities getStagedCCFlags :: Args getStagedCCFlags = prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig - -getStagedCPPFlags :: Args -getStagedCPPFlags = prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -5,7 +5,7 @@ import Hadrian.Haskell.Cabal.Type import Builder import Packages import Settings.Builders.Common -import GHC.Toolchain (tgtCCompiler, ccProgram, tgtCPreprocessor, cppProgram, tgtCCompilerLink, ccLinkProgram) +import GHC.Toolchain (tgtCCompiler, ccProgram, tgtCCompilerLink, ccLinkProgram) import GHC.Toolchain.Program hsc2hsBuilderArgs :: Args ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -1,3 +1,134 @@ +# FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS +# ---------------------------------- +# Drop in shell functions used by FPTOOLS_SET_HASKELL_PLATFORM_VARS +AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS], +[ + checkArch() { + case [$]1 in + i386) + test -z "[$]2" || eval "[$]2=ArchX86" + ;; + x86_64|amd64) + test -z "[$]2" || eval "[$]2=ArchX86_64" + ;; + powerpc) + test -z "[$]2" || eval "[$]2=ArchPPC" + ;; + powerpc64) + test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V1\"" + ;; + powerpc64le) + test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V2\"" + ;; + s390x) + test -z "[$]2" || eval "[$]2=ArchS390X" + ;; + arm) + GET_ARM_ISA() + test -z "[$]2" || eval "[$]2=\"ArchARM \$ARM_ISA \$ARM_ISA_EXT \$ARM_ABI\"" + ;; + aarch64) + test -z "[$]2" || eval "[$]2=ArchAArch64" + ;; + alpha) + test -z "[$]2" || eval "[$]2=ArchAlpha" + ;; + mips|mipseb) + test -z "[$]2" || eval "[$]2=ArchMipseb" + ;; + mipsel) + test -z "[$]2" || eval "[$]2=ArchMipsel" + ;; + riscv64) + test -z "[$]2" || eval "[$]2=ArchRISCV64" + ;; + wasm32) + test -z "[$]2" || eval "[$]2=ArchWasm32" + ;; + loongarch64) + test -z "[$]2" || eval "[$]2=ArchLoongArch64" + ;; + hppa|hppa1_1|ia64|m68k|nios2|riscv32|loongarch32|rs6000|s390|sh4|vax) + test -z "[$]2" || eval "[$]2=ArchUnknown" + ;; + javascript) + test -z "[$]2" || eval "[$]2=ArchJavaScript" + ;; + *) + echo "Unknown arch [$]1" + exit 1 + ;; + esac + } + + checkVendor() { + case [$]1 in + dec|none|unknown|hp|apple|next|sun|sgi|ibm|montavista|portbld|alpine) + ;; + *) + AC_MSG_WARN([Unknown vendor [$]1]) + ;; + esac + } + + checkOS() { + case [$]1 in + linux|linux-android) + test -z "[$]2" || eval "[$]2=OSLinux" + ;; + darwin|ios|watchos|tvos) + test -z "[$]2" || eval "[$]2=OSDarwin" + ;; + solaris2) + test -z "[$]2" || eval "[$]2=OSSolaris2" + ;; + mingw32|windows) + test -z "[$]2" || eval "[$]2=OSMinGW32" + ;; + freebsd) + test -z "[$]2" || eval "[$]2=OSFreeBSD" + ;; + dragonfly) + test -z "[$]2" || eval "[$]2=OSDragonFly" + ;; + kfreebsdgnu) + test -z "[$]2" || eval "[$]2=OSKFreeBSD" + ;; + openbsd) + test -z "[$]2" || eval "[$]2=OSOpenBSD" + ;; + netbsd) + test -z "[$]2" || eval "[$]2=OSNetBSD" + ;; + haiku) + test -z "[$]2" || eval "[$]2=OSHaiku" + ;; + nto-qnx) + test -z "[$]2" || eval "[$]2=OSQNXNTO" + ;; + wasi) + test -z "[$]2" || eval "[$]2=OSWasi" + ;; + dragonfly|hpux|linuxaout|freebsd2|nextstep2|nextstep3|sunos4|ultrix) + test -z "[$]2" || eval "[$]2=OSUnknown" + ;; + aix) + test -z "[$]2" || eval "[$]2=OSAIX" + ;; + gnu) + test -z "[$]2" || eval "[$]2=OSHurd" + ;; + ghcjs|js) + test -z "[$]2" || eval "[$]2=OSGhcjs" + ;; + *) + echo "Unknown OS '[$]1'" + exit 1 + ;; + esac + } +]) + # Note [autoconf assembler checks and -flto] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Autoconf's AC_COMPILE_IFELSE macro is fragile in the case of checks @@ -43,3 +174,13 @@ AC_DEFUN([GHC_SUBSECTIONS_VIA_SYMBOLS], # We might have to generate a bunch of -D CPP flags to satisfy these dependencies (future work). +# FPTOOLS_SET_HASKELL_PLATFORM_VARS +# ---------------------------------- +# Set the Haskell platform variables +AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS], +[ + AC_REQUIRE([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS]) + checkArch "[$]$1Arch" "Haskell$1Arch" + checkVendor "[$]$1Vendor" + checkOS "[$]$1OS" "Haskell$1Os" +]) ===================================== m4/get_arm_isa.m4 ===================================== @@ -0,0 +1,117 @@ +# GET_ARM_ISA +# ---------------------------------- +# Get info about the ISA on the ARM arch +AC_DEFUN([GET_ARM_ISA], +[ + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__ARM_ARCH_2__) || \ + defined(__ARM_ARCH_3__) || \ + defined(__ARM_ARCH_3M__) || \ + defined(__ARM_ARCH_4__) || \ + defined(__ARM_ARCH_4T__) || \ + defined(__ARM_ARCH_5__) || \ + defined(__ARM_ARCH_5T__) || \ + defined(__ARM_ARCH_5E__) || \ + defined(__ARM_ARCH_5TE__) + return 0; + #else + not pre arm v6 + #endif] + )], + [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv6, 1, [ARM pre v6]) + AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) + changequote(, )dnl + ARM_ISA=ARMv5 + ARM_ISA_EXT="[]" + changequote([, ])dnl + ], + [ + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__ARM_ARCH_6__) || \ + defined(__ARM_ARCH_6J__) || \ + defined(__ARM_ARCH_6T2__) || \ + defined(__ARM_ARCH_6Z__) || \ + defined(__ARM_ARCH_6ZK__) || \ + defined(__ARM_ARCH_6K__) || \ + defined(__ARM_ARCH_6KZ__) || \ + defined(__ARM_ARCH_6M__) + return 0; + #else + not pre arm v7 + #endif] + )], + [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) + if grep -q Raspbian /etc/issue && uname -m | grep -q armv7; then + # Raspbian unfortunately makes some extremely questionable + # packaging decisions, configuring gcc to compile for ARMv6 + # despite the fact that the RPi4 is ARMv8. As ARMv8 doesn't + # support all instructions supported by ARMv6 this can + # break. Work around this by checking uname to verify + # that we aren't running on armv7. + # See #17856. + AC_MSG_NOTICE([Found compiler which claims to target ARMv6 running on ARMv7, assuming this is ARMv7 on Raspbian (see T17856)]) + ARM_ISA=ARMv7 + changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + else + ARM_ISA=ARMv6 + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__VFP_FP__) + return 0; + #else + no vfp + #endif] + )], + [changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + ], + [changequote(, )dnl + ARM_ISA_EXT="[]" + changequote([, ])dnl + ] + ) + fi], + [changequote(, )dnl + ARM_ISA=ARMv7 + ARM_ISA_EXT="[VFPv3,NEON]" + changequote([, ])dnl + ]) + ]) + + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [], + [#if defined(__SOFTFP__) + return 0; + #else + not softfp + #endif] + )], + [changequote(, )dnl + ARM_ABI="SOFT" + changequote([, ])dnl + ], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [], + [#if defined(__ARM_PCS_VFP) + return 0; + #else + no hard float ABI + #endif] + )], + [ARM_ABI="HARD"], + [ARM_ABI="SOFTFP"] + )] + ) + + AC_SUBST(ARM_ISA) +]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05a34651b012bb745ca456eca7a70b5b606d16ed...dff45613e1b07060c55efca280c96533e353636b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05a34651b012bb745ca456eca7a70b5b606d16ed...dff45613e1b07060c55efca280c96533e353636b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 17:36:30 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 22 May 2023 13:36:30 -0400 Subject: [Git][ghc/ghc][wip/T23025] 25 commits: JS: Implement h$clock_gettime in the JavaScript RTS (#23360) Message-ID: <646ba81e233bd_9760a75c42a8c1145367@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23025 at Glasgow Haskell Compiler / GHC Commits: 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - 23cd07c8 by Krzysztof Gogolewski at 2023-05-22T19:23:43+02:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b421cc354d707a8b1610b68d92c16730fb159598...23cd07c8c6531ee433832aae46136be2be625e48 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b421cc354d707a8b1610b68d92c16730fb159598...23cd07c8c6531ee433832aae46136be2be625e48 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 17:51:48 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 22 May 2023 13:51:48 -0400 Subject: [Git][ghc/ghc][wip/expand-do] add PopSrcSpan in appropriate places while desugaring Message-ID: <646babb43c08c_9760a75c42a641145793@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: e54201aa by Apoorv Ingle at 2023-05-22T12:51:39-05:00 add PopSrcSpan in appropriate places while desugaring - - - - - 2 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -476,6 +476,12 @@ mkExpandedExpr -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedExpr a b = XExpr (ExpansionExprRn (HsExpanded (Left a) b)) +mkExpandedStmt + :: ExprLStmt GhcRn -- ^ source statement + -> HsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +mkExpandedStmt a b = XExpr (ExpansionExprRn (HsExpanded (Right a) b)) + data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions {-# UNPACK #-} !(HsWrap HsExpr) @@ -740,7 +746,8 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr x instance Outputable XXExprGhcRn where - ppr (ExpansionExprRn e) = ppr e + ppr (ExpansionExprRn (HsExpanded (Left e) _)) = ppr e + ppr (ExpansionExprRn (HsExpanded (Right e) _)) = ppr e ppr (PopSrcSpan e) = ppr e ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1209,7 +1209,7 @@ expand_do_stmts _ [L _ (LastStmt _ body _ ret_expr)] = return $ wrapGenSpan $ genHsApp ret body -expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) +expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding x can fail @@ -1220,10 +1220,10 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ mkHsApps (wrapGenSpan bind_op)-- (>>=) - [ e - , expr - ] + return $ mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ e + , noLocA $ mkPopSrcSpanExpr expr + ] | otherwise = -- just use the Prelude.>>= TODO: Necessary? -- stmts ~~> stmts' @@ -1241,7 +1241,7 @@ expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (expand_stmts)) + return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (noLocA $ mkPopSrcSpanExpr expand_stmts)) expand_do_stmts do_or_lc ((L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = @@ -1250,9 +1250,9 @@ expand_do_stmts do_or_lc ((L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ L loc (mkPopSrcSpanExpr (mkHsApps (wrapGenSpan f) -- (>>) - [ e -- e - , expand_stmts ])) -- stmts' + return $ (mkHsApps (wrapGenSpan f) -- (>>) + [ e -- e + , noLocA $ mkPopSrcSpanExpr expand_stmts ]) -- stmts' expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e54201aa253eab119d4b0ed0829d3cc3ce4f3f85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e54201aa253eab119d4b0ed0829d3cc3ce4f3f85 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 17:55:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 13:55:43 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 4 commits: ROMES: WIP 5 Message-ID: <646bac9f37cc5_9760a4b504b8c114641c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: c1c320fc by Rodrigo Mesquita at 2023-05-22T17:53:42+01:00 ROMES: WIP 5 - - - - - a8be9fae by Rodrigo Mesquita at 2023-05-22T17:53:47+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 3cd81437 by Rodrigo Mesquita at 2023-05-22T17:53:47+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 97a64016 by Rodrigo Mesquita at 2023-05-22T18:47:25+01:00 helper AC function for enable/disable - - - - - 12 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fptools_set_haskell_platform_vars.m4 - + m4/get_arm_isa.m4 - m4/ghc_toolchain.m4 Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -113,7 +113,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -288,7 +288,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -42,7 +42,6 @@ import GHC.SysTools.Tasks import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe ===================================== compiler/GHC/SysTools.hs ===================================== @@ -35,7 +35,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -123,8 +123,8 @@ data ToolchainSetting -- be part of settings, so they should be moved out setting :: Setting -> Action String setting key = case key of - BuildArch -> systemConf "build-arch" - BuildOs -> systemConf "build-os" + BuildArch -> hostConf archStr -- ROMES:TODO: This is only correct while we assume BUILD=HOST=TARGET + BuildOs -> hostConf osStr -- This too. BuildPlatform -> systemConf "build-platform" BuildVendor -> systemConf "build-vendor" CursesIncludeDir -> systemConf "curses-include-dir" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -431,7 +431,7 @@ generateSettings = do , ("ld command", expr $ settingsFileSetting ToolchainSetting_LdCommand) , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) , ("ld supports compact unwind", expr $ queryTargetTargetConfig linkSupportsCompactUnwind) - , ("ld supports filelist", expr $ queryTargetTargetConfig ldSupportsFilelist) + , ("ld supports filelist", expr $ queryTargetTargetConfig linkSupportsFilelist) , ("ld supports response files", expr $ queryTargetTargetConfig linkSupportsResponseFiles) , ("ld is GNU ld", expr $ queryTargetTargetConfig linkIsGnu) , ("Merge objects command", expr $ settingsFileSetting ToolchainSetting_MergeObjectsCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -14,7 +14,7 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra -import GHC.Toolchain (ccProgram, tgtCCompiler, cppProgram, tgtCPreprocessor) +import GHC.Toolchain (ccProgram, tgtCCompiler) import GHC.Toolchain.Program ghcBuilderArgs :: Args @@ -294,6 +294,3 @@ includeGhcArgs = do -- Utilities getStagedCCFlags :: Args getStagedCCFlags = prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig - -getStagedCPPFlags :: Args -getStagedCPPFlags = prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -5,7 +5,7 @@ import Hadrian.Haskell.Cabal.Type import Builder import Packages import Settings.Builders.Common -import GHC.Toolchain (tgtCCompiler, ccProgram, tgtCPreprocessor, cppProgram, tgtCCompilerLink, ccLinkProgram) +import GHC.Toolchain (tgtCCompiler, ccProgram, tgtCCompilerLink, ccLinkProgram) import GHC.Toolchain.Program hsc2hsBuilderArgs :: Args ===================================== m4/fptools_set_haskell_platform_vars.m4 ===================================== @@ -1,3 +1,134 @@ +# FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS +# ---------------------------------- +# Drop in shell functions used by FPTOOLS_SET_HASKELL_PLATFORM_VARS +AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS], +[ + checkArch() { + case [$]1 in + i386) + test -z "[$]2" || eval "[$]2=ArchX86" + ;; + x86_64|amd64) + test -z "[$]2" || eval "[$]2=ArchX86_64" + ;; + powerpc) + test -z "[$]2" || eval "[$]2=ArchPPC" + ;; + powerpc64) + test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V1\"" + ;; + powerpc64le) + test -z "[$]2" || eval "[$]2=\"ArchPPC_64 ELF_V2\"" + ;; + s390x) + test -z "[$]2" || eval "[$]2=ArchS390X" + ;; + arm) + GET_ARM_ISA() + test -z "[$]2" || eval "[$]2=\"ArchARM \$ARM_ISA \$ARM_ISA_EXT \$ARM_ABI\"" + ;; + aarch64) + test -z "[$]2" || eval "[$]2=ArchAArch64" + ;; + alpha) + test -z "[$]2" || eval "[$]2=ArchAlpha" + ;; + mips|mipseb) + test -z "[$]2" || eval "[$]2=ArchMipseb" + ;; + mipsel) + test -z "[$]2" || eval "[$]2=ArchMipsel" + ;; + riscv64) + test -z "[$]2" || eval "[$]2=ArchRISCV64" + ;; + wasm32) + test -z "[$]2" || eval "[$]2=ArchWasm32" + ;; + loongarch64) + test -z "[$]2" || eval "[$]2=ArchLoongArch64" + ;; + hppa|hppa1_1|ia64|m68k|nios2|riscv32|loongarch32|rs6000|s390|sh4|vax) + test -z "[$]2" || eval "[$]2=ArchUnknown" + ;; + javascript) + test -z "[$]2" || eval "[$]2=ArchJavaScript" + ;; + *) + echo "Unknown arch [$]1" + exit 1 + ;; + esac + } + + checkVendor() { + case [$]1 in + dec|none|unknown|hp|apple|next|sun|sgi|ibm|montavista|portbld|alpine) + ;; + *) + AC_MSG_WARN([Unknown vendor [$]1]) + ;; + esac + } + + checkOS() { + case [$]1 in + linux|linux-android) + test -z "[$]2" || eval "[$]2=OSLinux" + ;; + darwin|ios|watchos|tvos) + test -z "[$]2" || eval "[$]2=OSDarwin" + ;; + solaris2) + test -z "[$]2" || eval "[$]2=OSSolaris2" + ;; + mingw32|windows) + test -z "[$]2" || eval "[$]2=OSMinGW32" + ;; + freebsd) + test -z "[$]2" || eval "[$]2=OSFreeBSD" + ;; + dragonfly) + test -z "[$]2" || eval "[$]2=OSDragonFly" + ;; + kfreebsdgnu) + test -z "[$]2" || eval "[$]2=OSKFreeBSD" + ;; + openbsd) + test -z "[$]2" || eval "[$]2=OSOpenBSD" + ;; + netbsd) + test -z "[$]2" || eval "[$]2=OSNetBSD" + ;; + haiku) + test -z "[$]2" || eval "[$]2=OSHaiku" + ;; + nto-qnx) + test -z "[$]2" || eval "[$]2=OSQNXNTO" + ;; + wasi) + test -z "[$]2" || eval "[$]2=OSWasi" + ;; + dragonfly|hpux|linuxaout|freebsd2|nextstep2|nextstep3|sunos4|ultrix) + test -z "[$]2" || eval "[$]2=OSUnknown" + ;; + aix) + test -z "[$]2" || eval "[$]2=OSAIX" + ;; + gnu) + test -z "[$]2" || eval "[$]2=OSHurd" + ;; + ghcjs|js) + test -z "[$]2" || eval "[$]2=OSGhcjs" + ;; + *) + echo "Unknown OS '[$]1'" + exit 1 + ;; + esac + } +]) + # Note [autoconf assembler checks and -flto] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Autoconf's AC_COMPILE_IFELSE macro is fragile in the case of checks @@ -43,3 +174,13 @@ AC_DEFUN([GHC_SUBSECTIONS_VIA_SYMBOLS], # We might have to generate a bunch of -D CPP flags to satisfy these dependencies (future work). +# FPTOOLS_SET_HASKELL_PLATFORM_VARS +# ---------------------------------- +# Set the Haskell platform variables +AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS], +[ + AC_REQUIRE([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS]) + checkArch "[$]$1Arch" "Haskell$1Arch" + checkVendor "[$]$1Vendor" + checkOS "[$]$1OS" "Haskell$1Os" +]) ===================================== m4/get_arm_isa.m4 ===================================== @@ -0,0 +1,117 @@ +# GET_ARM_ISA +# ---------------------------------- +# Get info about the ISA on the ARM arch +AC_DEFUN([GET_ARM_ISA], +[ + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__ARM_ARCH_2__) || \ + defined(__ARM_ARCH_3__) || \ + defined(__ARM_ARCH_3M__) || \ + defined(__ARM_ARCH_4__) || \ + defined(__ARM_ARCH_4T__) || \ + defined(__ARM_ARCH_5__) || \ + defined(__ARM_ARCH_5T__) || \ + defined(__ARM_ARCH_5E__) || \ + defined(__ARM_ARCH_5TE__) + return 0; + #else + not pre arm v6 + #endif] + )], + [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv6, 1, [ARM pre v6]) + AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) + changequote(, )dnl + ARM_ISA=ARMv5 + ARM_ISA_EXT="[]" + changequote([, ])dnl + ], + [ + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__ARM_ARCH_6__) || \ + defined(__ARM_ARCH_6J__) || \ + defined(__ARM_ARCH_6T2__) || \ + defined(__ARM_ARCH_6Z__) || \ + defined(__ARM_ARCH_6ZK__) || \ + defined(__ARM_ARCH_6K__) || \ + defined(__ARM_ARCH_6KZ__) || \ + defined(__ARM_ARCH_6M__) + return 0; + #else + not pre arm v7 + #endif] + )], + [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) + if grep -q Raspbian /etc/issue && uname -m | grep -q armv7; then + # Raspbian unfortunately makes some extremely questionable + # packaging decisions, configuring gcc to compile for ARMv6 + # despite the fact that the RPi4 is ARMv8. As ARMv8 doesn't + # support all instructions supported by ARMv6 this can + # break. Work around this by checking uname to verify + # that we aren't running on armv7. + # See #17856. + AC_MSG_NOTICE([Found compiler which claims to target ARMv6 running on ARMv7, assuming this is ARMv7 on Raspbian (see T17856)]) + ARM_ISA=ARMv7 + changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + else + ARM_ISA=ARMv6 + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__VFP_FP__) + return 0; + #else + no vfp + #endif] + )], + [changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + ], + [changequote(, )dnl + ARM_ISA_EXT="[]" + changequote([, ])dnl + ] + ) + fi], + [changequote(, )dnl + ARM_ISA=ARMv7 + ARM_ISA_EXT="[VFPv3,NEON]" + changequote([, ])dnl + ]) + ]) + + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [], + [#if defined(__SOFTFP__) + return 0; + #else + not softfp + #endif] + )], + [changequote(, )dnl + ARM_ABI="SOFT" + changequote([, ])dnl + ], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [], + [#if defined(__ARM_PCS_VFP) + return 0; + #else + no hard float ABI + #endif] + )], + [ARM_ABI="HARD"], + [ARM_ABI="SOFTFP"] + )] + ) + + AC_SUBST(ARM_ISA) +]) ===================================== m4/ghc_toolchain.m4 ===================================== @@ -8,6 +8,17 @@ AC_DEFUN([ADD_GHC_TOOLCHAIN_ARG], done ]) +dnl $1 argument name +dnl $2 variable +AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], +[ + if test "$2" = "YES"; then + echo "--enable-$1" >> acargs + elif test "$2" = "NO"; then + echo "--disable-$1" >> acargs + fi +]) + AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ @@ -42,17 +53,8 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--readelf=$READELF" >> acargs ADD_GHC_TOOLCHAIN_ARG([readelf-opt], [$READELFFLAGS]) - if test "$Unregisterised" = "YES"; then - echo "--enable-unregisterised" >> acargs - else - echo "--disable-unregisterised" >> acargs - fi - - if test "$TablesNextToCode" = "YES"; then - echo "--enable-tables-next-to-code" >> acargs - else - echo "--disable-tables-next-to-code" >> acargs - fi + ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) + ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ( set -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dff45613e1b07060c55efca280c96533e353636b...97a64016882224b52197e5796ca7be5e959eddca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dff45613e1b07060c55efca280c96533e353636b...97a64016882224b52197e5796ca7be5e959eddca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 18:21:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 May 2023 14:21:37 -0400 Subject: [Git][ghc/ghc][master] NCG: remove useless .align directive (#20758) Message-ID: <646bb2b1d34ac_9760a75c42a78115685b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 2 changed files: - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -18,7 +18,6 @@ import GHC.CmmToAsm.Utils import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Label -import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes) import GHC.Cmm.BlockId import GHC.Cmm.CLabel @@ -29,18 +28,12 @@ import GHC.Utils.Outputable import GHC.Utils.Panic -pprProcAlignment :: IsDoc doc => NCGConfig -> doc -pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config) - where - platform = ncgPlatform config - pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc pprNatCmmDecl config (CmmData section dats) = pprSectionAlign config section $$ pprDatas config dats pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = let platform = ncgPlatform config in - pprProcAlignment config $$ case topInfoTable proc of Nothing -> -- special case for code without info table: @@ -80,10 +73,6 @@ pprLabel platform lbl = $$ pprTypeDecl platform lbl $$ line (pprAsmLabel platform lbl <> char ':') -pprAlign :: IsDoc doc => Platform -> Alignment -> doc -pprAlign _platform alignment - = line $ text "\t.balign " <> int (alignmentBytes alignment) - -- | Print appropriate alignment for the given section type. pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc pprAlignForSection _platform _seg ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -74,7 +74,6 @@ pprNatCmmDecl config (CmmData section dats) = pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = let platform = ncgPlatform config in - pprProcAlignment config $$ case topInfoTable proc of Nothing -> -- special case for code without info table: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b56d737974f55933a35c911e8a81ee6147b4a542 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b56d737974f55933a35c911e8a81ee6147b4a542 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 18:22:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 May 2023 14:22:17 -0400 Subject: [Git][ghc/ghc][master] Add test for #23156 Message-ID: <646bb2d9eedcc_9760a4b31b03c115997b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 3 changed files: - + testsuite/tests/typecheck/should_compile/T23156.hs - + testsuite/tests/typecheck/should_compile/T23156.stderr - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== testsuite/tests/typecheck/should_compile/T23156.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds, TypeFamilies, PartialTypeSignatures #-} +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T23156 where + +import Prelude +import GHC.TypeLits +import Data.Kind + +type BooleanOf2 :: Type -> Type +type family BooleanOf2 a + +type instance BooleanOf2 Double = Double + +-- Needs to be a type family, changing this to a datatype makes it fast +type TensorOf2 :: Nat -> Type -> Type +type family TensorOf2 k a + +type instance TensorOf2 n Double = Double + + +-- With GHC 9.4 and 9.6, typechecking was +-- exponential in the size of this tuple +type ADReady r = + ( BooleanOf2 r ~ BooleanOf2 (TensorOf2 1 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 2 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 3 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 4 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 5 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 6 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 7 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 8 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 9 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 10 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 11 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 12 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 13 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 14 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 15 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 16 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 17 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 18 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 19 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 20 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 21 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 22 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 23 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 24 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 25 r) + ) + +f :: forall r . (ADReady r) => () +f = undefined + +-- This uses a lot of memory +g :: _ => () +g = f + +-- This is fine +g' = f @Double ===================================== testsuite/tests/typecheck/should_compile/T23156.stderr ===================================== @@ -0,0 +1,25 @@ + +T23156.hs:51:6: warning: [GHC-05617] [-Wdeferred-type-errors (in -Wdefault)] + • Could not deduce ‘BooleanOf2 (TensorOf2 1 r0) ~ BooleanOf2 r0’ + from the context: ADReady r + bound by the type signature for: + f :: forall r. ADReady r => () + at T23156.hs:51:6-33 + NB: ‘BooleanOf2’ is a non-injective type family + The type variables ‘r0’, ‘r0’ are ambiguous + • In the ambiguity check for ‘f’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: f :: forall r. (ADReady r) => () + +T23156.hs:55:6: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] + • Found extra-constraints wildcard standing for ‘() :: Constraint’ + • In the type signature: g :: _ => () + +T23156.hs:56:5: warning: [GHC-18872] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type: BooleanOf2 (TensorOf2 1 r0) + with: BooleanOf2 r0 + arising from a use of ‘f’ + NB: ‘BooleanOf2’ is a non-injective type family + The type variables ‘r0’, ‘r0’ are ambiguous + • In the expression: f + In an equation for ‘g’: g = f ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -874,3 +874,4 @@ test('QualifiedRecordUpdate', test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) +test('T23156', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15b93d2f89464800465afa3a35151b904bddc730 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15b93d2f89464800465afa3a35151b904bddc730 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 18:42:22 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 22 May 2023 14:42:22 -0400 Subject: [Git][ghc/ghc][wip/expand-do] add PopSrcSpan in appropriate places while desugaring Message-ID: <646bb78e3e23a_9760a75b6d6e811778a3@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 9f2d8231 by Apoorv Ingle at 2023-05-22T13:42:09-05:00 add PopSrcSpan in appropriate places while desugaring - - - - - 2 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -457,8 +457,10 @@ type instance XXExpr GhcTc = XXExprGhcTc type HsExprOrStmt a = Either (HsExpr a) (ExprLStmt a) data XXExprGhcRn - = ExpansionExprRn !(HsExpansion (HsExprOrStmt GhcRn) (HsExpr GhcRn)) - | PopSrcSpan !(LHsExpr GhcRn) + = ExpansionExprRn + {-# UNPACK #-} !(HsExpansion (HsExprOrStmt GhcRn) (HsExpr GhcRn)) + | PopSrcSpan + {-# UNPACK #-} !(LHsExpr GhcRn) -- Placeholder for identifying generated source locations in GhcRn phase -- Should not presist post typechecking -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match @@ -476,6 +478,12 @@ mkExpandedExpr -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedExpr a b = XExpr (ExpansionExprRn (HsExpanded (Left a) b)) +mkExpandedStmt + :: ExprLStmt GhcRn -- ^ source statement + -> HsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +mkExpandedStmt a b = XExpr (ExpansionExprRn (HsExpanded (Right a) b)) + data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions {-# UNPACK #-} !(HsWrap HsExpr) @@ -740,7 +748,8 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr x instance Outputable XXExprGhcRn where - ppr (ExpansionExprRn e) = ppr e + ppr (ExpansionExprRn (HsExpanded (Left e) _)) = ppr e + ppr (ExpansionExprRn (HsExpanded (Right e) _)) = ppr e ppr (PopSrcSpan e) = ppr e ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1220,17 +1220,16 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ mkHsApps (wrapGenSpan bind_op)-- (>>=) - [ e - , expr - ] + return $ mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ e + , noLocA $ mkPopSrcSpanExpr expr + ] | otherwise = -- just use the Prelude.>>= TODO: Necessary? -- stmts ~~> stmts' -- ------------------------------------------------------- -- pat <- e ; stmts ~~> (Prelude.>>=) e (\ pat -> stmts') - do traceTc "expand_do_stmts: generic binop" empty - expand_stmts <- expand_do_stmts do_or_lc lstmts + do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ e , mkHsLamDoExp [pat] (noLocA $ mkPopSrcSpanExpr expand_stmts) -- (\ x -> stmts') @@ -1241,18 +1240,18 @@ expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (expand_stmts)) + return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (noLocA $ mkPopSrcSpanExpr expand_stmts)) -expand_do_stmts do_or_lc ((L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ L loc (mkPopSrcSpanExpr (mkHsApps (wrapGenSpan f) -- (>>) - [ e -- e - , expand_stmts ])) -- stmts' + return $ (mkHsApps (wrapGenSpan f) -- (>>) + [ e -- e + , noLocA $ mkPopSrcSpanExpr expand_stmts ]) -- stmts' expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f2d8231e64478037f815f13141c8bafe27f6bc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f2d8231e64478037f815f13141c8bafe27f6bc4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 18:43:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 May 2023 14:43:16 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <646bb7c4234fb_9760a8ee1acc41178339@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: d9c6b7a8 by Ben Gamari at 2023-05-22T14:43:05-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 10 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,243 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc, mkVarOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons ++ + map mkVarOcc integerConversionIds + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + + -- Conversion functions in GHC.Integer which are only exposed on 32-bit + -- platforms + integerConversionIds = + [ "int64ToInteger" + , "integerToInt64" + , "integerToWord64" + , "word64ToInteger" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> nest 2 (text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}") + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9c6b7a88ae2c1c666a86c971d3549c5fc8a637d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9c6b7a88ae2c1c666a86c971d3549c5fc8a637d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 18:47:03 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 22 May 2023 14:47:03 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Delete unused imports of SysTools.Info Message-ID: <646bb8a73bb9e_9760a8f091e081181185@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: fd4e2953 by Rodrigo Mesquita at 2023-05-22T19:06:33+01:00 Delete unused imports of SysTools.Info - - - - - 8196df06 by Rodrigo Mesquita at 2023-05-22T19:46:58+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 5 changed files: - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - distrib/configure.ac.in Changes: ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -39,7 +39,6 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit import Control.Monad ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,7 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs ===================================== @@ -8,23 +8,6 @@ ----------------------------------------------------------------------------- module GHC.SysTools.Info where -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - {- Note [Run-time linker info] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ See also: #5240, #6063, #10110 ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session ===================================== distrib/configure.ac.in ===================================== @@ -106,9 +106,6 @@ dnl -------------------------------------------------------------- AC_PROG_CC([gcc clang]) AC_PROG_CXX([g++ clang++ c++]) -dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) -AC_PROG_CPP - # --with-hs-cpp/--with-hs-cpp-flags FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97a64016882224b52197e5796ca7be5e959eddca...8196df064f0427fbbfb23e5bbeb1214c3a493613 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97a64016882224b52197e5796ca7be5e959eddca...8196df064f0427fbbfb23e5bbeb1214c3a493613 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 18:53:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 May 2023 14:53:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: NCG: remove useless .align directive (#20758) Message-ID: <646bba134e72b_9760a8f93bdb011889a7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 15f95381 by Greg Steuck at 2023-05-22T14:52:58-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - e8e72195 by Greg Steuck at 2023-05-22T14:52:58-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - c4304564 by Greg Steuck at 2023-05-22T14:52:58-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 8c2e0594 by Krzysztof Gogolewski at 2023-05-22T14:52:58-04:00 Add an error origin for impedance matching (#23427) - - - - - 13 changed files: - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types/Origin.hs - hadrian/src/Oracles/Setting.hs - libraries/base/tests/IO/all.T - libraries/ghc-boot/GHC/BaseDir.hs - + testsuite/tests/typecheck/should_compile/T23156.hs - + testsuite/tests/typecheck/should_compile/T23156.stderr - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T23427.hs - + testsuite/tests/typecheck/should_fail/T23427.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -18,7 +18,6 @@ import GHC.CmmToAsm.Utils import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Label -import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes) import GHC.Cmm.BlockId import GHC.Cmm.CLabel @@ -29,18 +28,12 @@ import GHC.Utils.Outputable import GHC.Utils.Panic -pprProcAlignment :: IsDoc doc => NCGConfig -> doc -pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config) - where - platform = ncgPlatform config - pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc pprNatCmmDecl config (CmmData section dats) = pprSectionAlign config section $$ pprDatas config dats pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = let platform = ncgPlatform config in - pprProcAlignment config $$ case topInfoTable proc of Nothing -> -- special case for code without info table: @@ -80,10 +73,6 @@ pprLabel platform lbl = $$ pprTypeDecl platform lbl $$ line (pprAsmLabel platform lbl <> char ':') -pprAlign :: IsDoc doc => Platform -> Alignment -> doc -pprAlign _platform alignment - = line $ text "\t.balign " <> int (alignmentBytes alignment) - -- | Print appropriate alignment for the given section type. pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc pprAlignForSection _platform _seg ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -74,7 +74,6 @@ pprNatCmmDecl config (CmmData section dats) = pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = let platform = ncgPlatform config in - pprProcAlignment config $$ case topInfoTable proc of Nothing -> -- special case for code without info table: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -899,7 +899,7 @@ mkExport prag_fn residual insoluble qtvs theta then return idHsWrapper -- Fast path; also avoids complaint when we infer -- an ambiguous type and have AllowAmbiguousType -- e..g infer x :: forall a. F a -> Int - else tcSubTypeSigma (Shouldn'tHappenOrigin "mkExport") + else tcSubTypeSigma (ImpedanceMatching poly_id) sig_ctxt sel_poly_ty poly_ty -- See Note [Impedance matching] @@ -1254,11 +1254,9 @@ Then we want to check that forall qtvs. theta => f_mono_ty is more polymorphic than f's polytype and the proof is the impedance matcher. -Notice that the impedance matcher may do defaulting. See #7173. - -If we've gotten the constraints right during inference (and we assume we have), -this sub-type check should never fail. It's not really a check -- it's more of -a procedure to produce the right wrapper. +The impedance matcher can do defaulting: in the above example, we default +to Integer because of Num. See #7173. If we're dealing with a nondefaultable +class, impedance matching can fail. See #23427. Note [SPECIALISE pragmas] ~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -591,6 +591,7 @@ data CtOrigin | IfThenElseOrigin -- An if-then-else expression | BracketOrigin -- An overloaded quotation bracket | StaticOrigin -- A static form + | ImpedanceMatching Id -- See Note [Impedance matching] in GHC.Tc.Gen.Bind | Shouldn'tHappenOrigin String -- The user should never see this one -- | Testing whether the constraint associated with an instance declaration @@ -826,6 +827,10 @@ pprCtOrigin (InstProvidedOrigin mod cls_inst) , ppr cls_inst , text "is provided by" <+> quotes (ppr mod)] +pprCtOrigin (ImpedanceMatching x) + = vcat [ text "arising when matching required constraints" + , text "in a recursive group involving" <+> quotes (ppr x)] + pprCtOrigin (CycleBreakerOrigin orig) = pprCtOrigin orig @@ -921,6 +926,8 @@ pprCtO (FRROrigin {}) = text "a representation-polymorphism check" pprCtO (WantedSuperclassOrigin {}) = text "a superclass constraint" pprCtO (InstanceSigOrigin {}) = text "a type signature in an instance" pprCtO (AmbiguityCheckOrigin {}) = text "a type ambiguity check" +pprCtO (ImpedanceMatching {}) = text "combining required constraints" + {- ********************************************************************* * * ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -291,10 +291,7 @@ isElfTarget = anyTargetOs elfOSes -- TODO: Windows supports lazy binding (but GHC doesn't currently support -- dynamic way on Windows anyways). hostSupportsRPaths :: Action Bool -hostSupportsRPaths = do - -- https://gitlab.haskell.org/ghc/ghc/-/issues/23011 - isOpenBSD <- anyHostOs ["openbsd"] - if not isOpenBSD then anyHostOs (elfOSes ++ machoOSes) else pure False +hostSupportsRPaths = anyHostOs (elfOSes ++ machoOSes) -- | Check whether the target supports GHCi. ghcWithInterpreter :: Action Bool ===================================== libraries/base/tests/IO/all.T ===================================== @@ -155,6 +155,7 @@ test('T17414', # distributions. This test needs to create a large file which will exceed the # size of this filesystem consequently we must skip it (see #17459). when(opsys('linux'), skip), + when(opsys('openbsd'), skip), high_memory_usage], compile_and_run, ['']) test('T17510', expect_broken(17510), compile_and_run, ['']) ===================================== libraries/ghc-boot/GHC/BaseDir.hs ===================================== @@ -24,7 +24,7 @@ import Data.List (stripPrefix) import Data.Maybe (listToMaybe) import System.FilePath -#if MIN_VERSION_base(4,17,0) +#if MIN_VERSION_base(4,17,0) && !defined(openbsd_HOST_OS) import System.Environment (executablePath) #else import System.Environment (getExecutablePath) @@ -45,8 +45,10 @@ expandPathVar var value str expandPathVar var value (x:xs) = x : expandPathVar var value xs expandPathVar _ _ [] = [] -#if !MIN_VERSION_base(4,17,0) --- Polyfill for base-4.17 executablePath +#if !MIN_VERSION_base(4,17,0) || defined(openbsd_HOST_OS) +-- Polyfill for base-4.17 executablePath and OpenBSD which doesn't +-- have executablePath. The best it can do is use argv[0] which is +-- good enough for most uses of getBaseDir. executablePath :: Maybe (IO (Maybe FilePath)) executablePath = Just (Just <$> getExecutablePath) #elif !MIN_VERSION_base(4,18,0) && defined(js_HOST_ARCH) ===================================== testsuite/tests/typecheck/should_compile/T23156.hs ===================================== @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds, TypeFamilies, PartialTypeSignatures #-} +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T23156 where + +import Prelude +import GHC.TypeLits +import Data.Kind + +type BooleanOf2 :: Type -> Type +type family BooleanOf2 a + +type instance BooleanOf2 Double = Double + +-- Needs to be a type family, changing this to a datatype makes it fast +type TensorOf2 :: Nat -> Type -> Type +type family TensorOf2 k a + +type instance TensorOf2 n Double = Double + + +-- With GHC 9.4 and 9.6, typechecking was +-- exponential in the size of this tuple +type ADReady r = + ( BooleanOf2 r ~ BooleanOf2 (TensorOf2 1 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 2 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 3 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 4 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 5 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 6 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 7 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 8 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 9 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 10 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 11 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 12 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 13 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 14 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 15 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 16 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 17 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 18 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 19 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 20 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 21 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 22 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 23 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 24 r) + , BooleanOf2 r ~ BooleanOf2 (TensorOf2 25 r) + ) + +f :: forall r . (ADReady r) => () +f = undefined + +-- This uses a lot of memory +g :: _ => () +g = f + +-- This is fine +g' = f @Double ===================================== testsuite/tests/typecheck/should_compile/T23156.stderr ===================================== @@ -0,0 +1,25 @@ + +T23156.hs:51:6: warning: [GHC-05617] [-Wdeferred-type-errors (in -Wdefault)] + • Could not deduce ‘BooleanOf2 (TensorOf2 1 r0) ~ BooleanOf2 r0’ + from the context: ADReady r + bound by the type signature for: + f :: forall r. ADReady r => () + at T23156.hs:51:6-33 + NB: ‘BooleanOf2’ is a non-injective type family + The type variables ‘r0’, ‘r0’ are ambiguous + • In the ambiguity check for ‘f’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: f :: forall r. (ADReady r) => () + +T23156.hs:55:6: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] + • Found extra-constraints wildcard standing for ‘() :: Constraint’ + • In the type signature: g :: _ => () + +T23156.hs:56:5: warning: [GHC-18872] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type: BooleanOf2 (TensorOf2 1 r0) + with: BooleanOf2 r0 + arising from a use of ‘f’ + NB: ‘BooleanOf2’ is a non-injective type family + The type variables ‘r0’, ‘r0’ are ambiguous + • In the expression: f + In an equation for ‘g’: g = f ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -874,3 +874,4 @@ test('QualifiedRecordUpdate', test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) +test('T23156', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T23427.hs ===================================== @@ -0,0 +1,10 @@ +module T23427 where + +class C a where + f :: a -> a + +indent :: C a => a -> a +indent n = doText n + where + doText x = const (f x) doTail + doTail _ = const n doText ===================================== testsuite/tests/typecheck/should_fail/T23427.stderr ===================================== @@ -0,0 +1,16 @@ + +T23427.hs:9:7: error: [GHC-39999] + • Could not deduce ‘C a0’ + arising when matching required constraints + in a recursive group involving ‘doTail’ + from the context: C a + bound by the type signature for: + indent :: forall a. C a => a -> a + at T23427.hs:6:1-23 + The type variable ‘a0’ is ambiguous + • In an equation for ‘indent’: + indent n + = doText n + where + doText x = const (f x) doTail + doTail _ = const n doText ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -683,3 +683,4 @@ test('TyfamsDisabled', normal, compile_fail, ['']) test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) test('CommonFieldTypeMismatch', normal, compile_fail, ['']) test('T17284', normal, compile_fail, ['']) +test('T23427', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a94db291bc8deb3c25bf077c5d656bbd6ffd9473...8c2e0594e18a4bb966197fd579c5c129945d7a53 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a94db291bc8deb3c25bf077c5d656bbd6ffd9473...8c2e0594e18a4bb966197fd579c5c129945d7a53 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 19:35:04 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 22 May 2023 15:35:04 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] 4 commits: NCG: remove useless .align directive (#20758) Message-ID: <646bc3e8a8d4f_9760a8ec71e7c12090cc@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 7aaea60b by Simon Peyton Jones at 2023-05-22T20:34:52+01:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 189e496c by Simon Peyton Jones at 2023-05-22T20:34:52+01:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 25 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1c2ba37ddd23adbbbfe11985c76ba634a694153...189e496c8393575ba84cb1909fd03119be8af379 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1c2ba37ddd23adbbbfe11985c76ba634a694153...189e496c8393575ba84cb1909fd03119be8af379 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 22 21:52:32 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 22 May 2023 17:52:32 -0400 Subject: [Git][ghc/ghc][wip/T23070-dicts] 2 commits: Add the SolverStage monad Message-ID: <646be420e7a2c_9760a8ec71e7c1217262@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23070-dicts at Glasgow Haskell Compiler / GHC Commits: 7512f7d7 by Simon Peyton Jones at 2023-05-22T23:51:52+02:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 2d9f0dac by Simon Peyton Jones at 2023-05-22T23:51:52+02:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 23 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/189e496c8393575ba84cb1909fd03119be8af379...2d9f0dac73c8a24f86af9d976a40b6facc86a14c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/189e496c8393575ba84cb1909fd03119be8af379...2d9f0dac73c8a24f86af9d976a40b6facc86a14c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 00:18:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 May 2023 20:18:42 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.6 Message-ID: <646c0662ba7dd_9760a8ec71e7c1226534@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 00:23:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 22 May 2023 20:23:26 -0400 Subject: [Git][ghc/ghc][wip/backports-9.6] Deleted 1 commit: configure: RELEASE=NO Message-ID: <646c077e6fb48_9760a75c42a8c122954a@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 9a1dcec1 by Ben Gamari at 2023-05-22T20:18:17-04:00 configure: RELEASE=NO - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.2], [glasgow-has AC_CONFIG_MACRO_DIRS([m4]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=YES} +: ${RELEASE=NO} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a1dcec1be8421d415c4592231e6c24af7e7e013 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a1dcec1be8421d415c4592231e6c24af7e7e013 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 00:23:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 May 2023 20:23:32 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Revert "Change hostSupportsRPaths to report False on OpenBSD" Message-ID: <646c07842c3f5_9760a8fb03b3412324be@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 3 changed files: - hadrian/src/Oracles/Setting.hs - libraries/base/tests/IO/all.T - libraries/ghc-boot/GHC/BaseDir.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -291,10 +291,7 @@ isElfTarget = anyTargetOs elfOSes -- TODO: Windows supports lazy binding (but GHC doesn't currently support -- dynamic way on Windows anyways). hostSupportsRPaths :: Action Bool -hostSupportsRPaths = do - -- https://gitlab.haskell.org/ghc/ghc/-/issues/23011 - isOpenBSD <- anyHostOs ["openbsd"] - if not isOpenBSD then anyHostOs (elfOSes ++ machoOSes) else pure False +hostSupportsRPaths = anyHostOs (elfOSes ++ machoOSes) -- | Check whether the target supports GHCi. ghcWithInterpreter :: Action Bool ===================================== libraries/base/tests/IO/all.T ===================================== @@ -155,6 +155,7 @@ test('T17414', # distributions. This test needs to create a large file which will exceed the # size of this filesystem consequently we must skip it (see #17459). when(opsys('linux'), skip), + when(opsys('openbsd'), skip), high_memory_usage], compile_and_run, ['']) test('T17510', expect_broken(17510), compile_and_run, ['']) ===================================== libraries/ghc-boot/GHC/BaseDir.hs ===================================== @@ -24,7 +24,7 @@ import Data.List (stripPrefix) import Data.Maybe (listToMaybe) import System.FilePath -#if MIN_VERSION_base(4,17,0) +#if MIN_VERSION_base(4,17,0) && !defined(openbsd_HOST_OS) import System.Environment (executablePath) #else import System.Environment (getExecutablePath) @@ -45,8 +45,10 @@ expandPathVar var value str expandPathVar var value (x:xs) = x : expandPathVar var value xs expandPathVar _ _ [] = [] -#if !MIN_VERSION_base(4,17,0) --- Polyfill for base-4.17 executablePath +#if !MIN_VERSION_base(4,17,0) || defined(openbsd_HOST_OS) +-- Polyfill for base-4.17 executablePath and OpenBSD which doesn't +-- have executablePath. The best it can do is use argv[0] which is +-- good enough for most uses of getBaseDir. executablePath :: Maybe (IO (Maybe FilePath)) executablePath = Just (Just <$> getExecutablePath) #elif !MIN_VERSION_base(4,18,0) && defined(js_HOST_ARCH) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/15b93d2f89464800465afa3a35151b904bddc730...9d531f9a3f9100467460508e928c7bdfba76aad7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/15b93d2f89464800465afa3a35151b904bddc730...9d531f9a3f9100467460508e928c7bdfba76aad7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 00:24:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 May 2023 20:24:05 -0400 Subject: [Git][ghc/ghc][master] Add an error origin for impedance matching (#23427) Message-ID: <646c07a51679_9760a96197e68123598f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 5 changed files: - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types/Origin.hs - + testsuite/tests/typecheck/should_fail/T23427.hs - + testsuite/tests/typecheck/should_fail/T23427.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -899,7 +899,7 @@ mkExport prag_fn residual insoluble qtvs theta then return idHsWrapper -- Fast path; also avoids complaint when we infer -- an ambiguous type and have AllowAmbiguousType -- e..g infer x :: forall a. F a -> Int - else tcSubTypeSigma (Shouldn'tHappenOrigin "mkExport") + else tcSubTypeSigma (ImpedanceMatching poly_id) sig_ctxt sel_poly_ty poly_ty -- See Note [Impedance matching] @@ -1254,11 +1254,9 @@ Then we want to check that forall qtvs. theta => f_mono_ty is more polymorphic than f's polytype and the proof is the impedance matcher. -Notice that the impedance matcher may do defaulting. See #7173. - -If we've gotten the constraints right during inference (and we assume we have), -this sub-type check should never fail. It's not really a check -- it's more of -a procedure to produce the right wrapper. +The impedance matcher can do defaulting: in the above example, we default +to Integer because of Num. See #7173. If we're dealing with a nondefaultable +class, impedance matching can fail. See #23427. Note [SPECIALISE pragmas] ~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -591,6 +591,7 @@ data CtOrigin | IfThenElseOrigin -- An if-then-else expression | BracketOrigin -- An overloaded quotation bracket | StaticOrigin -- A static form + | ImpedanceMatching Id -- See Note [Impedance matching] in GHC.Tc.Gen.Bind | Shouldn'tHappenOrigin String -- The user should never see this one -- | Testing whether the constraint associated with an instance declaration @@ -826,6 +827,10 @@ pprCtOrigin (InstProvidedOrigin mod cls_inst) , ppr cls_inst , text "is provided by" <+> quotes (ppr mod)] +pprCtOrigin (ImpedanceMatching x) + = vcat [ text "arising when matching required constraints" + , text "in a recursive group involving" <+> quotes (ppr x)] + pprCtOrigin (CycleBreakerOrigin orig) = pprCtOrigin orig @@ -921,6 +926,8 @@ pprCtO (FRROrigin {}) = text "a representation-polymorphism check" pprCtO (WantedSuperclassOrigin {}) = text "a superclass constraint" pprCtO (InstanceSigOrigin {}) = text "a type signature in an instance" pprCtO (AmbiguityCheckOrigin {}) = text "a type ambiguity check" +pprCtO (ImpedanceMatching {}) = text "combining required constraints" + {- ********************************************************************* * * ===================================== testsuite/tests/typecheck/should_fail/T23427.hs ===================================== @@ -0,0 +1,10 @@ +module T23427 where + +class C a where + f :: a -> a + +indent :: C a => a -> a +indent n = doText n + where + doText x = const (f x) doTail + doTail _ = const n doText ===================================== testsuite/tests/typecheck/should_fail/T23427.stderr ===================================== @@ -0,0 +1,16 @@ + +T23427.hs:9:7: error: [GHC-39999] + • Could not deduce ‘C a0’ + arising when matching required constraints + in a recursive group involving ‘doTail’ + from the context: C a + bound by the type signature for: + indent :: forall a. C a => a -> a + at T23427.hs:6:1-23 + The type variable ‘a0’ is ambiguous + • In an equation for ‘indent’: + indent n + = doText n + where + doText x = const (f x) doTail + doTail _ = const n doText ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -683,3 +683,4 @@ test('TyfamsDisabled', normal, compile_fail, ['']) test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) test('CommonFieldTypeMismatch', normal, compile_fail, ['']) test('T17284', normal, compile_fail, ['']) +test('T23427', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9db0eadd05da2f807b9a5fdcdec50ba1feedde15 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9db0eadd05da2f807b9a5fdcdec50ba1feedde15 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 01:13:31 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 22 May 2023 21:13:31 -0400 Subject: [Git][ghc/ghc][wip/expand-do] add PopSrcSpan in appropriate places while desugaring Message-ID: <646c133b83bee_9760a96b9f3c01237761@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: e62da3f4 by Apoorv Ingle at 2023-05-22T20:13:16-05:00 add PopSrcSpan in appropriate places while desugaring - - - - - 3 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -457,8 +457,10 @@ type instance XXExpr GhcTc = XXExprGhcTc type HsExprOrStmt a = Either (HsExpr a) (ExprLStmt a) data XXExprGhcRn - = ExpansionExprRn !(HsExpansion (HsExprOrStmt GhcRn) (HsExpr GhcRn)) - | PopSrcSpan !(LHsExpr GhcRn) + = ExpansionExprRn + {-# UNPACK #-} !(HsExpansion (HsExprOrStmt GhcRn) (HsExpr GhcRn)) + | PopSrcSpan + {-# UNPACK #-} !(LHsExpr GhcRn) -- Placeholder for identifying generated source locations in GhcRn phase -- Should not presist post typechecking -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match @@ -467,6 +469,10 @@ data XXExprGhcRn mkPopSrcSpanExpr :: LHsExpr GhcRn -> HsExpr GhcRn mkPopSrcSpanExpr a = XExpr (PopSrcSpan a) +-- | Generated location for PopSrcExpr +genPopSrcSpanExpr :: LHsExpr GhcRn -> LHsExpr GhcRn +genPopSrcSpanExpr = noLocA . mkPopSrcSpanExpr + -- | Build a 'HsExpansion' out of an extension constructor, -- and the two components of the expansion: original and -- desugared expressions. @@ -476,6 +482,12 @@ mkExpandedExpr -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedExpr a b = XExpr (ExpansionExprRn (HsExpanded (Left a) b)) +mkExpandedStmt + :: ExprLStmt GhcRn -- ^ source statement + -> HsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +mkExpandedStmt a b = XExpr (ExpansionExprRn (HsExpanded (Right a) b)) + data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions {-# UNPACK #-} !(HsWrap HsExpr) @@ -740,7 +752,8 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr x instance Outputable XXExprGhcRn where - ppr (ExpansionExprRn e) = ppr e + ppr (ExpansionExprRn (HsExpanded (Left e) _)) = ppr e + ppr (ExpansionExprRn (HsExpanded (Right e) _)) = ppr e ppr (PopSrcSpan e) = ppr e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,7 +858,8 @@ warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg arg_ty | Just (l, f) <- fish_var fun , f `hasKey` thenMClassOpKey -- it is a (>>) - , isGeneratedSrcSpan l -- it is compiler generated + , isNoSrcSpan l || isGeneratedSrcSpan l -- it is compiler generated + -- TODO: check why is isGeneratedSrcSpan false? = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun , text "loc" <+> ppr l , text "locGen?" <+> ppr (isGeneratedSrcSpan l) ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1192,7 +1192,7 @@ expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) expand_do_stmts ListComp _ = pprPanic "expand_do_stmts: impossible happened. ListComp" empty expand_do_stmts _ [] = pprPanic "expand_do_stmts: impossible happened. Empty stmts" empty -expand_do_stmts _ [L _ (LastStmt _ body _ ret_expr)] +expand_do_stmts _ [L loc (LastStmt _ body _ ret_expr)] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` -- TODO: i don't think we need this if we never call from a ListComp @@ -1206,53 +1206,44 @@ expand_do_stmts _ [L _ (LastStmt _ body _ ret_expr)] -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ wrapGenSpan $ genHsApp ret body + = return $ L loc (genHsApp ret body) -expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) +expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding x can fail -- instead of making an internal name, the fail block is just an anonymous match block --- stmts ~~> stmt' let / pat = stmts'; --- _ = fail "Pattern match failure .." +-- stmts ~~> stmt' expr = let / pat = stmts'; +-- _ = fail "Pattern match failure .." -- ------------------------------------------------------- --- pat <- e ; stmts ~~> (>>=) e f +-- pat <- e ; stmts ~~> (>>=) expr f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ mkHsApps (wrapGenSpan bind_op)-- (>>=) - [ e - , expr - ] + return $ mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ e + , genPopSrcSpanExpr expr + ] - | otherwise = -- just use the Prelude.>>= TODO: Necessary? --- stmts ~~> stmts' --- ------------------------------------------------------- --- pat <- e ; stmts ~~> (Prelude.>>=) e (\ pat -> stmts') - do traceTc "expand_do_stmts: generic binop" empty - expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) - [ e - , mkHsLamDoExp [pat] (noLocA $ mkPopSrcSpanExpr expand_stmts) -- (\ x -> stmts') - ] + | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (expand_stmts)) + return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (genPopSrcSpanExpr expand_stmts)) -expand_do_stmts do_or_lc ((L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ L loc (mkPopSrcSpanExpr (mkHsApps (wrapGenSpan f) -- (>>) - [ e -- e - , expand_stmts ])) -- stmts' + return $ (mkHsApps (wrapGenSpan f) -- (>>) + [ e -- e + , genPopSrcSpanExpr expand_stmts ]) -- stmts' expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts @@ -1276,7 +1267,7 @@ expand_do_stmts do_or_lc return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) , mkHsLamDoExp [ mkBigLHsVarPatTup all_ids ] -- (\ x -> - (noLocA $ mkPopSrcSpanExpr expand_stmts) -- stmts') + (genPopSrcSpanExpr expand_stmts) -- stmts') ] where local_only_ids = local_ids \\ later_ids -- get unique local rec ids; @@ -1360,15 +1351,15 @@ mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> Tc mk_failable_lexpr_tcm pat lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict - ; b <- isIrrefutableHsPatRn tc_env is_strict pat + ; irrf_pat <- isIrrefutableHsPatRn tc_env is_strict pat ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat - , text "isIrrefutable:" <+> ppr b + , text "isIrrefutable:" <+> ppr irrf_pat ]) - ; if b + ; if irrf_pat -- don't decorate with fail statement if -- the pattern is irrefutable - then return $ mkHsLamDoExp [pat] (noLocA (mkPopSrcSpanExpr lexpr)) + then return $ mkHsLamDoExp [pat] (genPopSrcSpanExpr lexpr) else mk_fail_lexpr pat lexpr fail_op } @@ -1379,8 +1370,8 @@ mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsEx mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ - (noLocA [ mkHsCaseAlt pat (noLocA $ mkPopSrcSpanExpr lexpr) -- pat -> expr - , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" + (noLocA [ mkHsCaseAlt pat (genPopSrcSpanExpr lexpr) -- pat -> expr + , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) ])) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e62da3f4897555fe49ad30b9110bd4bb932cdc67 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e62da3f4897555fe49ad30b9110bd4bb932cdc67 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 03:36:08 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 22 May 2023 23:36:08 -0400 Subject: [Git][ghc/ghc][wip/js-hline] lint Message-ID: <646c34a83725f_9760a96b9f3c012402d8@gitlab.mail> Josh Meredith pushed to branch wip/js-hline at Glasgow Haskell Compiler / GHC Commits: 62341d54 by Josh Meredith at 2023-05-23T03:35:58+00:00 lint - - - - - 1 changed file: - compiler/GHC/StgToJS/Linker/Linker.hs Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -118,6 +118,9 @@ newtype ArchiveState = ArchiveState { loadedArchives :: IORef (Map FilePath Ar.A emptyArchiveState :: IO ArchiveState emptyArchiveState = ArchiveState <$> newIORef M.empty +defaultJsContext :: SDocContext +defaultJsContext = defaultSDocContext{sdocStyle = PprCode} + jsLinkBinary :: JSLinkConfig -> StgToJSConfig @@ -196,11 +199,11 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex unless (lcNoRts lc_cfg) $ do if csPrettyRender cfg then withFile (out "rts.js.pretty") WriteMode $ \h -> - printSDoc defaultSDocContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) + printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) else withFile (out "rts.js") WriteMode $ \h -> do bh <- newBufHandle h - bPutHDoc bh defaultSDocContext (line rtsDeclsText $$ line (rtsText cfg)) - bPutHDoc bh defaultSDocContext (line (rtsText cfg)) + bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) + bPutHDoc bh defaultJsContext (line (rtsText cfg)) bFlush bh -- link dependencies' JS files into lib.js @@ -323,10 +326,10 @@ renderLinker h render_pretty mods jsFiles = do before <- hTell h if render_pretty then do - printSDoc defaultSDocContext (Ppr.PageMode True) h (pretty x) + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) else do bh <- newBufHandle h - bPutHDoc bh defaultSDocContext (line $ pretty x) + bPutHDoc bh defaultJsContext (line $ pretty x) hPutChar h '\n' bFlush bh after <- hTell h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62341d5482fe6af3cc6316def6699de7b7a5459d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62341d5482fe6af3cc6316def6699de7b7a5459d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 03:56:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 22 May 2023 23:56:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: Revert "Change hostSupportsRPaths to report False on OpenBSD" Message-ID: <646c395fe9968_9760a96d484d81242852@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 05df5692 by Ben Gamari at 2023-05-22T23:56:09-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 110e3777 by Ben Gamari at 2023-05-22T23:56:09-04:00 codeGen: Fix some Haddocks - - - - - 5d30eb44 by Ben Gamari at 2023-05-22T23:56:09-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - dbdeefe7 by Rodrigo Mesquita at 2023-05-22T23:56:09-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - a358ad8b by Rodrigo Mesquita at 2023-05-22T23:56:09-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 241ee1ad by Rodrigo Mesquita at 2023-05-22T23:56:09-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - 5b78f09a by Rodrigo Mesquita at 2023-05-22T23:56:09-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e038f7d3 by Rodrigo Mesquita at 2023-05-22T23:56:09-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - 7a9cc05c by Rodrigo Mesquita at 2023-05-22T23:56:09-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 8b8093e9 by Simon Peyton Jones at 2023-05-22T23:56:09-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 21bd0c5d by Simon Peyton Jones at 2023-05-22T23:56:09-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c2e0594e18a4bb966197fd579c5c129945d7a53...21bd0c5d7ebabc5ee578de9ca998665bb062d44a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c2e0594e18a4bb966197fd579c5c129945d7a53...21bd0c5d7ebabc5ee578de9ca998665bb062d44a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 06:44:33 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 23 May 2023 02:44:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-supported-extensions Message-ID: <646c60d1903dd_9760a96d488981270614@gitlab.mail> Josh Meredith pushed new branch wip/js-supported-extensions at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-supported-extensions You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 07:46:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 23 May 2023 03:46:59 -0400 Subject: [Git][ghc/ghc][master] 9 commits: testsuite: Add tests for #23146 Message-ID: <646c6f73915c3_9760a96f45f4c12863bf@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs - + testsuite/tests/codeGen/should_run/T23146/T23146.hs - + testsuite/tests/codeGen/should_run/T23146/T23146.stdout - + testsuite/tests/codeGen/should_run/T23146/T23146A.hs - + testsuite/tests/codeGen/should_run/T23146/T23146_lifted.hs - + testsuite/tests/codeGen/should_run/T23146/T23146_lifted.stdout - + testsuite/tests/codeGen/should_run/T23146/T23146_liftedA.hs - + testsuite/tests/codeGen/should_run/T23146/T23146_lifted_unlifted.hs - + testsuite/tests/codeGen/should_run/T23146/T23146_lifted_unlifted.stdout - + testsuite/tests/codeGen/should_run/T23146/T23146_lifted_unliftedA.hs - + testsuite/tests/codeGen/should_run/T23146/T23146_liftedeq.hs - + testsuite/tests/codeGen/should_run/T23146/T23146_liftedeq.stdout - + testsuite/tests/codeGen/should_run/T23146/T23146_liftedeqA.hs - + testsuite/tests/codeGen/should_run/T23146/all.T Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -1387,6 +1387,7 @@ For a data constructor (such as Just or Nothing), we have: ordinary Haskell function of arity 1 that allocates a (Just x) box: Just = \x -> Just x + Just_entry: The entry code for the worker function Just_closure: The closure for this worker Nothing_closure: a statically allocated closure for Nothing ===================================== compiler/GHC/Core.hs ===================================== @@ -368,18 +368,36 @@ Note [Core letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Core letrec invariant: - The right hand sides of all - /top-level/ or /recursive/ - bindings must be of lifted type - - There is one exception to this rule, top-level @let at s are - allowed to bind primitive string literals: see - Note [Core top-level string literals]. + The right hand sides of all /top-level/ or /recursive/ + bindings must be of lifted type See "Type#type_classification" in GHC.Core.Type -for the meaning of "lifted" vs. "unlifted"). - -For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. +for the meaning of "lifted" vs. "unlifted". + +For the non-top-level, non-recursive case see +Note [Core let-can-float invariant]. + +At top level, however, there are two exceptions to this rule: + +(TL1) A top-level binding is allowed to bind primitive string literal, + (which is unlifted). See Note [Core top-level string literals]. + +(TL2) In Core, we generate a top-level binding for every non-newtype data +constructor worker or wrapper + e.g. data T = MkT Int + we generate + MkT :: Int -> T + MkT = \x. MkT x + (This binding looks recursive, but isn't; it defines a top-level, curried + function whose body just allocates and returns the data constructor.) + + But if (a) the data contructor is nullary and (b) the data type is unlifted, + this binding is unlifted. + e.g. data S :: UnliftedType where { S1 :: S, S2 :: S -> S } + we generate + S1 :: S -- A top-level unlifted binding + S1 = S1 + We allow this top-level unlifted binding to exist. Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -111,8 +111,8 @@ import Data.List( find ) import Language.Haskell.Syntax.Module.Name {- -Data constructor representation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Data constructor representation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following Haskell data type declaration data T = T !Int ![Int] @@ -141,7 +141,19 @@ becomes case e of { T a' b -> let a = I# a' in ... } To keep ourselves sane, we name the different versions of the data constructor -differently, as follows. +differently, as follows in Note [Data Constructor Naming]. + +The `dcRepType` field of a `DataCon` contains the type of the representation of +the constructor /worker/, also called the Core representation. + +The Core representation may differ from the type of the constructor /wrapper/ +(built by `mkDataConRep`). Besides unpacking (as seen in the example above), +dictionaries and coercions become explict arguments in the Core representation +of a constructor. + +Note that this representation is still *different* from runtime +representation. (Which is what STG uses after unarise). +See Note [Constructor applications in STG] in GHC.Stg.Syntax. Note [Data Constructor Naming] @@ -209,11 +221,12 @@ Note [Data constructor workers and wrappers] * See Note [Data Constructor Naming] for how the worker and wrapper are named -* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments +* The workers don't take the dcStupidTheta dicts as arguments, while the + wrappers currently do * The wrapper (if it exists) takes dcOrigArgTys as its arguments. The worker takes dataConRepArgTys as its arguments - If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys + If the wrapper is absent, dataConRepArgTys is the same as dcOrigArgTys * The 'NoDataConRep' case of DataConRep is important. Not only is it efficient, but it also ensures that the wrapper is replaced by the @@ -528,7 +541,7 @@ data DataCon -- forall a x y. (a~(x,y), x~y, Ord x) => -- x -> y -> T a -- (this is *not* of the constructor wrapper Id: - -- see Note [Data con representation] below) + -- see Note [Data constructor representation]) -- Notice that the existential type parameters come *second*. -- Reason: in a case expression we may find: -- case (e :: T t) of @@ -586,12 +599,41 @@ Function call 'dataConKindEqSpec' returns [k'~k] Note [DataCon arities] ~~~~~~~~~~~~~~~~~~~~~~ -dcSourceArity does not take constraints into account, -but dcRepArity does. For example: +A `DataCon`'s source and core representation may differ, meaning the source +arity (`dcSourceArity`) and the core representation arity (`dcRepArity`) may +differ too. + +Note that the source arity isn't exactly the number of arguments the data con +/wrapper/ has, since `dcSourceArity` doesn't count constraints -- which may +appear in the wrapper through `DatatypeContexts`, or if the constructor stores a +dictionary. In this sense, the source arity counts the number of non-constraint +arguments that appear at the source level. + On the other hand, the Core representation arity is the number of arguments +of the data constructor in its Core representation, which is also the number +of arguments of the data con /worker/. + +The arity might differ since `dcRepArity` takes into account arguments such as +quantified dictionaries and coercion arguments, lifted and unlifted (despite +the unlifted coercion arguments having a zero-width runtime representation). +For example: MkT :: Ord a => a -> T a dcSourceArity = 1 dcRepArity = 2 + MkU :: (b ~ '[]) => U b + dcSourceArity = 0 + dcRepArity = 1 + +The arity might also differ due to unpacking, for example, consider the +following datatype and its wrapper and worker's type: + data V = MkV !() !Int + $WMkV :: () -> Int -> V + MkV :: Int# -> V +As you see, because of unpacking we have both dropped the unit argument and +unboxed the Int. In this case, the source arity (which is the arity of the +wrapper) is 2, while the Core representation arity (the arity of the worker) is 1. + + Note [DataCon user type variable binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A DataCon has two different sets of type variables: @@ -959,51 +1001,6 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. -Note [Data con representation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The dcRepType field contains the type of the representation of a constructor -This may differ from the type of the constructor *Id* (built -by MkId.mkDataConId) for two reasons: - a) the constructor Id may be overloaded, but the dictionary isn't stored - e.g. data Eq a => T a = MkT a a - - b) the constructor may store an unboxed version of a strict field. - -So whenever this module talks about the representation of a data constructor -what it means is the DataCon with all Unpacking having been applied. -We can think of this as the Core representation. - -Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# -Here - T :: Ord a => Int -> a -> Void# -> T a -but the rep type is - Trep :: Int# -> a -> Void# -> T a -Actually, the unboxed part isn't implemented yet! - -Not that this representation is still *different* from runtime -representation. (Which is what STG uses after unarise). - -This is how T would end up being used in STG post-unarise: - - let x = T 1# y - in ... - case x of - T int a -> ... - -The Void# argument is dropped and the boxed int is replaced by an unboxed -one. In essence we only generate binders for runtime relevant values. - -We also flatten out unboxed tuples in this process. See the unarise -pass for details on how this is done. But as an example consider -`data S = MkS Bool (# Bool | Char #)` which when matched on would -result in an alternative with three binders like this - - MkS bool tag tpl_field -> - -See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] -for the details of this transformation. - ************************************************************************ * * @@ -1395,9 +1392,10 @@ dataConSrcBangs = dcSrcBangs dataConSourceArity :: DataCon -> Arity dataConSourceArity (MkData { dcSourceArity = arity }) = arity --- | Gives the number of actual fields in the /representation/ of the --- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries +-- | Gives the number of value arguments (including zero-width coercions) +-- stored by the given `DataCon`'s worker in its Core representation. This may +-- differ from the number of arguments that appear in the source code; see also +-- Note [DataCon arities] dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity @@ -1406,8 +1404,14 @@ dataConRepArity (MkData { dcRepArity = arity }) = arity isNullarySrcDataCon :: DataCon -> Bool isNullarySrcDataCon dc = dataConSourceArity dc == 0 --- | Return whether there are any argument types for this 'DataCon's runtime representation type --- See Note [DataCon arities] +-- | Return whether this `DataCon`'s worker, in its Core representation, takes +-- any value arguments. +-- +-- In particular, remember that we include coercion arguments in the arity of +-- the Core representation of the `DataCon` -- both lifted and unlifted +-- coercions, despite the latter having zero-width runtime representation. +-- +-- See also Note [DataCon arities]. isNullaryRepDataCon :: DataCon -> Bool isNullaryRepDataCon dc = dataConRepArity dc == 0 ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -82,7 +82,7 @@ tidyBind env (Rec prs) -- This means the code generator can get the full calling convention by only looking at the function -- itself without having to inspect the RHS. -- --- The actual logic is in tidyCbvInfo and takes: +-- The actual logic is in computeCbvInfo and takes: -- * The function id -- * The functions rhs -- And gives us back the function annotated with the marks. @@ -169,7 +169,7 @@ computeCbvInfo fun_id rhs -- seqList: avoid retaining the original rhs | otherwise - = -- pprTraceDebug "tidyCbvInfo: Worker seems to take unboxed tuple/sum types!" + = -- pprTraceDebug "computeCbvInfo: Worker seems to take unboxed tuple/sum types!" -- (ppr fun_id <+> ppr rhs) asNonWorkerLikeId fun_id ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -889,12 +889,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0 return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) | otherwise = case typePrimRepArgs ty of - [rep_ty] -> do + rep_ty :| [] -> do (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, term0 : terms1) - rep_tys -> do - (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys + rep_ty :| rep_tys -> do + (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys) (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1) ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -36,6 +36,7 @@ import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types +import GHC.StgToCmm.Closure (importedIdLFInfo) import GHC.Stg.Utils import GHC.Stg.Syntax as StgSyn @@ -270,14 +271,11 @@ isTagged v = do TagProper -> True TagTagged -> True TagTuple _ -> True -- Consider unboxed tuples tagged. - False -- Imported - | Just con <- (isDataConWorkId_maybe v) - , isNullaryRepDataCon con - -> return True - | Just lf_info <- idLFInfo_maybe v - -> return $! - -- Can we treat the thing as tagged based on it's LFInfo? - case lf_info of + -- Imported + False -> return $! + -- Determine whether it is tagged from the LFInfo of the imported id. + -- See Note [The LFInfo of Imported Ids] + case importedIdLFInfo v of -- Function, applied not entered. LFReEntrant {} -> True @@ -295,9 +293,6 @@ isTagged v = do -- Shouldn't be possible. I don't think we can export letNoEscapes -> True - | otherwise - -> return False - isArgTagged :: StgArg -> RM Bool isArgTagged (StgLitArg _) = return True ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -237,6 +237,52 @@ StgConApp and StgPrimApp --- saturated applications There are specialised forms of application, for constructors, primitives, and literals. + +Note [Constructor applications in STG] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After the unarisation pass: +* In `StgConApp` and `StgRhsCon` and `StgAlt` we filter out the void arguments, + leaving only non-void ones. +* In `StgApp` and `StgOpApp` we retain void arguments. + +We can do this because we know that `StgConApp` and `StgRhsCon` are saturated applications, +so we lose no information by dropping those void args. In contrast, in `StgApp` we need the + void argument to compare the number of args in the call with the arity of the function. + +This is an open design choice. We could instead choose to treat all these applications +consistently (keeping the void args). But for some reason we don't, and this Note simply +documents that design choice. + +As an example, consider: + + data T a = MkT !Int a Void# + +The wrapper's representation and the worker's representation (i.e. the +datacon's Core representation) are respectively: + + $WMkT :: Int -> a -> Void# -> T a + MkT :: Int# -> a -> Void# -> T a + +T would end up being used in STG post-unarise as: + + let x = MkT 1# y + in ... + case x of + MkT int a -> ... + +The Void# argument is dropped. In essence we only generate binders for runtime +relevant values. + +We also flatten out unboxed tuples in this process. See the unarise +pass for details on how this is done. But as an example consider +`data S = MkS Bool (# Bool | Char #)` which when matched on would +result in an alternative with three binders like this + + MkS bool tag tpl_field -> + +See Note [Translating unboxed sums to unboxed tuples] and Note [Unarisation] +for the details of this transformation. + -} | StgLit Literal @@ -245,7 +291,7 @@ literals. -- which can't be let-bound | StgConApp DataCon ConstructorNumber - [StgArg] -- Saturated + [StgArg] -- Saturated. See Note [Constructor applications in STG] [Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise | StgOpApp StgOp -- Primitive op or foreign call @@ -422,7 +468,7 @@ important): -- are not allocated. ConstructorNumber [StgTickish] - [StgArg] -- Args + [StgArg] -- Saturated Args. See Note [Constructor applications in STG] Type -- Type, for rewriting to an StgRhsClosure -- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that ===================================== compiler/GHC/Stg/Unarise.hs ===================================== @@ -956,6 +956,8 @@ ubxSumRubbishArg (VecSlot n e) = StgLitArg (LitRubbish TypeLike vec_rep) -------------------------------------------------------------------------------- {- +Note [Unarisation of Void binders and arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For arguments (StgArg) and binders (Id) we have two kind of unarisation: - When unarising function arg binders and arguments, we don't want to remove ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -81,8 +81,10 @@ import Data.Coerce (coerce) import Data.ByteString (ByteString) import Data.Map (Map) import Data.IntMap (IntMap) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import qualified Data.IntMap as IntMap +import qualified Data.List.NonEmpty as NE import qualified GHC.Data.FiniteMap as Map import Data.Ord import GHC.Stack.CCS @@ -296,8 +298,8 @@ argBits platform (rep : args) | isFollowableArg rep = False : argBits platform args | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args -non_void :: [ArgRep] -> [ArgRep] -non_void = filter nv +non_void :: NonEmpty ArgRep -> [ArgRep] +non_void = NE.filter nv where nv V = False nv _ = True @@ -464,7 +466,7 @@ returnUnliftedAtom d s p e = do StgLitArg lit -> typePrimRepArgs (literalType lit) StgVarArg i -> bcIdPrimReps i (push, szb) <- pushAtom d p e - ret <- returnUnliftedReps d s szb reps + ret <- returnUnliftedReps d s szb (NE.toList $! reps) return (push `appOL` ret) -- return an unlifted value from the top of the stack @@ -864,7 +866,7 @@ doCase d s p scrut bndr alts (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_ty = primRepCmmType platform - bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr) + bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps in ( wordsToBytes platform (nativeCallSize call_info) @@ -1668,9 +1670,8 @@ maybe_getCCallReturnRep fn_ty (pprType fn_ty) in case r_reps of - [] -> panic "empty typePrimRepArgs" - [VoidRep] -> Nothing - [rep] -> Just rep + VoidRep :| [] -> Nothing + rep :| [] -> Just rep -- if it was, it would be impossible to create a -- valid return value placeholder on the stack @@ -2113,7 +2114,7 @@ idSizeCon platform var isUnboxedSumType (idType var) = wordsToBytes platform . WordOff . sum . map (argRepSizeW platform . toArgRep platform) . - bcIdPrimReps $ var + NE.toList . bcIdPrimReps $ var | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var)) bcIdArgRep :: Platform -> Id -> ArgRep @@ -2121,13 +2122,13 @@ bcIdArgRep platform = toArgRep platform . bcIdPrimRep bcIdPrimRep :: Id -> PrimRep bcIdPrimRep id - | [rep] <- typePrimRepArgs (idType id) + | rep :| [] <- typePrimRepArgs (idType id) = rep | otherwise = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id)) -bcIdPrimReps :: Id -> [PrimRep] +bcIdPrimReps :: Id -> NonEmpty PrimRep bcIdPrimReps id = typePrimRepArgs (idType id) repSizeWords :: Platform -> PrimRep -> WordOff @@ -2185,8 +2186,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e) mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff] mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb) -typeArgReps :: Platform -> Type -> [ArgRep] -typeArgReps platform = map (toArgRep platform) . typePrimRepArgs +typeArgReps :: Platform -> Type -> NonEmpty ArgRep +typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs -- ----------------------------------------------------------------------------- -- The bytecode generator's monad ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -28,7 +28,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, importedIdLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -96,6 +96,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc +import GHC.Data.Maybe (isNothing) import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 @@ -255,31 +256,70 @@ mkApLFInfo id upd_flag arity (mightBeFunTy (idType id)) ------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = +-- | The 'LambdaFormInfo' of an imported Id. +-- See Note [The LFInfo of Imported Ids] +importedIdLFInfo :: Id -> LambdaFormInfo +importedIdLFInfo id = -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types case idLFInfo_maybe id of Just lf_info -> - -- Use the LambdaFormInfo from the interface + -- Use the existing LambdaFormInfo lf_info Nothing - -- Interface doesn't have a LambdaFormInfo, make a conservative one from - -- the type. - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - -> LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - + -- Doesn't have a LambdaFormInfo, but we know it must be 'LFReEntrant' from its arity | arity > 0 -> LFReEntrant TopLevel arity True ArgUnknown + -- We can't be sure of the LambdaFormInfo of this imported Id, + -- so make a conservative one from the type. | otherwise - -> mkLFArgument id -- Not sure of exact arity + -> assert (isNothing (isDataConId_maybe id)) $ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make + mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id +{- +Note [The LFInfo of Imported Ids] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As explained in Note [Conveying CAF-info and LFInfo between modules] +the LambdaFormInfo records the details of a closure representation and is +often, when optimisations are enabled, serialized to the interface of a module. + +In particular, the `lfInfo` field of the `IdInfo` field of an `Id`: +* For DataCon workers and wrappers is populated as described in +Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make +* For other Ids defined in the module being compiled: is `Nothing` +* For other imported Ids: + * is (Just lf_info) if the LFInfo was serialised into the interface file + (typically, when the exporting module was compiled with -O) + * is Nothing if it wasn't serialised + +The LambdaFormInfo we give an Id is used in determining how to tag its pointer +(see `litIdInfo` and `lfDynTag`). Therefore, it's crucial we attribute a correct +LambdaFormInfo to imported Ids, or otherwise risk having pointers incorrectly +tagged which can lead to performance issues and even segmentation faults (see +#23231 and Note [Imported unlifted nullary datacon wrappers must have correct LFInfo]). + +In particular, saturated data constructor applications *must* be unambiguously +given `LFCon`, and if the LFInfo says LFCon, then it really is a static data +constructor, and similar for LFReEntrant. + +In `importedIdLFInfo`, we construct a LambdaFormInfo for imported Ids as follows: + +(1) If the `lfInfo` field contains an LFInfo, we use that LFInfo which is +correct by construction (the invariant being that if it exists, it is correct): + (1.1) Either it was serialised to the interface we're importing the Id from, + (1.2) Or it's a DataCon worker or wrapper and its LFInfo was constructed + according to Note [LFInfo of DataCon workers and wrappers] +(2) When the `lfInfo` field is `Nothing` + (2.1) If the `idFunRepArity` of the Id is known and is greater than 0, then + the Id is unambiguously a function and is given `LFReEntrant`, and pointers + to this Id will be tagged (by `litIdInfo`) with the corresponding arity. + (2.2) Otherwise, we can make a conservative estimate from the type. + +-} + ------------- mkLFStringLit :: LambdaFormInfo mkLFStringLit = LFUnlifted ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -83,8 +83,8 @@ mkRhsInit :: Platform -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph mkRhsInit platform reg lf_info expr = mkAssign (CmmLocal reg) (addDynTag platform expr (lfDynTag platform lf_info)) +-- | Returns a 'CmmExpr' for the *tagged* pointer idInfoToAmode :: CgIdInfo -> CmmExpr --- Returns a CmmExpr for the *tagged* pointer idInfoToAmode CgIdInfo { cg_loc = CmmLoc e } = e idInfoToAmode cg_info = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc @@ -149,9 +149,9 @@ getCgIdInfo id | otherwise = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id)) in return $ - litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl) + litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl) else - cgLookupPanic id -- Bug + cgLookupPanic id -- Bug, id is neither in local binds nor is external }}} -- | Retrieve cg info for a name if it already exists. ===================================== compiler/GHC/StgToCmm/Monad.hs ===================================== @@ -188,9 +188,11 @@ type CgBindings = IdEnv CgIdInfo data CgIdInfo = CgIdInfo - { cg_id :: Id -- Id that this is the info for + { cg_id :: Id + -- ^ Id that this is the info for , cg_lf :: LambdaFormInfo - , cg_loc :: CgLoc -- CmmExpr for the *tagged* value + , cg_loc :: CgLoc + -- ^ 'CmmExpr' for the *tagged* value } instance OutputableP Platform CgIdInfo where ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -53,7 +53,7 @@ make a conservative assumption, but that is bad: e.g. #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging Conservative assumption here is made when we import an Id without a - LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported. + LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.importedIdLFInfo. So we arrange to always serialise this information into the interface file. The moving parts are: @@ -70,6 +70,66 @@ moving parts are: * We don't absolutely guarantee to serialise the CgInfo: we won't if you have -fomit-interface-pragmas or -fno-code; and we won't read it in if you have -fignore-interface-pragmas. (We could revisit this decision.) + +Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As described in `Note [Conveying CAF-info and LFInfo between modules]`, +imported unlifted nullary datacons must have their LambdaFormInfo set to +reflect the fact that they are evaluated. This is necessary as otherwise +references to them may be passed untagged to code that expects tagged +references because of the unlifted nature of the argument. + +For example, in + + type T :: UnliftedType + data T = T1 + | T2 + + f :: T -> Int + f x = case x of T1 -> 1; T2 -> 2 + +`f` expects `x` to be evaluated and properly tagged due to its unliftedness. +We can guarantee all occurrences of `T1` and `T2` are considered evaluated and +are properly tagged by giving them the `LFCon` LambdaFormInfo which indicates +they are fully saturated constructor applications. +(The LambdaFormInfo is used to tag the pointer with the tag of the +constructor, in `litIdInfo`) + +What may be less obvious is that this must be done for not only datacon +workers but also *wrappers*. The reason is found in this program +from #23146: + + module B where + + type NP :: [UnliftedType] -> UnliftedType + data NP xs where + UNil :: NP '[] + + + module A where + import B + + fieldsSam :: NP xs -> NP xs -> Bool + fieldsSam UNil UNil = True + + x = fieldsSam UNil UNil + +Due to its GADT nature, `B.UNil` produces a trivial wrapper + + $WUNil :: NP '[] + $WUNil = UNil @'[] @~() + +which is referenced in the RHS of `A.x`. If we fail to give `$WUNil` the +correct `LFCon 0` `LambdaFormInfo` then we will end up passing an untagged +pointer to `fieldsSam`. This is problematic as `fieldsSam` may take advantage +of the unlifted nature of its arguments by omitting handling of the zero +tag when scrutinising them. + +The fix is straightforward: ensure we always construct a /correct/ LFInfo for +datacon workers and wrappers, and populate the `lfInfo` with it. See +Note [LFInfo of DataCon workers and wrappers]. This fixed #23146. + +See also Note [The LFInfo of Imported Ids] -} -- | Codegen-generated Id infos, to be passed to downstream via interfaces. @@ -118,7 +178,7 @@ data LambdaFormInfo !StandardFormInfo !Bool -- True <=> *might* be a function type - | LFCon -- A saturated constructor application + | LFCon -- A saturated data constructor application !DataCon -- The constructor | LFUnknown -- Used for function arguments and imported things. ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -697,6 +697,8 @@ idCallArity id = callArityInfo (idInfo id) setIdCallArity :: Id -> Arity -> Id setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id +-- | This function counts all arguments post-unarisation, which includes +-- arguments with no runtime representation -- see Note [Unarisation and arity] idFunRepArity :: Id -> RepArity idFunRepArity x = countFunRepArgs (idArity x) (idType x) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -123,7 +123,8 @@ infixl 1 `setRuleInfo`, `setCafInfo`, `setDmdSigInfo`, `setCprSigInfo`, - `setDemandInfo` + `setDemandInfo`, + `setLFInfo` {- ************************************************************************ * * @@ -401,6 +402,12 @@ data IdInfo -- -- See documentation of the getters for what these packed fields mean. lfInfo :: !(Maybe LambdaFormInfo), + -- ^ If lfInfo = Just info, then the `info` is guaranteed /correct/. + -- If lfInfo = Nothing, then we do not have a `LambdaFormInfo` for this Id, + -- so (for imported Ids) we make a conservative version. + -- See Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure + -- For locally-defined Ids other than DataCons, the `lfInfo` field is always Nothing. + -- See also Note [LFInfo of DataCon workers and wrappers] -- See documentation of the getters for what these packed fields mean. tagSig :: !(Maybe TagSig) @@ -466,7 +473,7 @@ oneShotInfo :: IdInfo -> OneShotInfo oneShotInfo = bitfieldGetOneShotInfo . bitfield -- | 'Id' arity, as computed by "GHC.Core.Opt.Arity". Specifies how many arguments --- this 'Id' has to be applied to before it doesn any meaningful work. +-- this 'Id' has to be applied to before it does any meaningful work. arityInfo :: IdInfo -> ArityInfo arityInfo = bitfieldGetArityInfo . bitfield ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Core.DataCon import GHC.Types.Literal import GHC.Types.SourceText +import GHC.Types.RepType ( countFunRepArgs ) import GHC.Types.Name.Set import GHC.Types.Name import GHC.Types.ForeignCall @@ -87,6 +88,10 @@ import GHC.Data.FastString import GHC.Data.List.SetOps import Data.List ( zipWith4 ) +-- A bit of a shame we must import these here +import GHC.StgToCmm.Types (LambdaFormInfo(..)) +import GHC.Runtime.Heap.Layout (ArgDescr(ArgUnknown)) + {- ************************************************************************ * * @@ -595,11 +600,18 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setLFInfo` wkr_lf_info -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + -- See Note [LFInfo of DataCon workers and wrappers] + wkr_lf_info + | wkr_arity == 0 = LFCon data_con + | otherwise = LFReEntrant TopLevel (countFunRepArgs wkr_arity wkr_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + ----------- Workers for newtypes -------------- univ_tvs = dataConUnivTyVars data_con ex_tcvs = dataConExTyCoVars data_con @@ -608,6 +620,8 @@ mkDataConWorkId wkr_name data_con `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma `setUnfoldingInfo` newtype_unf + -- See W1 in Note [LFInfo of DataCon workers and wrappers] + `setLFInfo` (panic "mkDataConWorkId: we shouldn't look at LFInfo for newtype worker ids") id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) res_ty_args = mkTyCoVarTys univ_tvs newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) @@ -618,6 +632,89 @@ mkDataConWorkId wkr_name data_con wrapNewTypeBody tycon res_ty_args (Var id_arg1) {- +Note [LFInfo of DataCon workers and wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As noted in Note [The LFInfo of Imported Ids] in GHC.StgToCmm.Closure, it's +crucial that saturated data con applications are given an LFInfo of `LFCon`. + +Since for data constructors we never serialise the worker and the wrapper (only +the data type declaration), we never serialise their lambda form info either. + +Therefore, when making data constructors workers and wrappers, we construct a +correct `LFInfo` for them right away, and put it it in the `lfInfo` field of the +worker/wrapper Id, ensuring that: + + The `lfInfo` field of a DataCon worker or wrapper is always populated with the correct LFInfo. + +How do we construct a /correct/ LFInfo for workers and wrappers? +(Remember: `LFCon` means "a saturated constructor application") + +(1) Data constructor workers and wrappers with arity > 0 are unambiguously +functions and should be given `LFReEntrant`, regardless of the runtime +relevance of the arguments. + - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, + and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + +(2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes +no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + +(3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. +A datacon /wrapper/ with zero arity must be a fully saturated application of +the worker to zero-width arguments only (which are dropped after unarisation), +and therefore is also given `LFCon`. + +For example, consider the following data constructors: + + data T1 a where + TCon1 :: {-# UNPACK #-} !(a :~: True) -> T1 a + + data T2 a where + TCon2 :: {-# UNPACK #-} !() -> T2 a + + data T3 a where + TCon3 :: T3 '[] + +`TCon1`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has an unlifted equality argument, which is zero-width. + +`TCon2`'s wrapper has a lifted argument, which is non-zero-width, while the +worker has no arguments. + +Wrinkle (W1). Perhaps surprisingly, it is possible for the /wrapper/ to be an +`LFCon` even though the /worker/ is not. Consider `T3` above. Here is the +Core representation of the worker and wrapper: + + $WTCon3 :: T3 '[] -- Wrapper + $WTCon3 = TCon3 @[] -- A saturated constructor application: LFCon + + TCon3 :: forall (a :: * -> *). (a ~# []) => T a -- Worker + TCon3 = /\a. \(co :: a~#[]). TCon3 co -- A function: LFReEntrant + +For `TCon1`, both the wrapper and worker will be given `LFReEntrant` since they +both have arity == 1. + +For `TCon2`, the wrapper will be given `LFReEntrant` since it has arity == 1 +while the worker is `LFCon` since its arity == 0 + +For `TCon3`, the wrapper will be given `LFCon` since its arity == 0 and the +worker `LFReEntrant` since its arity == 1 + +One might think we could give *workers* with only zero-width-args the `LFCon` +LambdaFormInfo, e.g. give `LFCon` to the worker of `TCon1` and `TCon3`. +However, these workers are unambiguously functions +-- which makes `LFReEntrant`, the LambdaFormInfo we give them, correct. +See also the discussion in #23158. + +Wrinkles: + +(W1) Why do we panic when generating `LFInfo` for newtype workers and wrappers? + + We don't generate code for newtype workers/wrappers, so we should never have to + look at their LFInfo (and in general we can't; they may be representation-polymorphic). + +See also the Note [Imported unlifted nullary datacon wrappers must have correct LFInfo] +in GHC.StgToCmm.Types. + ------------------------------------------------- -- Data constructor representation -- @@ -709,11 +806,20 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + `setLFInfo` wrap_lf_info -- The signature is purely for passes like the Simplifier, not for -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv + -- See Note [LFInfo of DataCon workers and wrappers] + wrap_lf_info + | wrap_arity == 0 = LFCon data_con + -- See W1 in Note [LFInfo of DataCon workers and wrappers] + | isNewTyCon tycon = panic "mkDataConRep: we shouldn't look at LFInfo for newtype wrapper ids" + | otherwise = LFReEntrant TopLevel (countFunRepArgs wrap_arity wrap_ty) True ArgUnknown + -- LFInfo stores post-unarisation arity + wrap_arg_dmds = replicate (length theta) topDmd ++ map mk_dmd arg_ibangs -- Don't forget the dictionary arguments when building ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -84,12 +84,11 @@ isNvUnaryType ty = False -- INVARIANT: the result list is never empty. -typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep] +typePrimRepArgs :: HasDebugCallStack => Type -> NonEmpty PrimRep typePrimRepArgs ty - | [] <- reps - = [VoidRep] - | otherwise - = reps + = case reps of + [] -> VoidRep :| [] + (x:xs) -> x :| xs where reps = typePrimRep ty @@ -124,6 +123,10 @@ unwrapType ty | otherwise = NS_Done +-- | Count the arity of a function post-unarisation, including zero-width arguments. +-- +-- The post-unarisation arity may be larger than the arity of the original +-- function type. See Note [Unarisation]. countFunRepArgs :: Arity -> Type -> RepArity countFunRepArgs 0 _ = 0 ===================================== testsuite/tests/codeGen/should_run/T23146/T23146.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} + +import T23146A + +fieldsSam :: NP xs -> NP xs -> Bool +fieldsSam (x' ::* xs) (y' ::* ys) = fieldsSam xs ys +fieldsSam UNil UNil = True + +main :: IO () +main = print (fieldsSam UNil UNil) + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146.stdout ===================================== @@ -0,0 +1,2 @@ +True + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146A.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE UnliftedDatatypes #-} +module T23146A where + +import GHC.Exts + +type NP :: [UnliftedType] -> UnliftedType +data NP xs where + UNil :: NP '[] + (::*) :: x -> NP xs -> NP (x ': xs) + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_lifted.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} + +import T23146_liftedA + +fieldsSam :: NP xs -> NP xs -> Bool +fieldsSam (x' ::* xs) (y' ::* ys) = fieldsSam xs ys +fieldsSam UNil UNil = True + +main :: IO () +main = print (fieldsSam UNil UNil) + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_lifted.stdout ===================================== @@ -0,0 +1,2 @@ +True + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_liftedA.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} + +module T23146_liftedA where + +data NP xs where + UNil :: NP '[] + (::*) :: x -> NP xs -> NP (x ': xs) + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_lifted_unlifted.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs, DataKinds #-} + +import T23146_lifted_unliftedA + +import Data.Type.Equality + +fieldsSam :: NP True -> NP True -> Bool +fieldsSam (x' ::* xs) (y' ::* ys) = fieldsSam xs ys +fieldsSam (UNil Refl) (UNil Refl) = True + +main :: IO () +main = print (fieldsSam (UNil Refl) (UNil Refl)) + + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_lifted_unlifted.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_lifted_unliftedA.hs ===================================== @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -O1 #-} +{-# LANGUAGE DataKinds #-} + +module T23146_lifted_unliftedA where + +import Data.Kind +import Data.Type.Equality + +data NP a where + UNil :: {-# UNPACK #-} !(a :~: True) -> NP a + (::*) :: Bool -> NP True -> NP True + + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_liftedeq.hs ===================================== @@ -0,0 +1,7 @@ +import T23146_liftedeqA + +fieldsSam :: NP xs -> NP xs -> Bool +fieldsSam UNil UNil = True + +main = print (fieldsSam UNil UNil) + ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_liftedeq.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/codeGen/should_run/T23146/T23146_liftedeqA.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE UnliftedDatatypes #-} + +module T23146_liftedeqA where + +import GHC.Exts + +type NP :: [UnliftedType] -> UnliftedType +data NP xs where + UNil :: NP '[] + (::*) :: x -> NP xs -> NP (x ': xs) + ===================================== testsuite/tests/codeGen/should_run/T23146/all.T ===================================== @@ -0,0 +1,4 @@ +test('T23146', normal, compile_and_run, ['']) +test('T23146_lifted', normal, compile_and_run, ['']) +test('T23146_liftedeq', normal, compile_and_run, ['']) +test('T23146_lifted_unlifted', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9db0eadd05da2f807b9a5fdcdec50ba1feedde15...b8fe6a0c044831ae90b0e7a5064300c28075b63c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9db0eadd05da2f807b9a5fdcdec50ba1feedde15...b8fe6a0c044831ae90b0e7a5064300c28075b63c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 07:47:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 23 May 2023 03:47:24 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Add the SolverStage monad Message-ID: <646c6f8c4203e_9760a96f45f38129337f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 23 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Rule.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8fe6a0c044831ae90b0e7a5064300c28075b63c...6abf36483a41e50579afcea1497f502875693913 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8fe6a0c044831ae90b0e7a5064300c28075b63c...6abf36483a41e50579afcea1497f502875693913 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 09:26:40 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 23 May 2023 05:26:40 -0400 Subject: [Git][ghc/ghc][wip/js-supported-extensions] lint Message-ID: <646c86d010fa2_9760a9f397548132686e@gitlab.mail> Josh Meredith pushed to branch wip/js-supported-extensions at Glasgow Haskell Compiler / GHC Commits: b713b4ca by Josh Meredith at 2023-05-23T09:26:17+00:00 lint - - - - - 1 changed file: - testsuite/tests/th/TH_foreignCallingConventions.hs Changes: ===================================== testsuite/tests/th/TH_foreignCallingConventions.hs ===================================== @@ -1,6 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface, CApiFFI, GHCForeignImportPrim, QuasiQuotes, TemplateHaskell, JavaScriptFFI, MagicHash, - UnliftedFFITypes #-} + UnliftedFFITypes, CPP #-} module TH_foreignCallingConventions where @@ -17,8 +17,13 @@ $( do let fi cconv safety lbl name ty = -- the declarations below would result in warnings or errors when returned dec3 <- fi CApi Unsafe "baz" (mkName "baz") <$> [t| Double -> IO () |] dec4 <- fi StdCall Safe "bay" (mkName "bay") <$> [t| (Int -> Bool) -> IO Int |] +#if defined(javascript_HOST_ARCH) dec5 <- fi JavaScript Unsafe "bax" (mkName "bax") <$> [t| Ptr Int -> IO String |] runIO $ mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4, dec5] >> hFlush stdout +#else + runIO $ + mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4] >> hFlush stdout +#endif return [dec1, dec2] ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b713b4ca4ac23da585064d55fb3801ae11517ae0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b713b4ca4ac23da585064d55fb3801ae11517ae0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 10:08:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 06:08:42 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646c90aa926c0_9760a9f7c9724133238d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 9b158cea by Rodrigo Mesquita at 2023-05-23T11:08:25+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,44 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- rOMES:TODO: potential causes of bug: + -- not using runSomethingResponseFile + -- ~~not passing userOptC~~ (trying...) + -- not filtering clobbering warnings + run_some_cpp logger dflags "C pre-processor" pgm_cpp (getOpts dflags opt_c ++ args) + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,16 +1,16 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -58,11 +58,11 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -97,3 +97,61 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor for files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + CPP_CMD="$withval" + fi +], +[ + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" +] +) + +AC_ARG_WITH(cpp-flags, + [AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + # Use whatever was set plus CPP_ARGS (which will be -E if CPP_CMD was + # not specified) + CPP_ARGS="$CPP_ARGS $withval" + fi + ], + [ + # We don't add any additional CPP flags. If the CPP_CMD was + # set to CC then CPP_ARGS is already set to -E above. + ]) + + $2="$CPP_CMD" + $3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b158ceaa5a603af9294b38a99bc01a9e9e71b78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b158ceaa5a603af9294b38a99bc01a9e9e71b78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 10:12:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 06:12:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/fixes Message-ID: <646c9181e6e68_9760a9f7c972413351aa@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/fixes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/fixes You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 10:21:46 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 06:21:46 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646c93bae2785_9760a9f7c97241340838@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 1b327cee by Rodrigo Mesquita at 2023-05-23T11:21:33+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,16 +1,16 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -58,11 +58,11 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -97,3 +97,61 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor for files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + CPP_CMD="$withval" + fi +], +[ + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" +] +) + +AC_ARG_WITH(cpp-flags, + [AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + # Use whatever was set plus CPP_ARGS (which will be -E if CPP_CMD was + # not specified) + CPP_ARGS="$CPP_ARGS $withval" + fi + ], + [ + # We don't add any additional CPP flags. If the CPP_CMD was + # set to CC then CPP_ARGS is already set to -E above. + ]) + + $2="$CPP_CMD" + $3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b327ceed593d3d086dd94b967c6ea94d45142ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b327ceed593d3d086dd94b967c6ea94d45142ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 10:29:32 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 06:29:32 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 35 commits: Configure CPP into settings Message-ID: <646c958c9bac0_9760a9fbf318813444a2@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 1b327cee by Rodrigo Mesquita at 2023-05-23T11:21:33+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - ba15bc0a by Ben Gamari at 2023-05-23T11:28:57+01:00 ghc-toolchain: Initial commit - - - - - 84a51145 by Ben Gamari at 2023-05-23T11:28:57+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 0651874e by Ben Gamari at 2023-05-23T11:28:57+01:00 Move via-C flags into GHC - - - - - c3c2d7f6 by Ben Gamari at 2023-05-23T11:28:57+01:00 Rip out runtime linker/compiler checks - - - - - b622aedb by Ben Gamari at 2023-05-23T11:28:57+01:00 configure: Rip out toolchain selection logic - - - - - 50a68b98 by Ben Gamari at 2023-05-23T11:28:57+01:00 Fixes - - - - - 42322e5f by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - f134aa72 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Re-introduce ld-override option - - - - - 6da145d1 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ROMES:WIP - - - - - 205bdeb2 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 985c3b85 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ROMES: WIP - - - - - 9df2544e by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Re-introduce flags in hadrian config - - - - - 6cef8a16 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ROMES WIP - - - - - 37874c85 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 56555815 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - fd7b41df by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Rip more of configure that is no longer being used - - - - - dba2aadc by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - 984b1bce by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Rip out more from hadrians system.config.in - - - - - c29c198e by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Configure CLink supports response files - - - - - bec1b014 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Read deleted keys from host and target's target - - - - - f705de7f by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ROMES: WIP 3 - - - - - d5dcd6a1 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 567a9c49 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - e06326d1 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Handle unspecified vs specified flags and commands better - - - - - 0f078251 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ROMES: WIP 4 - - - - - dae1640f by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Configure Cpp and HsCpp separately - - - - - 337dd695 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Fixes for compilation - - - - - fd5372c6 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Link is GNU linkerg - - - - - cc10dc18 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 ROMES: WIP 5 - - - - - 20b2af0b by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 9664da97 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 71802cd3 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 helper AC function for enable/disable - - - - - 3e067f48 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Delete unused imports of SysTools.Info - - - - - 3a81dbd9 by Rodrigo Mesquita at 2023-05-23T11:28:57+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8196df064f0427fbbfb23e5bbeb1214c3a493613...3a81dbd9113a21d65b0b2a837effbc5b8a0fb476 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8196df064f0427fbbfb23e5bbeb1214c3a493613...3a81dbd9113a21d65b0b2a837effbc5b8a0fb476 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 10:29:58 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 23 May 2023 06:29:58 -0400 Subject: [Git][ghc/ghc][wip/T23025] linear lint: Add missing processing of DEFAULT Message-ID: <646c95a6d7a60_9760a9f397548134494d@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23025 at Glasgow Haskell Compiler / GHC Commits: b8641ffb by Krzysztof Gogolewski at 2023-05-23T12:29:30+02:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - 6 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Tc/Gen/Expr.hs - + testsuite/tests/linear/should_compile/LinearRecUpd.hs - + testsuite/tests/linear/should_compile/T23025.hs - testsuite/tests/linear/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1194,13 +1194,13 @@ checkCanEtaExpand _ _ _ checkLinearity :: UsageEnv -> Var -> LintM UsageEnv checkLinearity body_ue lam_var = case varMultMaybe lam_var of - Just mult -> do ensureSubUsage lhs mult (err_msg mult) - return $ deleteUE body_ue lam_var + Just mult -> do + let (lhs, body_ue') = popUE body_ue lam_var + err_msg = text "Linearity failure in lambda:" <+> ppr lam_var + $$ ppr lhs <+> text "⊈" <+> ppr mult + ensureSubUsage lhs mult err_msg + return body_ue' Nothing -> return body_ue -- A type variable - where - lhs = lookupUE body_ue lam_var - err_msg mult = text "Linearity failure in lambda:" <+> ppr lam_var - $$ ppr lhs <+> text "⊈" <+> ppr mult {- Note [Join points and casts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1551,17 +1551,24 @@ lintCoreAlt :: Var -- Case binder -> LintM UsageEnv -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintCoreAlt _ _ _ alt_ty (Alt DEFAULT args rhs) = +lintCoreAlt case_bndr _ scrut_mult alt_ty (Alt DEFAULT args rhs) = do { lintL (null args) (mkDefaultArgsMsg args) - ; lintAltExpr rhs alt_ty } - -lintCoreAlt _case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) + ; rhs_ue <- lintAltExpr rhs alt_ty + ; let (case_bndr_usage, rhs_ue') = popUE rhs_ue case_bndr + err_msg = text "Linearity failure in the DEFAULT clause:" <+> ppr case_bndr + $$ ppr case_bndr_usage <+> text "⊈" <+> ppr scrut_mult + ; ensureSubUsage case_bndr_usage scrut_mult err_msg + ; return rhs_ue' } + +lintCoreAlt case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) | litIsLifted lit = failWithL integerScrutinisedMsg | otherwise = do { lintL (null args) (mkDefaultArgsMsg args) ; ensureEqTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty) - ; lintAltExpr rhs alt_ty } + ; rhs_ue <- lintAltExpr rhs alt_ty + ; return (deleteUE rhs_ue case_bndr) -- No need for linearity checks + } where lit_ty = literalType lit @@ -3184,9 +3191,14 @@ inCasePat = LintM $ \ env errs -> fromBoxedLResult (Just (is_case_pat env), errs addInScopeId :: Id -> LintedType -> LintM a -> LintM a addInScopeId id linted_ty m - = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set, le_ue_aliases = aliases }) errs -> unLintM m (env { le_ids = extendVarEnv id_set id (id, linted_ty) - , le_joins = add_joins join_set }) errs + , le_joins = add_joins join_set + , le_ue_aliases = delFromNameEnv aliases (idName id) }) errs + -- When shadowing an alias, we need to make sure the Id is no longer + -- classified as such. E.g. in + -- let x = in case x of x { _DEFAULT -> } + -- Occurrences of 'x' in e2 shouldn't count as occurrences of e1. where add_joins join_set | isJoinId id = extendVarSet join_set id -- Overwrite with new arity ===================================== compiler/GHC/Core/UsageEnv.hs ===================================== @@ -6,6 +6,7 @@ module GHC.Core.UsageEnv , bottomUE , deleteUE , lookupUE + , popUE , scaleUE , scaleUsage , supUE @@ -104,5 +105,8 @@ lookupUE (UsageEnv e has_bottom) x = Just w -> MUsage w Nothing -> if has_bottom then Bottom else Zero +popUE :: NamedThing n => UsageEnv -> n -> (Usage, UsageEnv) +popUE ue x = (lookupUE ue x, deleteUE ue x) + instance Outputable UsageEnv where ppr (UsageEnv ne b) = text "UsageEnv:" <+> ppr ne <+> ppr b ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1175,7 +1175,7 @@ desugarRecordUpd record_expr possible_parents rbnds res_ty -- e.g. (x', e1), (y', e2), ... ; let mk_upd_id :: Name -> LHsFieldBind GhcTc fld (LHsExpr GhcRn) -> TcM (Name, (TcId, LHsExpr GhcRn)) mk_upd_id fld_nm (L _ rbind) - = do { let Scaled m arg_ty = lookupNameEnv_NF arg_ty_env fld_nm + = do { let Scaled _ arg_ty = lookupNameEnv_NF arg_ty_env fld_nm nm_occ = rdrNameOcc . nameRdrName $ fld_nm actual_arg_ty = substTy subst arg_ty rhs = hfbRHS rbind @@ -1186,11 +1186,17 @@ desugarRecordUpd record_expr possible_parents rbnds res_ty -- (As we will typecheck the let-bindings later, we can drop this coercion here.) -- See RepPolyRecordUpdate test. ; nm <- newNameAt nm_occ generatedSrcSpan - ; let id = mkLocalId nm m actual_arg_ty + ; let id = mkLocalId nm ManyTy actual_arg_ty -- NB: create fresh names to avoid any accidental shadowing -- occurring in the RHS expressions when creating the let bindings: -- -- let x1 = e1; x2 = e2; ... + -- + -- Above, we use multiplicity Many rather than the one associated to arg_ty. + -- Normally, there shouldn't be a difference, since it's a let binding. + -- But -XStrict can convert the let to a case, and this causes issues + -- in test LinearRecUpd. Since we don't support linear record updates, + -- using Many is simple and safe. ; return (fld_nm, (id, rhs)) } arg_ty_env = mkNameEnv ===================================== testsuite/tests/linear/should_compile/LinearRecUpd.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE Strict #-} +module LinearRecUpd where + +nextM :: Env -> Env +nextM e = e{dfsE=0} + +data Env = Env {dfsE :: Int} ===================================== testsuite/tests/linear/should_compile/T23025.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE LinearTypes, BangPatterns #-} +module T23025 where + +import Data.Void + +f :: a %1 -> a +f !x = x + +g :: Void %m -> Maybe () +g a = Just (case a of {}) ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -40,3 +40,5 @@ test('T18731', normal, compile, ['']) test('T19400', unless(compiler_debugged(), skip), compile, ['']) test('T20023', normal, compile, ['']) test('T22546', normal, compile, ['']) +test('T23025', normal, compile, ['-dlinear-core-lint']) +test('LinearRecUpd', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8641ffbda26198c73618c8cd0dd64be189a8ae4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8641ffbda26198c73618c8cd0dd64be189a8ae4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 10:37:20 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 06:37:20 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646c9760e0bc5_9760a9f1a97f41349147@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 375404a1 by Rodrigo Mesquita at 2023-05-23T11:37:08+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,16 +1,16 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -58,11 +58,11 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -97,3 +97,61 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor for files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + CPP_CMD="$withval" + fi +], +[ + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" +] +) + +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + # Use whatever was set plus CPP_ARGS (which will be -E if CPP_CMD was + # not specified) + CPP_ARGS="$CPP_ARGS $withval" + fi +], +[ + # We don't add any additional CPP flags. If the CPP_CMD was + # set to CC then CPP_ARGS is already set to -E above. +]) + +$2="$CPP_CMD" +$3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/375404a15a83f7855394f263da9b555fe6d2213a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/375404a15a83f7855394f263da9b555fe6d2213a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 11:01:52 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 23 May 2023 07:01:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/i386-zonker Message-ID: <646c9d206ea17_9760a9eff3bd01357115@gitlab.mail> Matthew Pickering pushed new branch wip/i386-zonker at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/i386-zonker You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 13:06:08 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 09:06:08 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646cba40557c7_9760a9f1a97f413651f1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: d73853df by Rodrigo Mesquita at 2023-05-23T14:05:53+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,16 +1,16 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -58,11 +58,11 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -97,3 +97,60 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + CPP_CMD="$withval" + fi +], +[ + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" +] +) + +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + # Use whatever was set plus CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" + fi +], +[ + # We don't add any additional CPP flags. If the CPP_CMD was + # set to CC then CPP_ARGS is already set to -E above. +]) + +$2="$CPP_CMD" +$3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d73853df93e73281871848c980f573df60102a90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d73853df93e73281871848c980f573df60102a90 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 13:17:45 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 09:17:45 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646cbcf9efe69_9760a9fbf318813657a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: ecf26113 by Rodrigo Mesquita at 2023-05-23T14:17:31+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,16 +1,16 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -58,11 +58,11 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -97,3 +97,61 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + CPP_CMD="$withval" + fi +], +[ + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" +] +) + +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + # Use whatever was set plus CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" + fi +], +[ + # We don't add any additional CPP flags. If the CPP_CMD was + # set to CC then CPP_ARGS is already set to -E above. + true +]) + +$2="$CPP_CMD" +$3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecf261136b43878709c107c673449bc918247fba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecf261136b43878709c107c673449bc918247fba You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 13:18:23 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 09:18:23 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 35 commits: Configure CPP into settings Message-ID: <646cbd1f33bca_9760a9f1a97f41366145@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: ecf26113 by Rodrigo Mesquita at 2023-05-23T14:17:31+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 49fc40ba by Ben Gamari at 2023-05-23T14:18:01+01:00 ghc-toolchain: Initial commit - - - - - d009e6db by Ben Gamari at 2023-05-23T14:18:01+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 0707edf2 by Ben Gamari at 2023-05-23T14:18:01+01:00 Move via-C flags into GHC - - - - - 6e82ecc8 by Ben Gamari at 2023-05-23T14:18:01+01:00 Rip out runtime linker/compiler checks - - - - - 6b2ee26f by Ben Gamari at 2023-05-23T14:18:01+01:00 configure: Rip out toolchain selection logic - - - - - 5ba6f79f by Ben Gamari at 2023-05-23T14:18:01+01:00 Fixes - - - - - 36314304 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - ca53a862 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Re-introduce ld-override option - - - - - 1cdc2df3 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 ROMES:WIP - - - - - 625b3541 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 7fb4387d by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 ROMES: WIP - - - - - a84fe1e0 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Re-introduce flags in hadrian config - - - - - cffbd322 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 ROMES WIP - - - - - 8a86f218 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 49bd3fc3 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - afbd6e3a by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Rip more of configure that is no longer being used - - - - - 9a62f644 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - 108069be by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Rip out more from hadrians system.config.in - - - - - 09c8920d by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Configure CLink supports response files - - - - - 50d23648 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Read deleted keys from host and target's target - - - - - 8891d403 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 ROMES: WIP 3 - - - - - 5ce26f08 by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 4104868a by Rodrigo Mesquita at 2023-05-23T14:18:01+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - 3d9f2bc8 by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 Handle unspecified vs specified flags and commands better - - - - - 5157dd78 by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 ROMES: WIP 4 - - - - - 6dbce8ad by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 Configure Cpp and HsCpp separately - - - - - 6a70f1dd by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 Fixes for compilation - - - - - 5dc15cc9 by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 Link is GNU linkerg - - - - - a6c7dcfd by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 ROMES: WIP 5 - - - - - 58ef1ebe by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - b411b5e7 by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 9bbc3c25 by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 helper AC function for enable/disable - - - - - 4c6c0d4c by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 Delete unused imports of SysTools.Info - - - - - 87e47f34 by Rodrigo Mesquita at 2023-05-23T14:18:02+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a81dbd9113a21d65b0b2a837effbc5b8a0fb476...87e47f34b1a316abaac17cf27b944a08cbd020a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a81dbd9113a21d65b0b2a837effbc5b8a0fb476...87e47f34b1a316abaac17cf27b944a08cbd020a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 13:41:09 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 23 May 2023 09:41:09 -0400 Subject: [Git][ghc/ghc][wip/js-supported-extensions] lint Message-ID: <646cc2755e79_9760a9f1a97f4137514b@gitlab.mail> Josh Meredith pushed to branch wip/js-supported-extensions at Glasgow Haskell Compiler / GHC Commits: 353821ed by Josh Meredith at 2023-05-23T13:40:52+00:00 lint - - - - - 1 changed file: - testsuite/tests/th/TH_foreignCallingConventions.hs Changes: ===================================== testsuite/tests/th/TH_foreignCallingConventions.hs ===================================== @@ -1,6 +1,9 @@ {-# LANGUAGE ForeignFunctionInterface, CApiFFI, GHCForeignImportPrim, - QuasiQuotes, TemplateHaskell, JavaScriptFFI, MagicHash, + QuasiQuotes, TemplateHaskell, MagicHash, UnliftedFFITypes, CPP #-} +#if defined(javascript_HOST_ARCH) +{-# LANGUAGE JavaScriptFFI #-} +#endif module TH_foreignCallingConventions where @@ -17,13 +20,8 @@ $( do let fi cconv safety lbl name ty = -- the declarations below would result in warnings or errors when returned dec3 <- fi CApi Unsafe "baz" (mkName "baz") <$> [t| Double -> IO () |] dec4 <- fi StdCall Safe "bay" (mkName "bay") <$> [t| (Int -> Bool) -> IO Int |] -#if defined(javascript_HOST_ARCH) dec5 <- fi JavaScript Unsafe "bax" (mkName "bax") <$> [t| Ptr Int -> IO String |] runIO $ mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4, dec5] >> hFlush stdout -#else - runIO $ - mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4] >> hFlush stdout -#endif return [dec1, dec2] ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/353821eddf724fc117f15ef691ab38ecb6d351c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/353821eddf724fc117f15ef691ab38ecb6d351c5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 13:54:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 09:54:49 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646cc5a99812b_9760a9f97d23c1384363@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 79830718 by Rodrigo Mesquita at 2023-05-23T14:54:36+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 17 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,10 +466,18 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -1230,6 +1238,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,16 +1,16 @@ -# FP_CPP_CMD_WITH_ARGS() +# FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# sets HS CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments -AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? dnl -------------------------------------------------------------- AC_ARG_WITH(hs-cpp, [AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -58,11 +58,11 @@ AC_ARG_WITH(hs-cpp, ] ) -dnl ** what cpp flags to use? +dnl ** what hs-cpp flags to use? dnl ----------------------------------------------------------- AC_ARG_WITH(hs-cpp-flags, [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], [ if test "$HostOS" = "mingw32" then @@ -97,3 +97,61 @@ $2=$HS_CPP_ARGS ]) +# FP_CPP_CMD_WITH_ARGS() +# ---------------------- +# sets CPP command and its arguments +# +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. +AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + CPP_CMD="$withval" + fi +], +[ + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD=$1 + CPP_ARGS="-E" +] +) + +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + # Use whatever was set plus CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" + fi +], +[ + # We don't add any additional CPP flags. If the CPP_CMD was + # set to CC then CPP_ARGS is already set to -E above. + true +]) + +$2="$CPP_CMD" +$3="$CPP_ARGS" + +]) + ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/798307186eeaff9eeaaeb694c288931eac229341 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/798307186eeaff9eeaaeb694c288931eac229341 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 14:54:52 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 23 May 2023 10:54:52 -0400 Subject: [Git][ghc/ghc][wip/js-supported-extensions] Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <646cd3bc2b056_9760a9f7c972414285aa@gitlab.mail> Josh Meredith pushed to branch wip/js-supported-extensions at Glasgow Haskell Compiler / GHC Commits: bae24c5f by Josh Meredith at 2023-05-23T14:54:33+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - 3 changed files: - compiler/GHC/Driver/Session.hs - testsuite/tests/th/TH_foreignCallingConventions.hs - testsuite/tests/th/TH_foreignCallingConventions.stderr Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2520,7 +2520,7 @@ supportedLanguageOverlays :: [String] supportedLanguageOverlays = map (flagSpecName . snd) safeHaskellFlagsDeps supportedExtensions :: ArchOS -> [String] -supportedExtensions (ArchOS _ os) = concatMap toFlagSpecNamePair xFlags +supportedExtensions (ArchOS arch os) = concatMap toFlagSpecNamePair xFlags where toFlagSpecNamePair flg -- IMPORTANT! Make sure that `ghc --supported-extensions` omits @@ -2529,9 +2529,12 @@ supportedExtensions (ArchOS _ os) = concatMap toFlagSpecNamePair xFlags -- the rationale | isAIX, flagSpecFlag flg == LangExt.TemplateHaskell = [noName] | isAIX, flagSpecFlag flg == LangExt.QuasiQuotes = [noName] + -- "JavaScriptFFI" is only supported on the JavaScript backend + | notJS, flagSpecFlag flg == LangExt.JavaScriptFFI = [noName] | otherwise = [name, noName] where isAIX = os == OSAIX + notJS = arch /= ArchJavaScript noName = "No" ++ name name = flagSpecName flg ===================================== testsuite/tests/th/TH_foreignCallingConventions.hs ===================================== @@ -1,6 +1,9 @@ {-# LANGUAGE ForeignFunctionInterface, CApiFFI, GHCForeignImportPrim, - QuasiQuotes, TemplateHaskell, JavaScriptFFI, MagicHash, - UnliftedFFITypes #-} + QuasiQuotes, TemplateHaskell, MagicHash, + UnliftedFFITypes, CPP #-} +#if defined(javascript_HOST_ARCH) +{-# LANGUAGE JavaScriptFFI #-} +#endif module TH_foreignCallingConventions where ===================================== testsuite/tests/th/TH_foreignCallingConventions.stderr ===================================== @@ -8,7 +8,7 @@ foreign import stdcall safe "bay" bay :: (GHC.Types.Int -> GHC.Types.IO GHC.Types.Int foreign import javascript unsafe "bax" bax :: GHC.Ptr.Ptr GHC.Types.Int -> GHC.Types.IO GHC.Base.String -TH_foreignCallingConventions.hs:(13,2)-(24,2): Splicing declarations +TH_foreignCallingConventions.hs:(16,2)-(27,2): Splicing declarations do let fi cconv safety lbl name ty = ForeignD (ImportF cconv safety lbl name ty) dec1 <- fi CCall Interruptible "&" (mkName "foo") <$> [t| Ptr () |] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bae24c5f0235482ab50cdad2bbabe6aa94352edf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bae24c5f0235482ab50cdad2bbabe6aa94352edf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 15:08:23 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 23 May 2023 11:08:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/testsuite-stack-size Message-ID: <646cd6e771486_9760a9f7c97c414405ab@gitlab.mail> Matthew Pickering pushed new branch wip/testsuite-stack-size at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/testsuite-stack-size You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 15:12:11 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 23 May 2023 11:12:11 -0400 Subject: [Git][ghc/ghc][wip/testsuite-stack-size] testsuite: Pass -ki128k -kc128k for performance tests Message-ID: <646cd7cb32f60_9760a9fbf31881442498@gitlab.mail> Matthew Pickering pushed to branch wip/testsuite-stack-size at Glasgow Haskell Compiler / GHC Commits: afd1cfeb by Matthew Pickering at 2023-05-23T16:11:57+01:00 testsuite: Pass -ki128k -kc128k for performance tests Setting a larger stack (chunk size/ initial) gives a greater protection from stack underflow (which allocates more stack chunks). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. Fixes #23439 - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -1791,7 +1791,11 @@ async def simple_build(name: Union[TestName, str], stats_file = name + '.comp.stats' if isCompilerStatsTest(): - extra_hc_opts += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' + # Set a bigger chunk size to reduce variation due to additional under/overflowing + # The tests are attempting to test how much work the compiler is doing by proxy of + # bytes allocated. The additional allocations caused by stack overflow can cause + # spurious failures if you trip over the limit (see #23439) + extra_hc_opts += ' +RTS -ki128k -kc128k -V0 -t' + stats_file + ' --machine-readable -RTS' if backpack: extra_hc_opts += ' -outputdir ' + name + '.out' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afd1cfeb6985f299b55124292c027d6f79c2e559 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afd1cfeb6985f299b55124292c027d6f79c2e559 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 16:05:58 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 23 May 2023 12:05:58 -0400 Subject: [Git][ghc/ghc][wip/js-hline] JS: Convert rendering to use HLine instead of SDoc Message-ID: <646ce46646482_9760a9f97d23c14776ba@gitlab.mail> Josh Meredith pushed to branch wip/js-hline at Glasgow Haskell Compiler / GHC Commits: cbbbe272 by Josh Meredith at 2023-05-23T16:05:26+00:00 JS: Convert rendering to use HLine instead of SDoc - - - - - 10 changed files: - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs Changes: ===================================== compiler/GHC/Driver/Config/StgToJS.hs ===================================== @@ -20,6 +20,7 @@ initStgToJSConfig dflags = StgToJSConfig , csInlineLoadRegs = False , csInlineEnter = False , csInlineAlloc = False + , csPrettyRender = gopt Opt_DisableJsMinifier dflags , csTraceRts = False , csAssertRts = False , csBoundsCheck = gopt Opt_DoBoundsChecking dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -314,6 +314,9 @@ data GeneralFlag | Opt_WriteInterface -- forces .hi files to be written even with -fno-code | Opt_WriteHie -- generate .hie files + -- JavaScript opts + | Opt_DisableJsMinifier -- render JavaScript using a pretty-printed SDoc rather than compact a HLine + -- profiling opts | Opt_AutoSccsOnIndividualCafs | Opt_ProfCountEntries ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1859,6 +1859,10 @@ dynamic_flags_deps = [ , (NotDeprecated, customOrUnrecognisedWarning "W" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fwarn-" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fno-warn-" unSetCustomWarningFlag) + ] + + ------ JavaScript flags ----------------------------------------------- + ++ [ make_ord_flag defFlag "ddisable-js-minifier" (NoArg (setGeneralFlag Opt_DisableJsMinifier)) ] ------ Language flags ------------------------------------------------- ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -184,7 +184,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv ) <> semi _ -> empty - strlit xs = docToSDoc (pprStringLit xs) + strlit xs = pprStringLit xs -- the target which will form the root of what we ask rts_evalIO to run the_cfun ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TypeApplications #-} -- For Outputable instances for JS syntax {-# OPTIONS_GHC -Wno-orphans #-} @@ -55,10 +56,9 @@ module GHC.JS.Ppr , JsToDoc(..) , defaultRenderJs , RenderJs(..) + , JsRender(..) , jsToDoc , pprStringLit - , braceNest - , hangBrace , interSemi , addSemi ) @@ -75,16 +75,15 @@ import Data.List (sortOn) import Numeric(showHex) -import GHC.Utils.Outputable (Outputable (..), docToSDoc) -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map instance Outputable JExpr where - ppr = docToSDoc . renderJs + ppr = renderJs instance Outputable JVal where - ppr = docToSDoc . renderJs + ppr = renderJs -------------------------------------------------------------------------------- -- Top level API @@ -93,87 +92,86 @@ instance Outputable JVal where -- | Render a syntax tree as a pretty-printable document -- (simply showing the resultant doc produces a nice, -- well formatted String). -renderJs :: (JsToDoc a) => a -> Doc +renderJs :: (JsToDoc a) => a -> SDoc renderJs = renderJs' defaultRenderJs -renderJs' :: (JsToDoc a) => RenderJs -> a -> Doc +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs HLine -> a -> HLine #-} +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs SDoc -> a -> SDoc #-} +renderJs' :: (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc renderJs' r = jsToDocR r -data RenderJs = RenderJs - { renderJsS :: !(RenderJs -> JStat -> Doc) - , renderJsE :: !(RenderJs -> JExpr -> Doc) - , renderJsV :: !(RenderJs -> JVal -> Doc) - , renderJsI :: !(RenderJs -> Ident -> Doc) +data RenderJs doc = RenderJs + { renderJsS :: !(JsRender doc => RenderJs doc -> JStat -> doc) + , renderJsE :: !(JsRender doc => RenderJs doc -> JExpr -> doc) + , renderJsV :: !(JsRender doc => RenderJs doc -> JVal -> doc) + , renderJsI :: !(JsRender doc => RenderJs doc -> Ident -> doc) } -defaultRenderJs :: RenderJs +defaultRenderJs :: RenderJs doc defaultRenderJs = RenderJs defRenderJsS defRenderJsE defRenderJsV defRenderJsI -jsToDoc :: JsToDoc a => a -> Doc +jsToDoc :: JsToDoc a => a -> SDoc jsToDoc = jsToDocR defaultRenderJs -- | Render a syntax tree as a pretty-printable document, using a given prefix -- to all generated names. Use this with distinct prefixes to ensure distinct -- generated names between independent calls to render(Prefix)Js. -renderPrefixJs :: (JsToDoc a, JMacro a) => a -> Doc +renderPrefixJs :: (JsToDoc a, JMacro a) => a -> SDoc renderPrefixJs = renderPrefixJs' defaultRenderJs -renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc +renderPrefixJs' :: (JsToDoc a, JMacro a, JsRender doc) => RenderJs doc -> a -> doc renderPrefixJs' r = jsToDocR r -------------------------------------------------------------------------------- -- Code Generator -------------------------------------------------------------------------------- -class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc +class JsToDoc a where jsToDocR :: JsRender doc => RenderJs doc -> a -> doc instance JsToDoc JStat where jsToDocR r = renderJsS r r instance JsToDoc JExpr where jsToDocR r = renderJsE r r instance JsToDoc JVal where jsToDocR r = renderJsV r r instance JsToDoc Ident where jsToDocR r = renderJsI r r -instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) -instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc [JExpr] where jsToDocR r = jcat . map (addSemi . jsToDocR r) +instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) -defRenderJsS :: RenderJs -> JStat -> Doc +defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <> parens (jsToDocR r cond)) - (jsToDocR r x) - $$ mbElse - where mbElse | y == BlockStat [] = PP.empty - | otherwise = hangBrace (text "else") (jsToDocR r y) + IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) + (jnest $ optBlock r x) + <+?> mbElse + where mbElse | y == BlockStat [] = empty + | otherwise = hangBrace (text "else") (jnest $ optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x - DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+> char '=' <+> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <> parens (jsToDocR r p)) (jsToDocR r b) - WhileStat True p b -> (hangBrace (text "do") (jsToDocR r b)) $+$ text "while" <+> parens (jsToDocR r p) - BreakStat l -> maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l - ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l - LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s + DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) + WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l + ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l + LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s where - printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss + printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) where - forCond = parens $ hcat $ interSemi - [ jsToDocR r init - , jsToDocR r p - , parens (jsToDocR r s1) - ] - ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) + forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) where txt | each = "for each" | otherwise = "for" - SwitchStat e l d -> hangBrace (text "switch" <+> parens (jsToDocR r e)) cases - where l' = map (\(c,s) -> (text "case" <+> parens (jsToDocR r c) <> char ':') $$$ (jsToDocR r s)) l ++ [text "default:" $$$ (jsToDocR r d)] - cases = vcat l' + SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases + where l' = map (\(c,s) -> (text "case" <+?> parens (jsToDocR r c) <> colon) $$$ jnest (optBlock r s)) l + ++ [(text "default:") $$$ jnest (optBlock r d)] + cases = foldl1 ($$$) l' ReturnStat e -> text "return" <+> jsToDocR r e - ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) + ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i - <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) - (jsToDocR r b) - TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally - where mbCatch | s1 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) - mbFinally | s2 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "finally") (jsToDocR r s2) + <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) + (jnest $ optBlock r b) + TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally + where mbCatch | s1 == BlockStat [] = empty + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + mbFinally | s2 == BlockStat [] = empty + | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. @@ -183,36 +181,41 @@ defRenderJsS r = \case -- ... -- }); -- - ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] - _ -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x + ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs -optParens :: RenderJs -> JExpr -> Doc +optBlock :: JsRender doc => RenderJs doc -> JStat -> doc +optBlock r x = case x of + BlockStat{} -> jsToDocR r x + _ -> addSemi $ jsToDocR r x + +optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of UOpExpr _ _ -> parens (jsToDocR r x) _ -> jsToDocR r x -defRenderJsE :: RenderJs -> JExpr -> Doc +defRenderJsE :: JsRender doc => RenderJs doc -> JExpr -> doc defRenderJsE r = \case ValExpr x -> jsToDocR r x SelExpr x y -> jsToDocR r x <> char '.' <> jsToDocR r y IdxExpr x y -> jsToDocR r x <> brackets (jsToDocR r y) - IfExpr x y z -> parens (jsToDocR r x <+> char '?' <+> jsToDocR r y <+> char ':' <+> jsToDocR r z) - InfixExpr op x y -> parens $ hsep [jsToDocR r x, ftext (opText op), jsToDocR r y] + IfExpr x y z -> parens (jsToDocR r x <+?> char '?' <+?> jsToDocR r y <+?> colon <+?> jsToDocR r z) + InfixExpr op x y -> parens $ jsToDocR r x <+?> ftext (opText op) <+?> jsToDocR r y UOpExpr op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) - ApplExpr je xs -> jsToDocR r je <> (parens . hsep . punctuate comma $ map (jsToDocR r) xs) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) + ApplExpr je xs -> jsToDocR r je <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs) -defRenderJsV :: RenderJs -> JVal -> Doc +defRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc defRenderJsV r = \case JVar i -> jsToDocR r i - JList xs -> brackets . hsep . punctuate comma $ map (jsToDocR r) xs + JList xs -> brackets . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs JDouble (SaneDouble d) | d < 0 || isNegativeZero d -> parens (double d) | otherwise -> double d @@ -220,17 +223,17 @@ defRenderJsV r = \case | i < 0 -> parens (integer i) | otherwise -> integer i JStr s -> pprStringLit s - JRegEx s -> hcat [char '/',ftext s, char '/'] + JRegEx s -> char '/' <> ftext s <> char '/' JHash m | isNullUniqMap m -> text "{}" - | otherwise -> braceNest . hsep . punctuate comma . - map (\(x,y) -> squotes (ftext x) <> colon <+> jsToDocR r y) + | otherwise -> braceNest . foldl' (<+?>) empty . punctuate comma . + map (\(x,y) -> char '\'' <> ftext x <> char '\'' <> colon <+?> jsToDocR r y) -- nonDetKeysUniqMap doesn't introduce non-determinism here -- because we sort the elements lexically $ sortOn (LexicalFastString . fst) (nonDetUniqMapToList m) - JFunc is b -> parens $ hangBrace (text "function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) + JFunc is b -> parens $ hangBrace (text "function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) -defRenderJsI :: RenderJs -> Ident -> Doc +defRenderJsI :: JsRender doc => RenderJs doc -> Ident -> doc defRenderJsI _ (TxtI t) = ftext t aOpText :: AOp -> FastString @@ -298,17 +301,17 @@ isAlphaOp = \case VoidOp -> True _ -> False -pprStringLit :: FastString -> Doc -pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] +pprStringLit :: IsLine doc => FastString -> doc +pprStringLit s = char '\"' <> encodeJson s <> char '\"' -------------------------------------------------------------------------------- -- Utilities -------------------------------------------------------------------------------- -encodeJson :: FastString -> Doc +encodeJson :: IsLine doc => FastString -> doc encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) -encodeJsonChar :: Char -> Doc +encodeJsonChar :: IsLine doc => Char -> doc encodeJsonChar = \case '/' -> text "\\/" '\b' -> text "\\b" @@ -329,24 +332,64 @@ encodeJsonChar = \case let h = showHex cp "" in text (prefix ++ replicate (pad - length h) '0' ++ h) -braceNest :: Doc -> Doc -braceNest x = char '{' <+> nest 2 x $$ char '}' +-- braceNest :: IsLine doc => doc -> doc +-- braceNest x = dualsLine (\Refl -> lbrace $$ nest 2 x $$ rbrace) (\Refl -> braces x) -interSemi :: [Doc] -> [Doc] -interSemi [] = [] -interSemi [s] = [s] -interSemi (x:xs) = x <> text ";" : interSemi xs +interSemi :: JsRender doc => [doc] -> doc +interSemi = foldl ($$$) empty . punctuateFinal semi semi -addSemi :: Doc -> Doc -addSemi x = x <> text ";" +addSemi :: IsLine doc => doc -> doc +addSemi x = x <> semi <> char '\n' -- | Hang with braces: -- -- hdr { -- body -- } -hangBrace :: Doc -> Doc -> Doc -hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] - -($$$) :: Doc -> Doc -> Doc -x $$$ y = nest 2 $ x $+$ y +-- hangBrace :: IsLine doc => doc -> doc -> doc +-- hangBrace hdr body = dualsLine +-- (\Refl -> hdr <+> braces (nest 2 $ ppr body)) +-- (\Refl -> hdr <> braces body) + +-- ($$$) :: IsLine doc => doc -> doc -> doc +-- x $$$ y = dualsLine (\Refl -> x $$ y) (\Refl -> x <> y) + +-- (<+?>) :: IsLine doc => doc -> doc -> doc +-- x <+?> y = dualsLine (\Refl -> x <+> y) (\Refl -> x <> y) + + +class IsLine doc => JsRender doc where + (<+?>) :: doc -> doc -> doc + ($$$) :: doc -> doc -> doc + hangBrace :: doc -> doc -> doc + braceNest :: doc -> doc + jcat :: [doc] -> doc + jnest :: doc -> doc + +instance JsRender SDoc where + (<+?>) = (<+>) + {-# INLINE (<+?>) #-} + ($$$) = ($$) + {-# INLINE ($$$) #-} + hangBrace hdr body = hdr <+> lbrace $$ nest 2 (ppr body) $$ rbrace + {-# INLINE hangBrace #-} + braceNest x = lbrace $$ nest 2 x $$ rbrace + {-# INLINE braceNest #-} + jcat = vcat + {-# INLINE jcat #-} + jnest = nest 2 + {-# INLINE jnest #-} + +instance JsRender HLine where + (<+?>) = (<>) + {-# INLINE (<+?>) #-} + ($$$) = (<>) + {-# INLINE ($$$) #-} + hangBrace hdr body = hdr <> braces body + {-# INLINE hangBrace #-} + braceNest = braces + {-# INLINE braceNest #-} + jcat = hcat + {-# INLINE jcat #-} + jnest = id + {-# INLINE jnest #-} ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -91,7 +91,7 @@ stgToJS logger config stg_binds0 this_mod spt_entries foreign_stubs cccs output_ -- Doc to dump when -ddump-js is enabled when (logHasDumpFlag logger Opt_D_dump_js) $ do putDumpFileMaybe logger Opt_D_dump_js "JavaScript code" FormatJS - $ vcat (fmap (docToSDoc . jsToDoc . oiStat . luObjUnit) lus) + $ vcat (fmap (jsToDoc . oiStat . luObjUnit) lus) -- Write the object file bh <- openBinMem (4 * 1024 * 1000) -- a bit less than 4kB ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Unit.Types import GHC.Unit.Module (moduleStableString) import GHC.Utils.Outputable hiding ((<>)) +import GHC.Utils.BufHandle import GHC.Utils.Panic import GHC.Utils.Error import GHC.Utils.Logger (Logger, logVerbAtLeast) @@ -80,7 +81,6 @@ import Control.Monad import Data.Array import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import Data.Function (on) @@ -118,6 +118,9 @@ newtype ArchiveState = ArchiveState { loadedArchives :: IORef (Map FilePath Ar.A emptyArchiveState :: IO ArchiveState emptyArchiveState = ArchiveState <$> newIORef M.empty +defaultJsContext :: SDocContext +defaultJsContext = defaultSDocContext{sdocStyle = PprCode} + jsLinkBinary :: JSLinkConfig -> StgToJSConfig @@ -173,7 +176,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- LTO + rendering of JS code link_stats <- withBinaryFile (out "out.js") WriteMode $ \h -> - renderLinker h mods jsFiles + renderLinker h (csPrettyRender cfg) mods jsFiles ------------------------------------------------------------- @@ -194,8 +197,13 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do - BL.writeFile (out "rts.js") ( BLC.pack rtsDeclsText - <> BLC.pack (rtsText cfg)) + if csPrettyRender cfg + then withFile (out "rts.js") WriteMode $ \h -> + printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) + else withFile (out "rts.js") WriteMode $ \h -> do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) + bFlush bh -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -302,10 +310,11 @@ data CompactedModuleCode = CompactedModuleCode -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle + -> Bool -- ^ should we render readable JS for debugging? -> [ModuleCode] -- ^ linked code per module -> [FilePath] -- ^ additional JS files -> IO LinkerStats -renderLinker h mods jsFiles = do +renderLinker h render_pretty mods jsFiles = do -- link modules let (compacted_mods, meta) = linkModules mods @@ -314,8 +323,13 @@ renderLinker h mods jsFiles = do putBS = B.hPut h putJS x = do before <- hTell h - Ppr.printLeftRender h (pretty x) - hPutChar h '\n' + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) + bFlush bh after <- hTell h pure $! (after - before) ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -31,7 +31,7 @@ import GHC.Exts import GHC.JS.Syntax import GHC.JS.Ppr -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map @@ -39,10 +39,10 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JStat -> Doc +pretty :: JsRender doc => JStat -> doc pretty = jsToDocR ghcjsRenderJs -ghcjsRenderJs :: RenderJs +ghcjsRenderJs :: RenderJs doc ghcjsRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS @@ -52,7 +52,7 @@ ghcjsRenderJs = defaultRenderJs hdd :: SBS.ShortByteString hdd = SBS.pack (map (fromIntegral . ord) "h$$") -ghcjsRenderJsI :: RenderJs -> Ident -> Doc +ghcjsRenderJsI :: IsLine doc => RenderJs doc -> Ident -> doc ghcjsRenderJsI _ (TxtI fs) -- Fresh symbols are prefixed with "h$$". They aren't explicitly referred by -- name in user code, only in compiled code. Hence we can rename them if we do @@ -75,7 +75,7 @@ ghcjsRenderJsI _ (TxtI fs) -- | Render as an hexadecimal number in reversed order (because it's faster and we -- don't care about the actual value). -hexDoc :: Word -> Doc +hexDoc :: IsLine doc => Word -> doc hexDoc 0 = char '0' hexDoc v = text $ go v where @@ -91,23 +91,23 @@ hexDoc v = text $ go v -- attempt to resugar some of the common constructs -ghcjsRenderJsS :: RenderJs -> JStat -> Doc +ghcjsRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc ghcjsRenderJsS r s = renderJsS defaultRenderJs r s -- don't quote keys in our object literals, so closure compiler works -ghcjsRenderJsV :: RenderJs -> JVal -> Doc +ghcjsRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc ghcjsRenderJsV r (JHash m) | isNullUniqMap m = text "{}" - | otherwise = braceNest . PP.fsep . punctuate comma . - map (\(x,y) -> quoteIfRequired x <> PP.colon <+> jsToDocR r y) + | otherwise = braceNest . fsep . punctuate comma . + map (\(x,y) -> quoteIfRequired x <> colon <+> jsToDocR r y) -- nonDetEltsUniqMap doesn't introduce non-determinism here because -- we sort the elements lexically . sortOn (LexicalFastString . fst) $ nonDetUniqMapToList m where - quoteIfRequired :: FastString -> Doc + quoteIfRequired :: IsLine doc => FastString -> doc quoteIfRequired x | isUnquotedKey x = ftext x - | otherwise = PP.squotes (ftext x) + | otherwise = char '\'' <> ftext x <> char '\'' isUnquotedKey :: FastString -> Bool isUnquotedKey fs = case unpackFS fs of ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -O0 #-} @@ -45,6 +46,7 @@ import GHC.StgToJS.Linker.Opt import GHC.Data.FastString import GHC.Types.Unique.Map +import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -314,12 +316,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRets] -- | print the embedded RTS to a String -rtsText :: StgToJSConfig -> String -rtsText = show . pretty . jsOptimize . rts +rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc +rtsText = pretty @doc . jsOptimize . rts -- | print the RTS declarations to a String. -rtsDeclsText :: String -rtsDeclsText = show . pretty . jsOptimize $ rtsDecls +rtsDeclsText :: forall doc. JsRender doc => doc +rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' rts :: StgToJSConfig -> Sat.JStat ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -86,6 +86,7 @@ data StgToJSConfig = StgToJSConfig , csInlineLoadRegs :: !Bool , csInlineEnter :: !Bool , csInlineAlloc :: !Bool + , csPrettyRender :: !Bool , csTraceRts :: !Bool , csAssertRts :: !Bool , csBoundsCheck :: !Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbbbe272899f66a9a8001007096cbc99dedfefd6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbbbe272899f66a9a8001007096cbc99dedfefd6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 16:07:47 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 23 May 2023 12:07:47 -0400 Subject: [Git][ghc/ghc][wip/fix-ticky] 32 commits: base: Add test for #13660 Message-ID: <646ce4d36789f_9760a9fbf319c1478085@gitlab.mail> Matthew Pickering pushed to branch wip/fix-ticky at Glasgow Haskell Compiler / GHC Commits: 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 7963e0b4 by Matthew Pickering at 2023-05-23T17:07:34+01:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - fd2bab50 by Matthew Pickering at 2023-05-23T17:07:34+01:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Runtime/Heap/Inspect.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51633b935b3f17e579d85f6b38cec9fc3dca658b...fd2bab50d1019d0f4487412c64e27c4c6023d50f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51633b935b3f17e579d85f6b38cec9fc3dca658b...fd2bab50d1019d0f4487412c64e27c4c6023d50f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 16:34:36 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 23 May 2023 12:34:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-ticky Message-ID: <646ceb1c8a10d_9760a9f1a97f414853e0@gitlab.mail> Matthew Pickering pushed new branch wip/hadrian-ticky at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-ticky You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 16:43:07 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 12:43:07 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646ced1b7dacc_9760a9f1a97f41489397@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: fc1e6c49 by Rodrigo Mesquita at 2023-05-23T17:42:49+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -122,7 +122,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -700,7 +700,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -393,6 +394,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -475,6 +475,17 @@ FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting the C99 flags, or otherwise we +dnl might end up trying to configure the C99 flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + + dnl ** Which ld to use dnl -------------------------------------------------------------- AC_ARG_VAR(LD,[Use as the path to ld. See also --disable-ld-override.]) @@ -1230,6 +1241,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,10 +110,18 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) +# CPP, CPPFLAGS +# For now, we assume CPP args are shared accross stages +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc1e6c4943ffffe7d7894feabdf877b5d9c6649a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc1e6c4943ffffe7d7894feabdf877b5d9c6649a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 16:57:58 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 12:57:58 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 36 commits: Configure CPP into settings Message-ID: <646cf096bc13b_9760a9f1a97f414904c0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: fc1e6c49 by Rodrigo Mesquita at 2023-05-23T17:42:49+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 23dd03d1 by Ben Gamari at 2023-05-23T17:48:36+01:00 ghc-toolchain: Initial commit - - - - - c6abfc9d by Ben Gamari at 2023-05-23T17:54:23+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - edb0c2a1 by Ben Gamari at 2023-05-23T17:54:24+01:00 Move via-C flags into GHC - - - - - 53c675c8 by Ben Gamari at 2023-05-23T17:54:24+01:00 Rip out runtime linker/compiler checks - - - - - 71b260e6 by Ben Gamari at 2023-05-23T17:54:24+01:00 configure: Rip out toolchain selection logic - - - - - b30f3e03 by Ben Gamari at 2023-05-23T17:54:24+01:00 Fixes - - - - - 041e95ec by Rodrigo Mesquita at 2023-05-23T17:54:24+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - ab66e9a4 by Rodrigo Mesquita at 2023-05-23T17:54:24+01:00 Re-introduce ld-override option - - - - - d02bc8c0 by Rodrigo Mesquita at 2023-05-23T17:54:24+01:00 ROMES:WIP - - - - - cdee4a69 by Rodrigo Mesquita at 2023-05-23T17:54:24+01:00 ghc-toolchain library and usage in hadrian flags - - - - - dd8d2eba by Rodrigo Mesquita at 2023-05-23T17:54:24+01:00 ROMES: WIP - - - - - 3a4ce2be by Rodrigo Mesquita at 2023-05-23T17:54:24+01:00 Re-introduce flags in hadrian config - - - - - 83a22910 by Rodrigo Mesquita at 2023-05-23T17:54:24+01:00 ROMES WIP - - - - - dfef0ae5 by Rodrigo Mesquita at 2023-05-23T17:54:24+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 6af33204 by Rodrigo Mesquita at 2023-05-23T17:56:17+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - aa471082 by Rodrigo Mesquita at 2023-05-23T17:56:19+01:00 Rip more of configure that is no longer being used - - - - - f0058259 by Rodrigo Mesquita at 2023-05-23T17:56:19+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - 01bcd623 by Rodrigo Mesquita at 2023-05-23T17:56:19+01:00 Rip out more from hadrians system.config.in - - - - - 7d4868ba by Rodrigo Mesquita at 2023-05-23T17:56:19+01:00 Configure CLink supports response files - - - - - 512c1122 by Rodrigo Mesquita at 2023-05-23T17:56:19+01:00 Read deleted keys from host and target's target - - - - - ad8d0fda by Rodrigo Mesquita at 2023-05-23T17:56:19+01:00 ROMES: WIP 3 - - - - - d338895e by Rodrigo Mesquita at 2023-05-23T17:56:19+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 86e30c51 by Rodrigo Mesquita at 2023-05-23T17:57:46+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - 008508a6 by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Handle unspecified vs specified flags and commands better - - - - - 7ade537c by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 ROMES: WIP 4 - - - - - a0db8f0d by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Configure Cpp and HsCpp separately - - - - - 247199c6 by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Fixes for compilation - - - - - 957878e1 by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Link is GNU linkerg - - - - - 124ce78f by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 ROMES: WIP 5 - - - - - 32e7b4ca by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 253b0603 by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 9f7a2c65 by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 helper AC function for enable/disable - - - - - eb348fd8 by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Delete unused imports of SysTools.Info - - - - - b684af64 by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 8c5eaed6 by Rodrigo Mesquita at 2023-05-23T17:57:49+01:00 Delete trailing whitespace - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87e47f34b1a316abaac17cf27b944a08cbd020a8...8c5eaed695dddb9c14311f0c3209af125fa6b071 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87e47f34b1a316abaac17cf27b944a08cbd020a8...8c5eaed695dddb9c14311f0c3209af125fa6b071 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 17:30:13 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Tue, 23 May 2023 13:30:13 -0400 Subject: [Git][ghc/ghc][wip/more-dynflags-imports] 20 commits: testsuite: fix predicate on rdynamic test Message-ID: <646cf825cc084_9760a9699d5cc15020e3@gitlab.mail> Oleg Grenrus pushed to branch wip/more-dynflags-imports at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 3232fb96 by Oleg Grenrus at 2023-05-23T20:29:59+03:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6766907e40de2e37a3730cd9708c3eec0c5fd46a...3232fb961acbee543f9bfe73d222eed8a75e8d38 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6766907e40de2e37a3730cd9708c3eec0c5fd46a...3232fb961acbee543f9bfe73d222eed8a75e8d38 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 17:32:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 23 May 2023 13:32:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23411 Message-ID: <646cf8cba3bf6_9760a9f97d23c1502220@gitlab.mail> Ben Gamari pushed new branch wip/T23411 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23411 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 17:34:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 23 May 2023 13:34:06 -0400 Subject: [Git][ghc/ghc][wip/T23411] base: Add build-order import of GHC.Types in GHC.IO.Handle.Types Message-ID: <646cf90e3264d_9760a9eff3bd0150425e@gitlab.mail> Ben Gamari pushed to branch wip/T23411 at Glasgow Haskell Compiler / GHC Commits: 798fc163 by Ben Gamari at 2023-05-23T13:33:56-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - 1 changed file: - libraries/base/GHC/IO/Handle/Types.hs-boot Changes: ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -2,4 +2,7 @@ module GHC.IO.Handle.Types ( Handle ) where +-- See Note [Depend on GHC.Num.Integer] in GHC.Base +import GHC.Types () + data Handle View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/798fc1638568ede3a074b6e05ea4a22e7f6805a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/798fc1638568ede3a074b6e05ea4a22e7f6805a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 17:42:07 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 13:42:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/rip-solaris-configuration Message-ID: <646cfaef3726_9760a9f97d23c150488@gitlab.mail> Rodrigo Mesquita pushed new branch wip/rip-solaris-configuration at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/rip-solaris-configuration You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 17:46:23 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 23 May 2023 13:46:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23417 Message-ID: <646cfbef69d23_9760a9eff3bd015099e0@gitlab.mail> Ben Gamari pushed new branch wip/T23417 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23417 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 18:01:40 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 23 May 2023 14:01:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T13981 Message-ID: <646cff8484555_9760a9f7c9724152502d@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T13981 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T13981 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 18:19:06 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 14:19:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/move-via-c-flags-into-ghc Message-ID: <646d039ae44ea_9760a9eff3bd01528634@gitlab.mail> Rodrigo Mesquita pushed new branch wip/move-via-c-flags-into-ghc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/move-via-c-flags-into-ghc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 18:35:18 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 23 May 2023 14:35:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/T22919-redux Message-ID: <646d0766aaa35_9760a9f97d23c1537595@gitlab.mail> Alan Zimmerman pushed new branch wip/az/T22919-redux at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/T22919-redux You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 18:35:28 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 14:35:28 -0400 Subject: [Git][ghc/ghc][wip/move-via-c-flags-into-ghc] Move via-C flags into GHC Message-ID: <646d077093fc6_9760a9f5e51241537790@gitlab.mail> Rodrigo Mesquita pushed to branch wip/move-via-c-flags-into-ghc at Glasgow Haskell Compiler / GHC Commits: b84af2d8 by Ben Gamari at 2023-05-23T19:35:20+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 8 changed files: - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_gcc_extra_flags.m4 - + m4/fp_gcc_supports_via_c_flags.m4 Changes: ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -76,7 +76,6 @@ initSettings top_dir = do getToolSetting :: String -> ExceptT SettingsError m String getToolSetting key = expandToolDir useInplaceMinGW mtool_dir <$> getSetting key targetPlatformString <- getSetting "target platform string" - myExtraGccViaCFlags <- getSetting "GCC extra via C opts" cc_prog <- getToolSetting "C compiler command" cxx_prog <- getToolSetting "C++ compiler command" cc_args_str <- getToolSetting "C compiler flags" @@ -93,6 +92,18 @@ initSettings top_dir = do cpp_args = map Option (words cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str + + -- The extra flags we need to pass gcc when we invoke it to compile .hc code. + -- + -- -fwrapv is needed for gcc to emit well-behaved code in the presence of + -- integer wrap around (#952). + extraGccViaCFlags = if platformUnregisterised platform + -- These used to be conditioned on gcc version but + -- we no longer support GCC versions which lack + -- support for these flags + then ["-fwrapv", "-fno-builtin"] + else [] + ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" @@ -204,7 +215,7 @@ initSettings top_dir = do , toolSettings_opt_lc = [] , toolSettings_opt_i = [] - , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags + , toolSettings_extraGccViaCFlags = extraGccViaCFlags } , sTargetPlatform = platform ===================================== configure.ac ===================================== @@ -622,6 +622,9 @@ FP_GCC_VERSION dnl ** See whether cc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +dnl ** Check support for the extra flags passed by GHC when compiling via C +FP_GCC_SUPPORTS_VIA_C_FLAGS + dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on ===================================== hadrian/bindist/Makefile ===================================== @@ -79,7 +79,6 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ @echo ',("C++ compiler command", "$(SettingsCxxCompilerCommand)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -234,7 +234,6 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -137,7 +137,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -411,8 +411,7 @@ generateSettings :: Expr String generateSettings = do ctx <- getContext settings <- traverse sequence $ - [ ("GCC extra via C opts", expr $ lookupSystemConfig "gcc-extra-via-c-opts") - , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) + [ ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) , ("C++ compiler command", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerCommand) , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) ===================================== m4/fp_gcc_extra_flags.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_GCC_EXTRA_FLAGS -# ------------------ -# Determine which extra flags we need to pass gcc when we invoke it -# to compile .hc code. -# -# -fwrapv is needed for gcc to emit well-behaved code in the presence of -# integer wrap around. (#952) -# -AC_DEFUN([FP_GCC_EXTRA_FLAGS], -[AC_REQUIRE([FP_GCC_VERSION]) -AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts], -[ - if test "$Unregisterised" = "YES"; then - # These used to be conditioned on gcc version but we no longer support - # GCC versions which lack support for these flags - fp_cv_gcc_extra_opts="-fwrapv -fno-builtin" - fi -]) -AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) -]) ===================================== m4/fp_gcc_supports_via_c_flags.m4 ===================================== @@ -0,0 +1,18 @@ +# FP_GCC_SUPPORTS_VIA_C_FLAGS +# ---------------------- +# Does gcc support the -no-pie option? If so we should pass it to gcc when +# joining objects since -pie may be enabled by default. +AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C]) + echo 'int main() { return 0; }' > conftest.c + if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + AC_MSG_ERROR([gcc must support the flags -fwrapv and/or -fno-builtin])] + fi + rm -f conftest.c conftest.o conftest +]) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b84af2d87ee5b2f98d42356f6a137e412e9dbc69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b84af2d87ee5b2f98d42356f6a137e412e9dbc69 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 18:36:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 14:36:53 -0400 Subject: [Git][ghc/ghc][wip/move-via-c-flags-into-ghc] Move via-C flags into GHC Message-ID: <646d07c5efef_9760a9fbf3188153974a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/move-via-c-flags-into-ghc at Glasgow Haskell Compiler / GHC Commits: 75b42288 by Ben Gamari at 2023-05-23T19:36:44+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 8 changed files: - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_gcc_extra_flags.m4 - + m4/fp_gcc_supports_via_c_flags.m4 Changes: ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -76,7 +76,6 @@ initSettings top_dir = do getToolSetting :: String -> ExceptT SettingsError m String getToolSetting key = expandToolDir useInplaceMinGW mtool_dir <$> getSetting key targetPlatformString <- getSetting "target platform string" - myExtraGccViaCFlags <- getSetting "GCC extra via C opts" cc_prog <- getToolSetting "C compiler command" cxx_prog <- getToolSetting "C++ compiler command" cc_args_str <- getToolSetting "C compiler flags" @@ -93,6 +92,16 @@ initSettings top_dir = do cpp_args = map Option (words cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str + + -- The extra flags we need to pass gcc when we invoke it to compile .hc code. + -- + -- -fwrapv is needed for gcc to emit well-behaved code in the presence of + -- integer wrap around (#952). + extraGccViaCFlags = if platformUnregisterised platform + -- configure guarantees cc support these flags + then ["-fwrapv", "-fno-builtin"] + else [] + ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" @@ -204,7 +213,7 @@ initSettings top_dir = do , toolSettings_opt_lc = [] , toolSettings_opt_i = [] - , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags + , toolSettings_extraGccViaCFlags = extraGccViaCFlags } , sTargetPlatform = platform ===================================== configure.ac ===================================== @@ -622,6 +622,9 @@ FP_GCC_VERSION dnl ** See whether cc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +dnl ** Check support for the extra flags passed by GHC when compiling via C +FP_GCC_SUPPORTS_VIA_C_FLAGS + dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on ===================================== hadrian/bindist/Makefile ===================================== @@ -79,7 +79,6 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ @echo ',("C++ compiler command", "$(SettingsCxxCompilerCommand)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -234,7 +234,6 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -137,7 +137,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -411,8 +411,7 @@ generateSettings :: Expr String generateSettings = do ctx <- getContext settings <- traverse sequence $ - [ ("GCC extra via C opts", expr $ lookupSystemConfig "gcc-extra-via-c-opts") - , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) + [ ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) , ("C++ compiler command", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerCommand) , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) ===================================== m4/fp_gcc_extra_flags.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_GCC_EXTRA_FLAGS -# ------------------ -# Determine which extra flags we need to pass gcc when we invoke it -# to compile .hc code. -# -# -fwrapv is needed for gcc to emit well-behaved code in the presence of -# integer wrap around. (#952) -# -AC_DEFUN([FP_GCC_EXTRA_FLAGS], -[AC_REQUIRE([FP_GCC_VERSION]) -AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts], -[ - if test "$Unregisterised" = "YES"; then - # These used to be conditioned on gcc version but we no longer support - # GCC versions which lack support for these flags - fp_cv_gcc_extra_opts="-fwrapv -fno-builtin" - fi -]) -AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) -]) ===================================== m4/fp_gcc_supports_via_c_flags.m4 ===================================== @@ -0,0 +1,18 @@ +# FP_GCC_SUPPORTS_VIA_C_FLAGS +# ---------------------- +# Does gcc support the -no-pie option? If so we should pass it to gcc when +# joining objects since -pie may be enabled by default. +AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C]) + echo 'int main() { return 0; }' > conftest.c + if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + AC_MSG_ERROR([gcc must support the flags -fwrapv and/or -fno-builtin])] + fi + rm -f conftest.c conftest.o conftest +]) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75b422888527112f71a09e6cf39601d120efe541 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75b422888527112f71a09e6cf39601d120efe541 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 18:45:39 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 14:45:39 -0400 Subject: [Git][ghc/ghc][wip/move-via-c-flags-into-ghc] Move via-C flags into GHC Message-ID: <646d09d383854_9760a9f97d23c1540315@gitlab.mail> Rodrigo Mesquita pushed to branch wip/move-via-c-flags-into-ghc at Glasgow Haskell Compiler / GHC Commits: 99a4c996 by Ben Gamari at 2023-05-23T19:45:30+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 8 changed files: - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_gcc_extra_flags.m4 - + m4/fp_gcc_supports_via_c_flags.m4 Changes: ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -76,7 +76,6 @@ initSettings top_dir = do getToolSetting :: String -> ExceptT SettingsError m String getToolSetting key = expandToolDir useInplaceMinGW mtool_dir <$> getSetting key targetPlatformString <- getSetting "target platform string" - myExtraGccViaCFlags <- getSetting "GCC extra via C opts" cc_prog <- getToolSetting "C compiler command" cxx_prog <- getToolSetting "C++ compiler command" cc_args_str <- getToolSetting "C compiler flags" @@ -93,6 +92,16 @@ initSettings top_dir = do cpp_args = map Option (words cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str + + -- The extra flags we need to pass gcc when we invoke it to compile .hc code. + -- + -- -fwrapv is needed for gcc to emit well-behaved code in the presence of + -- integer wrap around (#952). + extraGccViaCFlags = if platformUnregisterised platform + -- configure guarantees cc support these flags + then ["-fwrapv", "-fno-builtin"] + else [] + ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" @@ -204,7 +213,7 @@ initSettings top_dir = do , toolSettings_opt_lc = [] , toolSettings_opt_i = [] - , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags + , toolSettings_extraGccViaCFlags = extraGccViaCFlags } , sTargetPlatform = platform ===================================== configure.ac ===================================== @@ -622,6 +622,9 @@ FP_GCC_VERSION dnl ** See whether cc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +dnl ** Check support for the extra flags passed by GHC when compiling via C +FP_GCC_SUPPORTS_VIA_C_FLAGS + dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on ===================================== hadrian/bindist/Makefile ===================================== @@ -79,7 +79,6 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ @echo ',("C++ compiler command", "$(SettingsCxxCompilerCommand)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -234,7 +234,6 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -137,7 +137,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -411,8 +411,7 @@ generateSettings :: Expr String generateSettings = do ctx <- getContext settings <- traverse sequence $ - [ ("GCC extra via C opts", expr $ lookupSystemConfig "gcc-extra-via-c-opts") - , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) + [ ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) , ("C++ compiler command", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerCommand) , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) ===================================== m4/fp_gcc_extra_flags.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_GCC_EXTRA_FLAGS -# ------------------ -# Determine which extra flags we need to pass gcc when we invoke it -# to compile .hc code. -# -# -fwrapv is needed for gcc to emit well-behaved code in the presence of -# integer wrap around. (#952) -# -AC_DEFUN([FP_GCC_EXTRA_FLAGS], -[AC_REQUIRE([FP_GCC_VERSION]) -AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts], -[ - if test "$Unregisterised" = "YES"; then - # These used to be conditioned on gcc version but we no longer support - # GCC versions which lack support for these flags - fp_cv_gcc_extra_opts="-fwrapv -fno-builtin" - fi -]) -AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) -]) ===================================== m4/fp_gcc_supports_via_c_flags.m4 ===================================== @@ -0,0 +1,17 @@ +# FP_GCC_SUPPORTS_VIA_C_FLAGS +# --------------------------- +# Make sure GCC supports the flags passed by GHC when compiling via C +AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C]) + echo 'int main() { return 0; }' > conftest.c + if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + AC_MSG_ERROR([gcc must support the flags -fwrapv and/or -fno-builtin]) + fi + rm -f conftest.c conftest.o conftest +]) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99a4c996c926d4146e137fbf262a0f65283284c0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99a4c996c926d4146e137fbf262a0f65283284c0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 18:55:21 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 14:55:21 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] 22 commits: Make Warn = Located DriverMessage Message-ID: <646d0c19987f3_9760a9f1a97f41546342@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - bf3b714c by Rodrigo Mesquita at 2023-05-23T19:55:13+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc1e6c4943ffffe7d7894feabdf877b5d9c6649a...bf3b714cce4f16b788219d618129047eaf37c7b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc1e6c4943ffffe7d7894feabdf877b5d9c6649a...bf3b714cce4f16b788219d618129047eaf37c7b7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 18:59:10 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 14:59:10 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646d0cfe6eae2_9760a9f7c972415481ce@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 86ad71d7 by Rodrigo Mesquita at 2023-05-23T19:58:58+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,31 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +93,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86ad71d7747c8c6292ed937036a522af20db668e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86ad71d7747c8c6292ed937036a522af20db668e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 19:02:26 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 15:02:26 -0400 Subject: [Git][ghc/ghc][wip/rip-solaris-configuration] 24 commits: Make Warn = Located DriverMessage Message-ID: <646d0dc2e7bb1_9760a9f7c97c415503ee@gitlab.mail> Rodrigo Mesquita pushed to branch wip/rip-solaris-configuration at Glasgow Haskell Compiler / GHC Commits: 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 86ad71d7 by Rodrigo Mesquita at 2023-05-23T19:58:58+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 9541a1e3 by Rodrigo Mesquita at 2023-05-23T20:02:09+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - df979036 by Ben Gamari at 2023-05-23T20:02:09+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c6d7c33074316cef53691fc096cb348534a027e...df979036d3c6ddb50c3d971cd29c917e70eda59d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c6d7c33074316cef53691fc096cb348534a027e...df979036d3c6ddb50c3d971cd29c917e70eda59d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 19:04:16 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 15:04:16 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <646d0e30c53f4_9760a9fbf319c1550680@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 04ec66b1 by Rodrigo Mesquita at 2023-05-23T20:04:03+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +96,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04ec66b110a7414e665f082593c68a00e942b80f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04ec66b110a7414e665f082593c68a00e942b80f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 19:07:27 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 15:07:27 -0400 Subject: [Git][ghc/ghc][wip/rip-solaris-configuration] 2 commits: Configure CPP into settings Message-ID: <646d0eef88805_9760a9fbf319c15527d6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/rip-solaris-configuration at Glasgow Haskell Compiler / GHC Commits: 04ec66b1 by Rodrigo Mesquita at 2023-05-23T20:04:03+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5033fdbe by Ben Gamari at 2023-05-23T20:06:56+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 20 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 - mk/project.mk.in Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +96,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,41 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + runSomethingFiltered logger id desc p + (args0 ++ args1 ++ args2) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> DynFlags -> [Option] -> IO () +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + -- ROMES: we're no longer using runSomethingResponseFile for CPP, nor passing the C options + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args0 = map Option (augmentImports dflags optPs) + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args0 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -298,23 +298,6 @@ then exit 1 fi -# Testing if we shall enable shared libs support on Solaris. -# Anything older than SunOS 5.11 aka Solaris 11 (Express) is broken. - -SOLARIS_BROKEN_SHLD=NO - -case $host in - i386-*-solaris2) - # here we go with the test - MINOR=`uname -r|cut -d '.' -f 2-` - if test "$MINOR" -lt "11"; then - SOLARIS_BROKEN_SHLD=YES - fi - ;; -esac - -AC_SUBST(SOLARIS_BROKEN_SHLD) - dnl ** Do an unregisterised build? dnl -------------------------------------------------------------- @@ -466,7 +449,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +646,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1223,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -49,7 +51,6 @@ hs-cpp-args = @HaskellCPPArgs@ # Build options: #=============== -solaris-broken-shld = @SOLARIS_BROKEN_SHLD@ ghc-unregisterised = @Unregisterised@ tables-next-to-code = @TablesNextToCode@ use-libffi-for-adjustors = @UseLibffiForAdjustors@ @@ -108,11 +109,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +142,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -28,7 +28,6 @@ data Flag = ArSupportsAtFile | GmpInTree | GmpFrameworkPref | LeadingUnderscore - | SolarisBrokenShld | UseSystemFfi | BootstrapThreadedRts | BootstrapEventLoggingRts @@ -58,7 +57,6 @@ flag f = do GmpInTree -> "intree-gmp" GmpFrameworkPref -> "gmp-framework-preferred" LeadingUnderscore -> "leading-underscore" - SolarisBrokenShld -> "solaris-broken-shld" UseSystemFfi -> "use-system-ffi" BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" @@ -101,8 +99,7 @@ platformSupportsSharedLibs = do ppc_linux <- anyTargetPlatform [ "powerpc-unknown-linux" ] solaris <- anyTargetPlatform [ "i386-unknown-solaris2" ] javascript <- anyTargetArch [ "javascript" ] - solarisBroken <- flag SolarisBrokenShld - return $ not (windows || wasm || javascript || ppc_linux || solaris && solarisBroken) + return $ not (windows || wasm || javascript || ppc_linux || solaris) -- | Does the target support threaded RTS? targetSupportsThreadedRts :: Action Bool ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,68 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) ===================================== mk/project.mk.in ===================================== @@ -156,10 +156,6 @@ else Windows_Target=NO endif -# In case of Solaris OS, does it provide broken shared libs -# linker or not? -SOLARIS_BROKEN_SHLD=@SOLARIS_BROKEN_SHLD@ - # Is the stage0 compiler affected by Bug #9439? GHC_LLVM_AFFECTED_BY_9439 = @GHC_LLVM_AFFECTED_BY_9439@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df979036d3c6ddb50c3d971cd29c917e70eda59d...5033fdbe0dc625875d87d4bf637db13b642f2fb8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df979036d3c6ddb50c3d971cd29c917e70eda59d...5033fdbe0dc625875d87d4bf637db13b642f2fb8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 19:11:32 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 15:11:32 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 58 commits: Make Warn = Located DriverMessage Message-ID: <646d0fe473ff_9760a9fbf319c15565c9@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 04ec66b1 by Rodrigo Mesquita at 2023-05-23T20:04:03+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5033fdbe by Ben Gamari at 2023-05-23T20:06:56+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 8ae5cd50 by Ben Gamari at 2023-05-23T20:07:41+01:00 ghc-toolchain: Initial commit - - - - - 126305d3 by Ben Gamari at 2023-05-23T20:07:41+01:00 Move via-C flags into GHC - - - - - dd9607c3 by Ben Gamari at 2023-05-23T20:07:41+01:00 Rip out runtime linker/compiler checks - - - - - 6cee771b by Ben Gamari at 2023-05-23T20:09:29+01:00 configure: Rip out toolchain selection logic - - - - - f646ea38 by Ben Gamari at 2023-05-23T20:09:30+01:00 Fixes - - - - - 2e54d9b4 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 004d474c by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Re-introduce ld-override option - - - - - a9e66b90 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 ROMES:WIP - - - - - e886c08b by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 ghc-toolchain library and usage in hadrian flags - - - - - dabc2b10 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 ROMES: WIP - - - - - 5c92d6d3 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Re-introduce flags in hadrian config - - - - - 7ed2f679 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 ROMES WIP - - - - - c1baa03f by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 23f4ee4d by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - ec6de1f3 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Rip more of configure that is no longer being used - - - - - fbee3711 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - 3fea79c5 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Rip out more from hadrians system.config.in - - - - - 46d44725 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Configure CLink supports response files - - - - - 08c2f805 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Read deleted keys from host and target's target - - - - - 1266dec1 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 ROMES: WIP 3 - - - - - ece60c76 by Rodrigo Mesquita at 2023-05-23T20:09:30+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 0f13432f by Rodrigo Mesquita at 2023-05-23T20:11:17+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - 54568412 by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Handle unspecified vs specified flags and commands better - - - - - 55071d93 by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 ROMES: WIP 4 - - - - - 5949e6a3 by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Configure Cpp and HsCpp separately - - - - - de1da28a by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Fixes for compilation - - - - - c9dc7ba8 by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Link is GNU linkerg - - - - - 38d5fb3e by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 ROMES: WIP 5 - - - - - 703ccc6f by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 8880d4d5 by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 5d32a549 by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 helper AC function for enable/disable - - - - - c41024ec by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Delete unused imports of SysTools.Info - - - - - 233b4252 by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 7e410db7 by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Delete trailing whitespace - - - - - ac365d6f by Rodrigo Mesquita at 2023-05-23T20:11:18+01:00 Delete trailing whitespace - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Linker/ExtraObj.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c5eaed695dddb9c14311f0c3209af125fa6b071...ac365d6f7c997dd4998dc4313231706750277efd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c5eaed695dddb9c14311f0c3209af125fa6b071...ac365d6f7c997dd4998dc4313231706750277efd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 19:12:31 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 23 May 2023 15:12:31 -0400 Subject: [Git][ghc/ghc][wip/az/T22919-redux] 16 commits: Revert "Change hostSupportsRPaths to report False on OpenBSD" Message-ID: <646d101f3f18b_9760a9f5e51241557243@gitlab.mail> Alan Zimmerman pushed to branch wip/az/T22919-redux at Glasgow Haskell Compiler / GHC Commits: 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 3f79634d by Alan Zimmerman at 2023-05-23T20:12:16+01:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22c9754f6265b01d7013e907e066a21cab65bdac...3f79634dcab877830a66b85c146b63aff8d79fe4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22c9754f6265b01d7013e907e066a21cab65bdac...3f79634dcab877830a66b85c146b63aff8d79fe4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 19:17:56 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 23 May 2023 15:17:56 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 34 commits: Move via-C flags into GHC Message-ID: <646d11646e992_9760a9f7c97c415577d9@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 8ff58c59 by Ben Gamari at 2023-05-23T20:15:53+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 90ce374e by Ben Gamari at 2023-05-23T20:15:53+01:00 Rip out runtime linker/compiler checks - - - - - 9244615f by Ben Gamari at 2023-05-23T20:15:53+01:00 configure: Rip out toolchain selection logic - - - - - 9f717f1b by Ben Gamari at 2023-05-23T20:15:53+01:00 Fixes - - - - - 5aad1436 by Rodrigo Mesquita at 2023-05-23T20:15:53+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - e644541b by Rodrigo Mesquita at 2023-05-23T20:15:53+01:00 Re-introduce ld-override option - - - - - 44eee319 by Rodrigo Mesquita at 2023-05-23T20:17:17+01:00 ROMES:WIP - - - - - d6f9e6df by Rodrigo Mesquita at 2023-05-23T20:17:18+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 01843f1d by Rodrigo Mesquita at 2023-05-23T20:17:44+01:00 ROMES: WIP - - - - - 89ad6be3 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Re-introduce flags in hadrian config - - - - - ce54a8ba by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 ROMES WIP - - - - - e2d5904d by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - f04d7a02 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - 76be5f8f by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Rip more of configure that is no longer being used - - - - - 1430e79c by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - e49ea8d7 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Rip out more from hadrians system.config.in - - - - - 0b584353 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Configure CLink supports response files - - - - - db527959 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Read deleted keys from host and target's target - - - - - e232320a by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 ROMES: WIP 3 - - - - - 632a4d42 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - c3b265bb by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - b4fa58e8 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Handle unspecified vs specified flags and commands better - - - - - 4a17be94 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 ROMES: WIP 4 - - - - - 208e074a by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Configure Cpp and HsCpp separately - - - - - 72e581e3 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Fixes for compilation - - - - - ab5652ac by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Link is GNU linkerg - - - - - ee608654 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 ROMES: WIP 5 - - - - - f8a6e24a by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 6cd2f434 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 51b3c775 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 helper AC function for enable/disable - - - - - bbdef5cb by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Delete unused imports of SysTools.Info - - - - - 93e99dd3 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 4e34dda7 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Delete trailing whitespace - - - - - b58ffb71 by Rodrigo Mesquita at 2023-05-23T20:17:45+01:00 Delete trailing whitespace - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac365d6f7c997dd4998dc4313231706750277efd...b58ffb71bf7fe28e5e2484f0cc7ea1e6036b522b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac365d6f7c997dd4998dc4313231706750277efd...b58ffb71bf7fe28e5e2484f0cc7ea1e6036b522b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 20:06:27 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Tue, 23 May 2023 16:06:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/amg/dcoercion-optimisation Message-ID: <646d1cc341441_9760a9fbf319c1562416@gitlab.mail> Adam Gundry pushed new branch wip/amg/dcoercion-optimisation at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/amg/dcoercion-optimisation You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 21:34:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 23 May 2023 17:34:49 -0400 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.6.2-release Message-ID: <646d317929974_9760a9f7c972415845b@gitlab.mail> Ben Gamari pushed new tag ghc-9.6.2-release at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.6.2-release You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 23 21:43:00 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Tue, 23 May 2023 17:43:00 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 23 commits: testsuite: fix predicate on rdynamic test Message-ID: <646d336423a7b_9760a9f97d23c15850b3@gitlab.mail> Matthew Craven pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 903b1cf6 by Matthew Craven at 2023-05-23T17:27:41-04:00 WIP: Track visibility in forall-coercions - - - - - 3d2428b9 by Matthew Craven at 2023-05-23T17:27:43-04:00 revert temporary renamings of the forallco constructors - - - - - 7a0f67e5 by Matthew Craven at 2023-05-23T17:27:44-04:00 make necessary testsuite changes - - - - - 01955e40 by Matthew Craven at 2023-05-23T17:27:44-04:00 accept new output for T23398 - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Iface/Rename.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cd59cd32042db4c5bdbc0504e1b27a52651a800c...01955e401b4b701c9ca23fb3e7b798f56d68d5a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cd59cd32042db4c5bdbc0504e1b27a52651a800c...01955e401b4b701c9ca23fb3e7b798f56d68d5a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 06:46:49 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Wed, 24 May 2023 02:46:49 -0400 Subject: [Git][ghc/ghc][wip/amg/dcoercion-optimisation] WIP: experiment with DCoercion optimisation Message-ID: <646db2d99633c_9760a9699d5cc1605418@gitlab.mail> Adam Gundry pushed to branch wip/amg/dcoercion-optimisation at Glasgow Haskell Compiler / GHC Commits: fdf40c60 by Adam Gundry at 2023-05-24T07:46:27+01:00 WIP: experiment with DCoercion optimisation - - - - - 1 changed file: - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wwarn #-} -- AMG TODO module GHC.Core.Coercion.Opt ( optCoercion @@ -374,6 +375,7 @@ opt_co4 opts env sym rep r (AxiomInstCo con ind cos) -- Note that the_co does *not* have sym pushed into it opt_co4 opts env@(LC _ _lift_co_env) sym rep r (HydrateDCo _r lhs_ty dco rhs_ty) +{- = case optDCoMethod opts of HydrateDCos -> opt_co4 opts env sym rep r (hydrateOneLayerDCo r lhs_ty dco) @@ -384,10 +386,13 @@ opt_co4 opts env@(LC _ _lift_co_env) sym rep r (HydrateDCo _r lhs_ty dco rhs_ty) wrapSym sym $ wrapRole rep r $ res + | otherwise - -> assert (r == _r) $ +-} +-- -> assert (r == _r) $ + = assert (r == _r) $ wrapSym sym $ - (\ (lhs', dco') -> mkHydrateDCo r' lhs' dco' rhs') $ +-- (\ (lhs', dco') -> mkHydrateDCo r' lhs' dco' rhs') $ opt_dco4_wrap "HydrateDCo" opts env rep r lhs_ty dco where rhs' = substTyUnchecked (lcSubstRight env) rhs_ty @@ -607,31 +612,29 @@ type family OptRes co_or_dco where type Optimiser in_co out_co = OptCoParams -> LiftingContext -> SymFlag -> ReprFlag -> Role -> in_co -> out_co -opt_co_or_dco :: CoOrDCo co_or_dco -> Type -> Optimiser co_or_dco co_or_dco +opt_co_or_dco :: CoOrDCo co_or_dco -> Type -> Optimiser co_or_dco Coercion opt_co_or_dco Co _ = opt_co4 opt_co_or_dco DCo l_ty = \ opts lc sym repr r dco -> assert (sym == False) $ - snd $ opt_dco4 opts lc repr r l_ty dco opt_univ :: forall co_or_dco . Outputable co_or_dco => CoOrDCo co_or_dco -> OptCoParams - -> LiftingContext -> SymFlag -> UnivCoProvenance co_or_dco -> Role - -> Type -> Type -> OptRes co_or_dco + -> LiftingContext -> SymFlag -> UnivCoProvenance Coercion -> Role + -> Type -> Type -> Coercion opt_univ co_or_dco opts env sym (PhantomProv h) _r ty1 ty2 | sym = mk_phantom h' ty2' ty1' | otherwise = mk_phantom h' ty1' ty2' where - h' = wrap "opt_univ PhantomProv" (opt_co_or_dco co_or_dco ty1) opts env sym False Nominal h + h' = wrap "opt_univ PhantomProv" (opt_co_or_dco Co ty1) opts env sym False Nominal h ty1' = substTy (lcSubstLeft env) ty1 ty2' = substTy (lcSubstRight env) ty2 - mk_phantom :: co_or_dco -> Type -> Type -> OptRes co_or_dco - mk_phantom = case co_or_dco of - Co -> mkPhantomCo - DCo -> \ h t1 t2 -> (t1, mkUnivDCo (PhantomProv h) t2) + mk_phantom :: Coercion -> Type -> Type -> Coercion + mk_phantom = mkPhantomCo + opt_univ co_or_dco opts env sym prov role oty1 oty2 | Just (tc1, tys1) <- splitTyConApp_maybe oty1 @@ -642,19 +645,10 @@ opt_univ co_or_dco opts env sym prov role oty1 oty2 -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom); -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps = let roles = tyConRoleListX role tc1 - in case co_or_dco of - Co -> - let - arg_cos = zipWith3 mk_univ roles tys1 tys2 - arg_cos' = zipWith (opt_co4 opts env sym False) roles arg_cos - in - mkTyConAppCo role tc1 arg_cos' - DCo -> - let - arg_cos = zipWith3 (\ r x y -> snd $ mk_univ r x y) roles tys1 tys2 - (arg_lhs', arg_dcos') = unzip $ zipWith3 (opt_dco4 opts env False) roles tys1 arg_cos - in - (mkTyConApp tc1 arg_lhs', mkTyConAppDCo arg_dcos') + arg_cos = zipWith3 mk_univ roles tys1 tys2 + arg_cos' = zipWith (opt_co4 opts env sym False) roles arg_cos + in + mkTyConAppCo role tc1 arg_cos' -- can't optimize the AppTy case because we can't build the kind coercions. @@ -663,9 +657,7 @@ opt_univ co_or_dco opts env sym prov role oty1 oty2 -- NB: prov isn't interesting here either = let k1 = tyVarKind tv1 k2 = tyVarKind tv2 - eta = case co_or_dco of - Co -> mk_univ Nominal k1 k2 - DCo -> snd $ mk_univ Nominal k1 k2 + eta = mk_univ Nominal k1 k2 tv1' = mk_castTy (TyVarTy tv1) k1 eta k2 -- eta gets opt'ed soon, but not yet. ty2' = substTyWith [tv2] [tv1'] ty2 @@ -680,13 +672,9 @@ opt_univ co_or_dco opts env sym prov role oty1 oty2 = let k1 = varType cv1 k2 = varType cv2 r' = coVarRole cv1 - eta = case co_or_dco of - Co -> mk_univ Nominal k1 k2 - DCo -> snd $ mk_univ Nominal k1 k2 + eta = mk_univ Nominal k1 k2 eta_d = downgradeRole r' Nominal $ - case co_or_dco of - Co -> eta - DCo -> mkHydrateDCo Nominal k1 eta k2 + eta -- eta gets opt'ed soon, but not yet. n_co = (mkSymCo $ mkSelCo (SelTyCon 2 r') eta_d) `mkTransCo` (mkCoVarCo cv1) `mkTransCo` @@ -706,32 +694,24 @@ opt_univ co_or_dco opts env sym prov role oty1 oty2 mk_univ role a b where - mk_castTy :: Type -> Type -> co_or_dco -> Type -> Type - mk_castTy = case co_or_dco of - Co -> \ ty _ co _ -> CastTy ty co - DCo -> \ ty l dco r -> CastTy ty (mkHydrateDCo Nominal l dco r) - mk_univ :: Role -> Type -> Type -> OptRes co_or_dco - mk_univ = case co_or_dco of - Co -> mkUnivCo prov' - DCo -> \ _ l_ty r_ty -> (l_ty, mkUnivDCo prov' r_ty) - mk_forall :: TyCoVar -> co_or_dco -> OptRes co_or_dco -> OptRes co_or_dco - mk_forall cv eta = case co_or_dco of - Co -> mkForAllCo cv eta - DCo -> \ (_,body) -> (mkTyVarTy cv, mkForAllDCo cv eta body) - opt_forall :: TyCoVar -> co_or_dco -> (LiftingContext,TyCoVar,co_or_dco) - opt_forall tv co = case co_or_dco of - Co -> optForAllCoBndr opts env sym tv co - DCo -> optForAllDCoBndr opts env sym tv co - prov' :: UnivCoProvenance co_or_dco + mk_castTy :: Type -> Type -> Coercion -> Type -> Type + mk_castTy = \ ty _ co _ -> CastTy ty co + mk_univ :: Role -> Type -> Type -> Coercion + mk_univ = mkUnivCo prov' + mk_forall :: TyCoVar -> Coercion -> Coercion -> Coercion + mk_forall cv eta = mkForAllCo cv eta + opt_forall :: TyCoVar -> Coercion -> (LiftingContext,TyCoVar,Coercion) + opt_forall tv co = optForAllCoBndr opts env sym tv co + prov' :: UnivCoProvenance KindCoercion prov' = case prov of #if __GLASGOW_HASKELL__ < 901 -- This alt is redundant with the first match of the FunDef PhantomProv kco -> PhantomProv - $ wrap "univ_co phantom" (opt_co_or_dco co_or_dco oty1) + $ wrap "univ_co phantom" (opt_co_or_dco Co oty1) opts env sym False Nominal kco #endif ProofIrrelProv kco -> ProofIrrelProv - $ wrap "univ_co proof_irrel" (opt_co_or_dco co_or_dco oty1) + $ wrap "univ_co proof_irrel" (opt_co_or_dco Co oty1) opts env sym False Nominal kco PluginProv str -> PluginProv str CorePrepProv homo -> CorePrepProv homo @@ -1054,14 +1034,14 @@ fireTransRule _rule _co1 _co2 res -- N.B.: The reason we return (Type, DCoercion) and not just DCoercion is that we -- sometimes need the substituted LHS type (see opt_trans_dco). -opt_phantom_dco :: OptCoParams -> LiftingContext -> Role -> Type -> DCoercion -> (Type, NormalDCo) +opt_phantom_dco :: OptCoParams -> LiftingContext -> Role -> Type -> DCoercion -> NormalCo opt_phantom_dco opts env r l_ty dco = opt_univ DCo opts env False (PhantomProv kco) Phantom l_ty r_ty where - kco = DehydrateCo (mkKindCo $ mkHydrateDCo r l_ty dco r_ty) + kco = mkKindCo $ mkHydrateDCo r l_ty dco r_ty r_ty = followDCo r l_ty dco -- A naive attempt at removing this entirely causes issues in test "type_in_type_hole_fits". -opt_dco4_wrap :: String -> OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> (Type, NormalDCo) +opt_dco4_wrap :: String -> OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> NormalCo opt_dco4_wrap str opts lc rep r l_ty dco = wrap ("opt_dco4 " ++ str) go opts lc False rep r dco where go opts lc _sym repr r dco = opt_dco4 opts lc repr r l_ty dco @@ -1070,59 +1050,104 @@ opt_dco2 :: OptCoParams -> LiftingContext -> Role -- ^ The role of the input coercion -> Type - -> DCoercion -> (Type, NormalDCo) + -> DCoercion -> NormalCo opt_dco2 opts env Phantom ty dco = opt_phantom_dco opts env Phantom ty dco opt_dco2 opts env r ty dco = opt_dco3 opts env Nothing r ty dco -opt_dco3 :: OptCoParams -> LiftingContext -> Maybe Role -> Role -> Type -> DCoercion -> (Type, NormalDCo) +opt_dco3 :: OptCoParams -> LiftingContext -> Maybe Role -> Role -> Type -> DCoercion -> NormalCo opt_dco3 opts env (Just Phantom) r ty dco = opt_phantom_dco opts env r ty dco opt_dco3 opts env (Just Representational) r ty dco = opt_dco4_wrap "opt_dco3 R" opts env True r ty dco opt_dco3 opts env _ r ty dco = opt_dco4_wrap "opt_dco3 _" opts env False r ty dco -opt_dco4 :: OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> (Type, NormalDCo) -opt_dco4 opts env rep r l_ty dco = case dco of +{- + +My plan for DCoercion optimisation is this: try to get rid of DCoercions as much +as possible, because Coercions are easier to optimise. In particular, they may +disappear to nothing at all, and unblock subsequent coercion +optimisations. There is only really one case in which DCoercions are better, +which is where we have a long transitive chain of type family reduction steps. + +-} + +opt_dco4 :: OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> NormalCo +opt_dco4 opts env@(LC _ lift_co_env) rep r l_ty dco = case dco of + TransDCo dco1 dco2 + -> case opt_dco4 opts env rep r l_ty dco1 of + HydrateDCo r' l_ty' dco1' r_ty + | isEmptyVarEnv lift_co_env -> + let dco2' = substDCo (lcSubst env) dco2 + in HydrateDCo r' l_ty' (dco1' `mkTransDCo` dco2') (followDCo r' r_ty dco2') + co1@(AxiomInstCo coax br cos) + | not (isNewTyCon (coAxiomTyCon coax)) + , isEmptyVarEnv lift_co_env -> + let dco2' = substDCo (lcSubst env) dco2 + Pair l_ty' r_ty = coercionKind co1 + dco1' = mkDehydrateCo co1 -- TODO: inline; use assumption cos are refls? + in HydrateDCo r l_ty' (dco1' `mkTransDCo` dco2') (followDCo r r_ty dco2') + -- TODO: AxiomRuleCo? + co1 -> opt_trans opts (lcInScopeSet env) co1 (opt_dco4 opts env rep r (coercionRKind co1) dco2) + _ -> opt_co4 opts env False rep r (hydrateOneLayerDCo r l_ty dco) + + +_opt_dco4 :: OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> NormalCo +_opt_dco4 opts env rep r l_ty dco = case dco of ReflDCo - -> lifted_dco + -> lifted_co GReflRightDCo kco | isGReflCo kco || isGReflCo kco' - -> lifted_dco + -> lifted_co | otherwise - -> (l_ty', mkGReflRightDCo kco') + -> mkGReflRightCo r l_ty' kco' where kco' = opt_co4 opts env False False Nominal kco GReflLeftDCo kco | isGReflCo kco || isGReflCo kco' - -> lifted_dco + -> lifted_co | otherwise - -> (l_ty', mkGReflLeftDCo kco') + -> mkGReflLeftCo r l_ty' kco' where kco' = opt_co4 opts env False False Nominal kco TyConAppDCo dcos | Just (tc, l_tys) <- splitTyConApp_maybe l_ty -> let - (arg_ltys, arg_dcos) = + arg_cos = case (rep, r) of (True, Nominal) -> - unzip $ zipWith3 (\ mb_r' -> opt_dco3 opts env mb_r' Nominal) (map Just (tyConRoleListRepresentational tc)) l_tys dcos (False, Nominal) -> - unzip $ zipWith (opt_dco4 opts env False Nominal) l_tys dcos (_, Representational) -> - unzip $ zipWith3 (opt_dco2 opts env) (tyConRoleListRepresentational tc) l_tys dcos (_, Phantom) -> pprPanic "opt_dco4 sees a phantom!" (ppr dco) - in (mkTyConApp tc arg_ltys, mkTyConAppDCo arg_dcos) + in mkTyConAppCo r tc arg_cos + +-- AMG TODO: experimenting with changing dco opt to return a Coercion. +-- +-- Key question: do we want to push Hydrate up or down? +-- If we have TyConApp for a non-family, it will never reduce, so might want to be a Coercion? +-- But then perhaps that is included in a larger context which wants a DCoercion? +-- +-- Idea: we only benefit from DCoercion when we have a long chain of +-- Steps/AxiomInstDCo. For coercion optimisation purposes, a Coercion is +-- better. Thus dcoercion optimisation produces Coercions. Then in +-- opt_trans_rule we need to handle the cases intelligently. +-- +-- Idea: look out for +-- Hydrate ty1 dco ; Sym (Hydrate ty2 dco) +-- and handle it by converting to coercions and optimising their transitive composition? + +-- Sym (Hydrate ty dco1) ; Hydrate ty dco2 +-- should be easy as we can follow common prefix of both dco1 and dco2 | otherwise -> pprPanic "opt_dco4: TyConAppDCo where ty is not a TyConApp" $ @@ -1132,14 +1157,17 @@ opt_dco4 opts env rep r l_ty dco = case dco of AppDCo dco1 dco2 | Just (l_ty1, l_ty2) <- splitAppTy_maybe l_ty , let - (l_ty1', l_dco1) = opt_dco4 opts env rep r l_ty1 dco1 - (l_ty2', l_dco2) = opt_dco4 opts env False Nominal l_ty2 dco2 - -> (mkAppTy l_ty1' l_ty2', mkAppDCo l_dco1 l_dco2) + l_co1 = opt_dco4 opts env rep r l_ty1 dco1 + l_co2 = opt_dco4 opts env False Nominal l_ty2 dco2 + -> mkAppCo l_co1 l_co2 | otherwise -> pprPanic "opt_dco4: AppDCo where ty is not an AppTy" $ vcat [ text "dco =" <+> ppr dco , text "l_ty =" <+> ppr l_ty ] + ForAllDCo{} -- AMG TODO + -> rep_dco +{- ForAllDCo dco_tcv k_dco body_dco | ForAllTy (Bndr ty_tv af) body_ty <- coreFullView l_ty -> case optForAllDCoBndr opts env False dco_tcv k_dco of @@ -1155,44 +1183,45 @@ opt_dco4 opts env rep r l_ty dco = case dco of -> pprPanic "opt_dco4: ForAllDCo where ty is not a ForAllTy" $ vcat [ text "dco =" <+> ppr dco , text "l_ty =" <+> ppr l_ty ] +-} CoVarDCo cv - -> let co' = opt_co4 opts env False rep r (CoVarCo cv) - in (coercionLKind co', mkDehydrateCo co') + -> opt_co4 opts env False rep r (CoVarCo cv) AxiomInstDCo {} - -> (l_ty', rep_dco) + -> rep_dco StepsDCo {} - -> (l_ty', rep_dco) + -> rep_dco + UnivDCo{} -> rep_dco -- TODO +{- UnivDCo prov rhs_ty -> opt_univ DCo opts env False prov r' l_ty rhs_ty +-} TransDCo dco1 dco2 -> let - (l_ty', dco1') = opt_dco4 opts env rep r l_ty dco1 + co1' = opt_dco4 opts env rep r l_ty dco1 -- Follow the original directed coercion, -- to avoid applying the substitution twice. - mid_ty = followDCo r l_ty dco1 - (mid_ty', dco2') = opt_dco4 opts env rep r mid_ty dco2 + Pair l_ty' mid_ty' = coercionKind co1' + co2' = opt_dco4 opts env rep r mid_ty' dco2 in - (l_ty', opt_trans_dco opts (lcInScopeSet env) r' l_ty' dco1' mid_ty' dco2') + opt_trans opts (lcInScopeSet env) co1' co2' SubDCo dco -> assert (r == Representational) $ opt_dco4_wrap "SubDCo" opts env True Nominal l_ty dco DehydrateCo co -> - let co' = opt_co4_wrap "DehydrateCo" opts env False rep r co - in (coercionLKind co', mkDehydrateCo co') + opt_co4_wrap "DehydrateCo" opts env False rep r co where - lifted_dco = let lifted_co = liftCoSubst r' env l_ty - in ( coercionLKind lifted_co, mkDehydrateCo lifted_co ) + lifted_co = liftCoSubst r' env l_ty l_ty' = substTyUnchecked (lcSubstLeft env) l_ty r' = chooseRole rep r - rep_dco = wrapRole_dco rep r l_ty' dco (followDCo r l_ty' dco) + rep_dco = wrapRole rep r $ mkHydrateDCo r l_ty' dco (followDCo r l_ty' dco) --------------------------------------------------------- -- Transitivity for directed coercions. @@ -1236,6 +1265,8 @@ opt_trans2_dco _ _ _ _ dco1 _ dco2 opt_trans_rule_dco :: OptCoParams -> InScopeSet -> Role -> Type -> NormalNonIdDCo -> Type -> NormalNonIdDCo -> Maybe NormalDCo +-- AMG TODO: should be more cases here? + -- Handle undirected coercions. opt_trans_rule_dco opts is _ _ (DehydrateCo co1) _ (DehydrateCo co2) = DehydrateCo <$> opt_trans_rule opts is co1 co2 @@ -1660,5 +1691,5 @@ optForAllDCoBndr :: OptCoParams optForAllDCoBndr opts env sym tv = substForAllDCoBndrUsingLC sym (substTyUnchecked (lcSubstLeft env)) - (snd . opt_dco4_wrap "optForAllDCoBndr" opts env False Nominal (tyVarKind tv)) env + (mkDehydrateCo . opt_dco4_wrap "optForAllDCoBndr" opts env False Nominal (tyVarKind tv)) env tv View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fdf40c6097ff27b259d8d5b2de5c0c0d29379db0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fdf40c6097ff27b259d8d5b2de5c0c0d29379db0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 07:57:54 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 24 May 2023 03:57:54 -0400 Subject: [Git][ghc/ghc][wip/js-hline] JS: Convert rendering to use HLine instead of SDoc (#22455) Message-ID: <646dc38237e6a_9760a9f1a97f416199ab@gitlab.mail> Josh Meredith pushed to branch wip/js-hline at Glasgow Haskell Compiler / GHC Commits: e9dd4f31 by Josh Meredith at 2023-05-24T07:57:34+00:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - 11 changed files: - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - docs/users_guide/debugging.rst Changes: ===================================== compiler/GHC/Driver/Config/StgToJS.hs ===================================== @@ -20,6 +20,7 @@ initStgToJSConfig dflags = StgToJSConfig , csInlineLoadRegs = False , csInlineEnter = False , csInlineAlloc = False + , csPrettyRender = gopt Opt_DisableJsMinifier dflags , csTraceRts = False , csAssertRts = False , csBoundsCheck = gopt Opt_DoBoundsChecking dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -314,6 +314,9 @@ data GeneralFlag | Opt_WriteInterface -- forces .hi files to be written even with -fno-code | Opt_WriteHie -- generate .hie files + -- JavaScript opts + | Opt_DisableJsMinifier -- render JavaScript using a pretty-printed SDoc rather than compact a HLine + -- profiling opts | Opt_AutoSccsOnIndividualCafs | Opt_ProfCountEntries ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1859,6 +1859,10 @@ dynamic_flags_deps = [ , (NotDeprecated, customOrUnrecognisedWarning "W" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fwarn-" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fno-warn-" unSetCustomWarningFlag) + ] + + ------ JavaScript flags ----------------------------------------------- + ++ [ make_ord_flag defFlag "ddisable-js-minifier" (NoArg (setGeneralFlag Opt_DisableJsMinifier)) ] ------ Language flags ------------------------------------------------- ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -184,7 +184,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv ) <> semi _ -> empty - strlit xs = docToSDoc (pprStringLit xs) + strlit xs = pprStringLit xs -- the target which will form the root of what we ask rts_evalIO to run the_cfun ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TypeApplications #-} -- For Outputable instances for JS syntax {-# OPTIONS_GHC -Wno-orphans #-} @@ -55,10 +56,9 @@ module GHC.JS.Ppr , JsToDoc(..) , defaultRenderJs , RenderJs(..) + , JsRender(..) , jsToDoc , pprStringLit - , braceNest - , hangBrace , interSemi , addSemi ) @@ -75,16 +75,15 @@ import Data.List (sortOn) import Numeric(showHex) -import GHC.Utils.Outputable (Outputable (..), docToSDoc) -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map instance Outputable JExpr where - ppr = docToSDoc . renderJs + ppr = renderJs instance Outputable JVal where - ppr = docToSDoc . renderJs + ppr = renderJs -------------------------------------------------------------------------------- -- Top level API @@ -93,87 +92,86 @@ instance Outputable JVal where -- | Render a syntax tree as a pretty-printable document -- (simply showing the resultant doc produces a nice, -- well formatted String). -renderJs :: (JsToDoc a) => a -> Doc +renderJs :: (JsToDoc a) => a -> SDoc renderJs = renderJs' defaultRenderJs -renderJs' :: (JsToDoc a) => RenderJs -> a -> Doc +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs HLine -> a -> HLine #-} +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs SDoc -> a -> SDoc #-} +renderJs' :: (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc renderJs' r = jsToDocR r -data RenderJs = RenderJs - { renderJsS :: !(RenderJs -> JStat -> Doc) - , renderJsE :: !(RenderJs -> JExpr -> Doc) - , renderJsV :: !(RenderJs -> JVal -> Doc) - , renderJsI :: !(RenderJs -> Ident -> Doc) +data RenderJs doc = RenderJs + { renderJsS :: !(JsRender doc => RenderJs doc -> JStat -> doc) + , renderJsE :: !(JsRender doc => RenderJs doc -> JExpr -> doc) + , renderJsV :: !(JsRender doc => RenderJs doc -> JVal -> doc) + , renderJsI :: !(JsRender doc => RenderJs doc -> Ident -> doc) } -defaultRenderJs :: RenderJs +defaultRenderJs :: RenderJs doc defaultRenderJs = RenderJs defRenderJsS defRenderJsE defRenderJsV defRenderJsI -jsToDoc :: JsToDoc a => a -> Doc +jsToDoc :: JsToDoc a => a -> SDoc jsToDoc = jsToDocR defaultRenderJs -- | Render a syntax tree as a pretty-printable document, using a given prefix -- to all generated names. Use this with distinct prefixes to ensure distinct -- generated names between independent calls to render(Prefix)Js. -renderPrefixJs :: (JsToDoc a, JMacro a) => a -> Doc +renderPrefixJs :: (JsToDoc a, JMacro a) => a -> SDoc renderPrefixJs = renderPrefixJs' defaultRenderJs -renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc +renderPrefixJs' :: (JsToDoc a, JMacro a, JsRender doc) => RenderJs doc -> a -> doc renderPrefixJs' r = jsToDocR r -------------------------------------------------------------------------------- -- Code Generator -------------------------------------------------------------------------------- -class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc +class JsToDoc a where jsToDocR :: JsRender doc => RenderJs doc -> a -> doc instance JsToDoc JStat where jsToDocR r = renderJsS r r instance JsToDoc JExpr where jsToDocR r = renderJsE r r instance JsToDoc JVal where jsToDocR r = renderJsV r r instance JsToDoc Ident where jsToDocR r = renderJsI r r -instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) -instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc [JExpr] where jsToDocR r = jcat . map (addSemi . jsToDocR r) +instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) -defRenderJsS :: RenderJs -> JStat -> Doc +defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <> parens (jsToDocR r cond)) - (jsToDocR r x) - $$ mbElse - where mbElse | y == BlockStat [] = PP.empty - | otherwise = hangBrace (text "else") (jsToDocR r y) + IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) + (jnest $ optBlock r x) + <+?> mbElse + where mbElse | y == BlockStat [] = empty + | otherwise = hangBrace (text "else") (jnest $ optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x - DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+> char '=' <+> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <> parens (jsToDocR r p)) (jsToDocR r b) - WhileStat True p b -> (hangBrace (text "do") (jsToDocR r b)) $+$ text "while" <+> parens (jsToDocR r p) - BreakStat l -> maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l - ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l - LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s + DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) + WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l + ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l + LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s where - printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss + printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) where - forCond = parens $ hcat $ interSemi - [ jsToDocR r init - , jsToDocR r p - , parens (jsToDocR r s1) - ] - ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) + forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) where txt | each = "for each" | otherwise = "for" - SwitchStat e l d -> hangBrace (text "switch" <+> parens (jsToDocR r e)) cases - where l' = map (\(c,s) -> (text "case" <+> parens (jsToDocR r c) <> char ':') $$$ (jsToDocR r s)) l ++ [text "default:" $$$ (jsToDocR r d)] - cases = vcat l' + SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases + where l' = map (\(c,s) -> (text "case" <+?> parens (jsToDocR r c) <> colon) $$$ jnest (optBlock r s)) l + ++ [(text "default:") $$$ jnest (optBlock r d)] + cases = foldl1 ($$$) l' ReturnStat e -> text "return" <+> jsToDocR r e - ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) + ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i - <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) - (jsToDocR r b) - TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally - where mbCatch | s1 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) - mbFinally | s2 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "finally") (jsToDocR r s2) + <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) + (jnest $ optBlock r b) + TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally + where mbCatch | s1 == BlockStat [] = empty + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + mbFinally | s2 == BlockStat [] = empty + | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. @@ -183,36 +181,41 @@ defRenderJsS r = \case -- ... -- }); -- - ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] - _ -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x + ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs -optParens :: RenderJs -> JExpr -> Doc +optBlock :: JsRender doc => RenderJs doc -> JStat -> doc +optBlock r x = case x of + BlockStat{} -> jsToDocR r x + _ -> addSemi $ jsToDocR r x + +optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of UOpExpr _ _ -> parens (jsToDocR r x) _ -> jsToDocR r x -defRenderJsE :: RenderJs -> JExpr -> Doc +defRenderJsE :: JsRender doc => RenderJs doc -> JExpr -> doc defRenderJsE r = \case ValExpr x -> jsToDocR r x SelExpr x y -> jsToDocR r x <> char '.' <> jsToDocR r y IdxExpr x y -> jsToDocR r x <> brackets (jsToDocR r y) - IfExpr x y z -> parens (jsToDocR r x <+> char '?' <+> jsToDocR r y <+> char ':' <+> jsToDocR r z) - InfixExpr op x y -> parens $ hsep [jsToDocR r x, ftext (opText op), jsToDocR r y] + IfExpr x y z -> parens (jsToDocR r x <+?> char '?' <+?> jsToDocR r y <+?> colon <+?> jsToDocR r z) + InfixExpr op x y -> parens $ jsToDocR r x <+?> ftext (opText op) <+?> jsToDocR r y UOpExpr op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) - ApplExpr je xs -> jsToDocR r je <> (parens . hsep . punctuate comma $ map (jsToDocR r) xs) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) + ApplExpr je xs -> jsToDocR r je <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs) -defRenderJsV :: RenderJs -> JVal -> Doc +defRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc defRenderJsV r = \case JVar i -> jsToDocR r i - JList xs -> brackets . hsep . punctuate comma $ map (jsToDocR r) xs + JList xs -> brackets . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs JDouble (SaneDouble d) | d < 0 || isNegativeZero d -> parens (double d) | otherwise -> double d @@ -220,17 +223,17 @@ defRenderJsV r = \case | i < 0 -> parens (integer i) | otherwise -> integer i JStr s -> pprStringLit s - JRegEx s -> hcat [char '/',ftext s, char '/'] + JRegEx s -> char '/' <> ftext s <> char '/' JHash m | isNullUniqMap m -> text "{}" - | otherwise -> braceNest . hsep . punctuate comma . - map (\(x,y) -> squotes (ftext x) <> colon <+> jsToDocR r y) + | otherwise -> braceNest . foldl' (<+?>) empty . punctuate comma . + map (\(x,y) -> char '\'' <> ftext x <> char '\'' <> colon <+?> jsToDocR r y) -- nonDetKeysUniqMap doesn't introduce non-determinism here -- because we sort the elements lexically $ sortOn (LexicalFastString . fst) (nonDetUniqMapToList m) - JFunc is b -> parens $ hangBrace (text "function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) + JFunc is b -> parens $ hangBrace (text "function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) -defRenderJsI :: RenderJs -> Ident -> Doc +defRenderJsI :: JsRender doc => RenderJs doc -> Ident -> doc defRenderJsI _ (TxtI t) = ftext t aOpText :: AOp -> FastString @@ -298,17 +301,17 @@ isAlphaOp = \case VoidOp -> True _ -> False -pprStringLit :: FastString -> Doc -pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] +pprStringLit :: IsLine doc => FastString -> doc +pprStringLit s = char '\"' <> encodeJson s <> char '\"' -------------------------------------------------------------------------------- -- Utilities -------------------------------------------------------------------------------- -encodeJson :: FastString -> Doc +encodeJson :: IsLine doc => FastString -> doc encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) -encodeJsonChar :: Char -> Doc +encodeJsonChar :: IsLine doc => Char -> doc encodeJsonChar = \case '/' -> text "\\/" '\b' -> text "\\b" @@ -329,24 +332,64 @@ encodeJsonChar = \case let h = showHex cp "" in text (prefix ++ replicate (pad - length h) '0' ++ h) -braceNest :: Doc -> Doc -braceNest x = char '{' <+> nest 2 x $$ char '}' +-- braceNest :: IsLine doc => doc -> doc +-- braceNest x = dualsLine (\Refl -> lbrace $$ nest 2 x $$ rbrace) (\Refl -> braces x) -interSemi :: [Doc] -> [Doc] -interSemi [] = [] -interSemi [s] = [s] -interSemi (x:xs) = x <> text ";" : interSemi xs +interSemi :: JsRender doc => [doc] -> doc +interSemi = foldl ($$$) empty . punctuateFinal semi semi -addSemi :: Doc -> Doc -addSemi x = x <> text ";" +addSemi :: IsLine doc => doc -> doc +addSemi x = x <> semi <> char '\n' -- | Hang with braces: -- -- hdr { -- body -- } -hangBrace :: Doc -> Doc -> Doc -hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] - -($$$) :: Doc -> Doc -> Doc -x $$$ y = nest 2 $ x $+$ y +-- hangBrace :: IsLine doc => doc -> doc -> doc +-- hangBrace hdr body = dualsLine +-- (\Refl -> hdr <+> braces (nest 2 $ ppr body)) +-- (\Refl -> hdr <> braces body) + +-- ($$$) :: IsLine doc => doc -> doc -> doc +-- x $$$ y = dualsLine (\Refl -> x $$ y) (\Refl -> x <> y) + +-- (<+?>) :: IsLine doc => doc -> doc -> doc +-- x <+?> y = dualsLine (\Refl -> x <+> y) (\Refl -> x <> y) + + +class IsLine doc => JsRender doc where + (<+?>) :: doc -> doc -> doc + ($$$) :: doc -> doc -> doc + hangBrace :: doc -> doc -> doc + braceNest :: doc -> doc + jcat :: [doc] -> doc + jnest :: doc -> doc + +instance JsRender SDoc where + (<+?>) = (<+>) + {-# INLINE (<+?>) #-} + ($$$) = ($$) + {-# INLINE ($$$) #-} + hangBrace hdr body = hdr <+> lbrace $$ nest 2 (ppr body) $$ rbrace + {-# INLINE hangBrace #-} + braceNest x = lbrace $$ nest 2 x $$ rbrace + {-# INLINE braceNest #-} + jcat = vcat + {-# INLINE jcat #-} + jnest = nest 2 + {-# INLINE jnest #-} + +instance JsRender HLine where + (<+?>) = (<>) + {-# INLINE (<+?>) #-} + ($$$) = (<>) + {-# INLINE ($$$) #-} + hangBrace hdr body = hdr <> braces body + {-# INLINE hangBrace #-} + braceNest = braces + {-# INLINE braceNest #-} + jcat = hcat + {-# INLINE jcat #-} + jnest = id + {-# INLINE jnest #-} ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -91,7 +91,7 @@ stgToJS logger config stg_binds0 this_mod spt_entries foreign_stubs cccs output_ -- Doc to dump when -ddump-js is enabled when (logHasDumpFlag logger Opt_D_dump_js) $ do putDumpFileMaybe logger Opt_D_dump_js "JavaScript code" FormatJS - $ vcat (fmap (docToSDoc . jsToDoc . oiStat . luObjUnit) lus) + $ vcat (fmap (jsToDoc . oiStat . luObjUnit) lus) -- Write the object file bh <- openBinMem (4 * 1024 * 1000) -- a bit less than 4kB ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Unit.Types import GHC.Unit.Module (moduleStableString) import GHC.Utils.Outputable hiding ((<>)) +import GHC.Utils.BufHandle import GHC.Utils.Panic import GHC.Utils.Error import GHC.Utils.Logger (Logger, logVerbAtLeast) @@ -80,7 +81,6 @@ import Control.Monad import Data.Array import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import Data.Function (on) @@ -118,6 +118,9 @@ newtype ArchiveState = ArchiveState { loadedArchives :: IORef (Map FilePath Ar.A emptyArchiveState :: IO ArchiveState emptyArchiveState = ArchiveState <$> newIORef M.empty +defaultJsContext :: SDocContext +defaultJsContext = defaultSDocContext{sdocStyle = PprCode} + jsLinkBinary :: JSLinkConfig -> StgToJSConfig @@ -173,7 +176,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- LTO + rendering of JS code link_stats <- withBinaryFile (out "out.js") WriteMode $ \h -> - renderLinker h mods jsFiles + renderLinker h (csPrettyRender cfg) mods jsFiles ------------------------------------------------------------- @@ -194,8 +197,13 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do - BL.writeFile (out "rts.js") ( BLC.pack rtsDeclsText - <> BLC.pack (rtsText cfg)) + if csPrettyRender cfg + then withFile (out "rts.js") WriteMode $ \h -> + printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) + else withFile (out "rts.js") WriteMode $ \h -> do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) + bFlush bh -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -302,10 +310,11 @@ data CompactedModuleCode = CompactedModuleCode -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle + -> Bool -- ^ should we render readable JS for debugging? -> [ModuleCode] -- ^ linked code per module -> [FilePath] -- ^ additional JS files -> IO LinkerStats -renderLinker h mods jsFiles = do +renderLinker h render_pretty mods jsFiles = do -- link modules let (compacted_mods, meta) = linkModules mods @@ -314,8 +323,13 @@ renderLinker h mods jsFiles = do putBS = B.hPut h putJS x = do before <- hTell h - Ppr.printLeftRender h (pretty x) - hPutChar h '\n' + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) + bFlush bh after <- hTell h pure $! (after - before) ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -31,7 +31,7 @@ import GHC.Exts import GHC.JS.Syntax import GHC.JS.Ppr -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map @@ -39,10 +39,10 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JStat -> Doc +pretty :: JsRender doc => JStat -> doc pretty = jsToDocR ghcjsRenderJs -ghcjsRenderJs :: RenderJs +ghcjsRenderJs :: RenderJs doc ghcjsRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS @@ -52,7 +52,7 @@ ghcjsRenderJs = defaultRenderJs hdd :: SBS.ShortByteString hdd = SBS.pack (map (fromIntegral . ord) "h$$") -ghcjsRenderJsI :: RenderJs -> Ident -> Doc +ghcjsRenderJsI :: IsLine doc => RenderJs doc -> Ident -> doc ghcjsRenderJsI _ (TxtI fs) -- Fresh symbols are prefixed with "h$$". They aren't explicitly referred by -- name in user code, only in compiled code. Hence we can rename them if we do @@ -75,7 +75,7 @@ ghcjsRenderJsI _ (TxtI fs) -- | Render as an hexadecimal number in reversed order (because it's faster and we -- don't care about the actual value). -hexDoc :: Word -> Doc +hexDoc :: IsLine doc => Word -> doc hexDoc 0 = char '0' hexDoc v = text $ go v where @@ -91,23 +91,23 @@ hexDoc v = text $ go v -- attempt to resugar some of the common constructs -ghcjsRenderJsS :: RenderJs -> JStat -> Doc +ghcjsRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc ghcjsRenderJsS r s = renderJsS defaultRenderJs r s -- don't quote keys in our object literals, so closure compiler works -ghcjsRenderJsV :: RenderJs -> JVal -> Doc +ghcjsRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc ghcjsRenderJsV r (JHash m) | isNullUniqMap m = text "{}" - | otherwise = braceNest . PP.fsep . punctuate comma . - map (\(x,y) -> quoteIfRequired x <> PP.colon <+> jsToDocR r y) + | otherwise = braceNest . fsep . punctuate comma . + map (\(x,y) -> quoteIfRequired x <> colon <+> jsToDocR r y) -- nonDetEltsUniqMap doesn't introduce non-determinism here because -- we sort the elements lexically . sortOn (LexicalFastString . fst) $ nonDetUniqMapToList m where - quoteIfRequired :: FastString -> Doc + quoteIfRequired :: IsLine doc => FastString -> doc quoteIfRequired x | isUnquotedKey x = ftext x - | otherwise = PP.squotes (ftext x) + | otherwise = char '\'' <> ftext x <> char '\'' isUnquotedKey :: FastString -> Bool isUnquotedKey fs = case unpackFS fs of ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -O0 #-} @@ -45,6 +46,7 @@ import GHC.StgToJS.Linker.Opt import GHC.Data.FastString import GHC.Types.Unique.Map +import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -314,12 +316,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRets] -- | print the embedded RTS to a String -rtsText :: StgToJSConfig -> String -rtsText = show . pretty . jsOptimize . rts +rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc +rtsText = pretty @doc . jsOptimize . rts -- | print the RTS declarations to a String. -rtsDeclsText :: String -rtsDeclsText = show . pretty . jsOptimize $ rtsDecls +rtsDeclsText :: forall doc. JsRender doc => doc +rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' rts :: StgToJSConfig -> Sat.JStat ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -86,6 +86,7 @@ data StgToJSConfig = StgToJSConfig , csInlineLoadRegs :: !Bool , csInlineEnter :: !Bool , csInlineAlloc :: !Bool + , csPrettyRender :: !Bool , csTraceRts :: !Bool , csAssertRts :: !Bool , csBoundsCheck :: !Bool ===================================== docs/users_guide/debugging.rst ===================================== @@ -723,6 +723,16 @@ assembler. Dump the final JavaScript code produced by the JavaScript code generator. +JavaScript code generator +~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. ghc-flag:: -ddisable-js-minifier + :shortdec: Generate JavaScript code with whitespace + :type: dynamic + + Include human-readable spacing and indentation when generating JavaScript. + + Miscellaneous backend dumps ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9dd4f3152b1e91c2c596591a87262570a3e7ebd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9dd4f3152b1e91c2c596591a87262570a3e7ebd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 11:31:37 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 24 May 2023 07:31:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/9.2.8 Message-ID: <646df59982927_9760abedc093816750fe@gitlab.mail> Zubin pushed new branch wip/9.2.8 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/9.2.8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 11:34:00 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 24 May 2023 07:34:00 -0400 Subject: [Git][ghc/ghc][wip/9.2.8] Prepare release 9.2.8 Message-ID: <646df6289da39_9760a9699d5cc1677080@gitlab.mail> Zubin pushed to branch wip/9.2.8 at Glasgow Haskell Compiler / GHC Commits: b466a972 by Zubin Duggal at 2023-05-24T17:03:50+05:30 Prepare release 9.2.8 - - - - - 3 changed files: - configure.ac - + docs/users_guide/9.2.8-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.7], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.8], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058) ===================================== docs/users_guide/9.2.8-notes.rst ===================================== @@ -0,0 +1,62 @@ +.. _release-9-2-8: + +Version 9.2.8 +============== + +The significant changes to the various parts of the compiler are listed in the +following sections. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +9, 10, 11, or 12. + +Compiler +-------- + +- Fix a bug with RTS linker failing with 'internal error: m32_allocator_init: + Failed to map' on newer Linux kernels (:ghc-ticket:`19421`). + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/libiserv/libiserv.cabal: Internal compiler library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + + ===================================== docs/users_guide/release-notes.rst ===================================== @@ -11,3 +11,4 @@ Release notes 9.2.5-notes 9.2.6-notes 9.2.7-notes + 9.2.8-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b466a97211b0bcb6a191a638063e94cd26767bcd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b466a97211b0bcb6a191a638063e94cd26767bcd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 11:34:52 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 24 May 2023 07:34:52 -0400 Subject: [Git][ghc/ghc][wip/9.2.8] Prepare release 9.2.8 Message-ID: <646df65c56614_9760abedc093816773d5@gitlab.mail> Zubin pushed to branch wip/9.2.8 at Glasgow Haskell Compiler / GHC Commits: 28d61a2c by Zubin Duggal at 2023-05-24T17:04:40+05:30 Prepare release 9.2.8 - - - - - 3 changed files: - configure.ac - + docs/users_guide/9.2.8-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.7], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.8], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058) ===================================== docs/users_guide/9.2.8-notes.rst ===================================== @@ -0,0 +1,62 @@ +.. _release-9-2-8: + +Version 9.2.8 +============== + +The significant changes to the various parts of the compiler are listed in the +following sections. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +9, 10, 11, or 12. + +Runtime system +-------------- + +- Fix a bug with RTS linker failing with 'internal error: m32_allocator_init: + Failed to map' on newer Linux kernels (:ghc-ticket:`19421`). + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/libiserv/libiserv.cabal: Internal compiler library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + + ===================================== docs/users_guide/release-notes.rst ===================================== @@ -11,3 +11,4 @@ Release notes 9.2.5-notes 9.2.6-notes 9.2.7-notes + 9.2.8-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28d61a2cf667f6fc143d15c53272ec09dcb2b3f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28d61a2cf667f6fc143d15c53272ec09dcb2b3f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 11:44:16 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 24 May 2023 07:44:16 -0400 Subject: [Git][ghc/ghc][wip/js-hline] JS: Convert rendering to use HLine instead of SDoc (#22455) Message-ID: <646df8909572b_9760a9f7c972416803ba@gitlab.mail> Josh Meredith pushed to branch wip/js-hline at Glasgow Haskell Compiler / GHC Commits: dfb47563 by Josh Meredith at 2023-05-24T11:43:55+00:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - 11 changed files: - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - docs/users_guide/debugging.rst Changes: ===================================== compiler/GHC/Driver/Config/StgToJS.hs ===================================== @@ -20,6 +20,7 @@ initStgToJSConfig dflags = StgToJSConfig , csInlineLoadRegs = False , csInlineEnter = False , csInlineAlloc = False + , csPrettyRender = gopt Opt_DisableJsMinifier dflags , csTraceRts = False , csAssertRts = False , csBoundsCheck = gopt Opt_DoBoundsChecking dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -314,6 +314,9 @@ data GeneralFlag | Opt_WriteInterface -- forces .hi files to be written even with -fno-code | Opt_WriteHie -- generate .hie files + -- JavaScript opts + | Opt_DisableJsMinifier -- render JavaScript using a pretty-printed SDoc rather than compact a HLine + -- profiling opts | Opt_AutoSccsOnIndividualCafs | Opt_ProfCountEntries ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1859,6 +1859,10 @@ dynamic_flags_deps = [ , (NotDeprecated, customOrUnrecognisedWarning "W" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fwarn-" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fno-warn-" unSetCustomWarningFlag) + ] + + ------ JavaScript flags ----------------------------------------------- + ++ [ make_ord_flag defFlag "ddisable-js-minifier" (NoArg (setGeneralFlag Opt_DisableJsMinifier)) ] ------ Language flags ------------------------------------------------- ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -184,7 +184,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv ) <> semi _ -> empty - strlit xs = docToSDoc (pprStringLit xs) + strlit xs = pprStringLit xs -- the target which will form the root of what we ask rts_evalIO to run the_cfun ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TypeApplications #-} -- For Outputable instances for JS syntax {-# OPTIONS_GHC -Wno-orphans #-} @@ -55,10 +56,9 @@ module GHC.JS.Ppr , JsToDoc(..) , defaultRenderJs , RenderJs(..) + , JsRender(..) , jsToDoc , pprStringLit - , braceNest - , hangBrace , interSemi , addSemi ) @@ -75,16 +75,15 @@ import Data.List (sortOn) import Numeric(showHex) -import GHC.Utils.Outputable (Outputable (..), docToSDoc) -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map instance Outputable JExpr where - ppr = docToSDoc . renderJs + ppr = renderJs instance Outputable JVal where - ppr = docToSDoc . renderJs + ppr = renderJs -------------------------------------------------------------------------------- -- Top level API @@ -93,87 +92,86 @@ instance Outputable JVal where -- | Render a syntax tree as a pretty-printable document -- (simply showing the resultant doc produces a nice, -- well formatted String). -renderJs :: (JsToDoc a) => a -> Doc +renderJs :: (JsToDoc a) => a -> SDoc renderJs = renderJs' defaultRenderJs -renderJs' :: (JsToDoc a) => RenderJs -> a -> Doc +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs HLine -> a -> HLine #-} +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs SDoc -> a -> SDoc #-} +renderJs' :: (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc renderJs' r = jsToDocR r -data RenderJs = RenderJs - { renderJsS :: !(RenderJs -> JStat -> Doc) - , renderJsE :: !(RenderJs -> JExpr -> Doc) - , renderJsV :: !(RenderJs -> JVal -> Doc) - , renderJsI :: !(RenderJs -> Ident -> Doc) +data RenderJs doc = RenderJs + { renderJsS :: !(JsRender doc => RenderJs doc -> JStat -> doc) + , renderJsE :: !(JsRender doc => RenderJs doc -> JExpr -> doc) + , renderJsV :: !(JsRender doc => RenderJs doc -> JVal -> doc) + , renderJsI :: !(JsRender doc => RenderJs doc -> Ident -> doc) } -defaultRenderJs :: RenderJs +defaultRenderJs :: RenderJs doc defaultRenderJs = RenderJs defRenderJsS defRenderJsE defRenderJsV defRenderJsI -jsToDoc :: JsToDoc a => a -> Doc +jsToDoc :: JsToDoc a => a -> SDoc jsToDoc = jsToDocR defaultRenderJs -- | Render a syntax tree as a pretty-printable document, using a given prefix -- to all generated names. Use this with distinct prefixes to ensure distinct -- generated names between independent calls to render(Prefix)Js. -renderPrefixJs :: (JsToDoc a, JMacro a) => a -> Doc +renderPrefixJs :: (JsToDoc a, JMacro a) => a -> SDoc renderPrefixJs = renderPrefixJs' defaultRenderJs -renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc +renderPrefixJs' :: (JsToDoc a, JMacro a, JsRender doc) => RenderJs doc -> a -> doc renderPrefixJs' r = jsToDocR r -------------------------------------------------------------------------------- -- Code Generator -------------------------------------------------------------------------------- -class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc +class JsToDoc a where jsToDocR :: JsRender doc => RenderJs doc -> a -> doc instance JsToDoc JStat where jsToDocR r = renderJsS r r instance JsToDoc JExpr where jsToDocR r = renderJsE r r instance JsToDoc JVal where jsToDocR r = renderJsV r r instance JsToDoc Ident where jsToDocR r = renderJsI r r -instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) -instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc [JExpr] where jsToDocR r = jcat . map (addSemi . jsToDocR r) +instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) -defRenderJsS :: RenderJs -> JStat -> Doc +defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <> parens (jsToDocR r cond)) - (jsToDocR r x) - $$ mbElse - where mbElse | y == BlockStat [] = PP.empty - | otherwise = hangBrace (text "else") (jsToDocR r y) + IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) + (jnest $ optBlock r x) + <+?> mbElse + where mbElse | y == BlockStat [] = empty + | otherwise = hangBrace (text "else") (jnest $ optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x - DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+> char '=' <+> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <> parens (jsToDocR r p)) (jsToDocR r b) - WhileStat True p b -> (hangBrace (text "do") (jsToDocR r b)) $+$ text "while" <+> parens (jsToDocR r p) - BreakStat l -> maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l - ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l - LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s + DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) + WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l + ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l + LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s where - printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss + printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) where - forCond = parens $ hcat $ interSemi - [ jsToDocR r init - , jsToDocR r p - , parens (jsToDocR r s1) - ] - ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) + forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) where txt | each = "for each" | otherwise = "for" - SwitchStat e l d -> hangBrace (text "switch" <+> parens (jsToDocR r e)) cases - where l' = map (\(c,s) -> (text "case" <+> parens (jsToDocR r c) <> char ':') $$$ (jsToDocR r s)) l ++ [text "default:" $$$ (jsToDocR r d)] - cases = vcat l' + SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases + where l' = map (\(c,s) -> (text "case" <+?> parens (jsToDocR r c) <> colon) $$$ jnest (optBlock r s)) l + ++ [(text "default:") $$$ jnest (optBlock r d)] + cases = foldl1 ($$$) l' ReturnStat e -> text "return" <+> jsToDocR r e - ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) + ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i - <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) - (jsToDocR r b) - TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally - where mbCatch | s1 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) - mbFinally | s2 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "finally") (jsToDocR r s2) + <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) + (jnest $ optBlock r b) + TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally + where mbCatch | s1 == BlockStat [] = empty + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + mbFinally | s2 == BlockStat [] = empty + | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. @@ -183,36 +181,41 @@ defRenderJsS r = \case -- ... -- }); -- - ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] - _ -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x + ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs -optParens :: RenderJs -> JExpr -> Doc +optBlock :: JsRender doc => RenderJs doc -> JStat -> doc +optBlock r x = case x of + BlockStat{} -> jsToDocR r x + _ -> addSemi $ jsToDocR r x + +optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of UOpExpr _ _ -> parens (jsToDocR r x) _ -> jsToDocR r x -defRenderJsE :: RenderJs -> JExpr -> Doc +defRenderJsE :: JsRender doc => RenderJs doc -> JExpr -> doc defRenderJsE r = \case ValExpr x -> jsToDocR r x SelExpr x y -> jsToDocR r x <> char '.' <> jsToDocR r y IdxExpr x y -> jsToDocR r x <> brackets (jsToDocR r y) - IfExpr x y z -> parens (jsToDocR r x <+> char '?' <+> jsToDocR r y <+> char ':' <+> jsToDocR r z) - InfixExpr op x y -> parens $ hsep [jsToDocR r x, ftext (opText op), jsToDocR r y] + IfExpr x y z -> parens (jsToDocR r x <+?> char '?' <+?> jsToDocR r y <+?> colon <+?> jsToDocR r z) + InfixExpr op x y -> parens $ jsToDocR r x <+?> ftext (opText op) <+?> jsToDocR r y UOpExpr op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) - ApplExpr je xs -> jsToDocR r je <> (parens . hsep . punctuate comma $ map (jsToDocR r) xs) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) + ApplExpr je xs -> jsToDocR r je <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs) -defRenderJsV :: RenderJs -> JVal -> Doc +defRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc defRenderJsV r = \case JVar i -> jsToDocR r i - JList xs -> brackets . hsep . punctuate comma $ map (jsToDocR r) xs + JList xs -> brackets . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs JDouble (SaneDouble d) | d < 0 || isNegativeZero d -> parens (double d) | otherwise -> double d @@ -220,17 +223,17 @@ defRenderJsV r = \case | i < 0 -> parens (integer i) | otherwise -> integer i JStr s -> pprStringLit s - JRegEx s -> hcat [char '/',ftext s, char '/'] + JRegEx s -> char '/' <> ftext s <> char '/' JHash m | isNullUniqMap m -> text "{}" - | otherwise -> braceNest . hsep . punctuate comma . - map (\(x,y) -> squotes (ftext x) <> colon <+> jsToDocR r y) + | otherwise -> braceNest . foldl' (<+?>) empty . punctuate comma . + map (\(x,y) -> char '\'' <> ftext x <> char '\'' <> colon <+?> jsToDocR r y) -- nonDetKeysUniqMap doesn't introduce non-determinism here -- because we sort the elements lexically $ sortOn (LexicalFastString . fst) (nonDetUniqMapToList m) - JFunc is b -> parens $ hangBrace (text "function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) + JFunc is b -> parens $ hangBrace (text "function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) -defRenderJsI :: RenderJs -> Ident -> Doc +defRenderJsI :: JsRender doc => RenderJs doc -> Ident -> doc defRenderJsI _ (TxtI t) = ftext t aOpText :: AOp -> FastString @@ -298,17 +301,17 @@ isAlphaOp = \case VoidOp -> True _ -> False -pprStringLit :: FastString -> Doc -pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] +pprStringLit :: IsLine doc => FastString -> doc +pprStringLit s = char '\"' <> encodeJson s <> char '\"' -------------------------------------------------------------------------------- -- Utilities -------------------------------------------------------------------------------- -encodeJson :: FastString -> Doc +encodeJson :: IsLine doc => FastString -> doc encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) -encodeJsonChar :: Char -> Doc +encodeJsonChar :: IsLine doc => Char -> doc encodeJsonChar = \case '/' -> text "\\/" '\b' -> text "\\b" @@ -329,24 +332,64 @@ encodeJsonChar = \case let h = showHex cp "" in text (prefix ++ replicate (pad - length h) '0' ++ h) -braceNest :: Doc -> Doc -braceNest x = char '{' <+> nest 2 x $$ char '}' +-- braceNest :: IsLine doc => doc -> doc +-- braceNest x = dualsLine (\Refl -> lbrace $$ nest 2 x $$ rbrace) (\Refl -> braces x) -interSemi :: [Doc] -> [Doc] -interSemi [] = [] -interSemi [s] = [s] -interSemi (x:xs) = x <> text ";" : interSemi xs +interSemi :: JsRender doc => [doc] -> doc +interSemi = foldl ($$$) empty . punctuateFinal semi semi -addSemi :: Doc -> Doc -addSemi x = x <> text ";" +addSemi :: IsLine doc => doc -> doc +addSemi x = x <> semi <> char '\n' -- | Hang with braces: -- -- hdr { -- body -- } -hangBrace :: Doc -> Doc -> Doc -hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] - -($$$) :: Doc -> Doc -> Doc -x $$$ y = nest 2 $ x $+$ y +-- hangBrace :: IsLine doc => doc -> doc -> doc +-- hangBrace hdr body = dualsLine +-- (\Refl -> hdr <+> braces (nest 2 $ ppr body)) +-- (\Refl -> hdr <> braces body) + +-- ($$$) :: IsLine doc => doc -> doc -> doc +-- x $$$ y = dualsLine (\Refl -> x $$ y) (\Refl -> x <> y) + +-- (<+?>) :: IsLine doc => doc -> doc -> doc +-- x <+?> y = dualsLine (\Refl -> x <+> y) (\Refl -> x <> y) + + +class IsLine doc => JsRender doc where + (<+?>) :: doc -> doc -> doc + ($$$) :: doc -> doc -> doc + hangBrace :: doc -> doc -> doc + braceNest :: doc -> doc + jcat :: [doc] -> doc + jnest :: doc -> doc + +instance JsRender SDoc where + (<+?>) = (<+>) + {-# INLINE (<+?>) #-} + ($$$) = ($$) + {-# INLINE ($$$) #-} + hangBrace hdr body = hdr <+> lbrace $$ nest 2 (ppr body) $$ rbrace + {-# INLINE hangBrace #-} + braceNest x = lbrace $$ nest 2 x $$ rbrace + {-# INLINE braceNest #-} + jcat = vcat + {-# INLINE jcat #-} + jnest = nest 2 + {-# INLINE jnest #-} + +instance JsRender HLine where + (<+?>) = (<>) + {-# INLINE (<+?>) #-} + ($$$) = (<>) + {-# INLINE ($$$) #-} + hangBrace hdr body = hdr <> braces body + {-# INLINE hangBrace #-} + braceNest = braces + {-# INLINE braceNest #-} + jcat = hcat + {-# INLINE jcat #-} + jnest = id + {-# INLINE jnest #-} ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -91,7 +91,7 @@ stgToJS logger config stg_binds0 this_mod spt_entries foreign_stubs cccs output_ -- Doc to dump when -ddump-js is enabled when (logHasDumpFlag logger Opt_D_dump_js) $ do putDumpFileMaybe logger Opt_D_dump_js "JavaScript code" FormatJS - $ vcat (fmap (docToSDoc . jsToDoc . oiStat . luObjUnit) lus) + $ vcat (fmap (jsToDoc . oiStat . luObjUnit) lus) -- Write the object file bh <- openBinMem (4 * 1024 * 1000) -- a bit less than 4kB ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Unit.Types import GHC.Unit.Module (moduleStableString) import GHC.Utils.Outputable hiding ((<>)) +import GHC.Utils.BufHandle import GHC.Utils.Panic import GHC.Utils.Error import GHC.Utils.Logger (Logger, logVerbAtLeast) @@ -80,7 +81,6 @@ import Control.Monad import Data.Array import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import Data.Function (on) @@ -118,6 +118,9 @@ newtype ArchiveState = ArchiveState { loadedArchives :: IORef (Map FilePath Ar.A emptyArchiveState :: IO ArchiveState emptyArchiveState = ArchiveState <$> newIORef M.empty +defaultJsContext :: SDocContext +defaultJsContext = defaultSDocContext{sdocStyle = PprCode} + jsLinkBinary :: JSLinkConfig -> StgToJSConfig @@ -173,7 +176,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- LTO + rendering of JS code link_stats <- withBinaryFile (out "out.js") WriteMode $ \h -> - renderLinker h mods jsFiles + renderLinker h (csPrettyRender cfg) mods jsFiles ------------------------------------------------------------- @@ -194,8 +197,13 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do - BL.writeFile (out "rts.js") ( BLC.pack rtsDeclsText - <> BLC.pack (rtsText cfg)) + if csPrettyRender cfg + then withFile (out "rts.js") WriteMode $ \h -> + printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) + else withFile (out "rts.js") WriteMode $ \h -> do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) + bFlush bh -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -302,10 +310,11 @@ data CompactedModuleCode = CompactedModuleCode -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle + -> Bool -- ^ should we render readable JS for debugging? -> [ModuleCode] -- ^ linked code per module -> [FilePath] -- ^ additional JS files -> IO LinkerStats -renderLinker h mods jsFiles = do +renderLinker h render_pretty mods jsFiles = do -- link modules let (compacted_mods, meta) = linkModules mods @@ -314,8 +323,13 @@ renderLinker h mods jsFiles = do putBS = B.hPut h putJS x = do before <- hTell h - Ppr.printLeftRender h (pretty x) - hPutChar h '\n' + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) + bFlush bh after <- hTell h pure $! (after - before) ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -31,7 +31,7 @@ import GHC.Exts import GHC.JS.Syntax import GHC.JS.Ppr -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map @@ -39,10 +39,10 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JStat -> Doc +pretty :: JsRender doc => JStat -> doc pretty = jsToDocR ghcjsRenderJs -ghcjsRenderJs :: RenderJs +ghcjsRenderJs :: RenderJs doc ghcjsRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS @@ -52,7 +52,7 @@ ghcjsRenderJs = defaultRenderJs hdd :: SBS.ShortByteString hdd = SBS.pack (map (fromIntegral . ord) "h$$") -ghcjsRenderJsI :: RenderJs -> Ident -> Doc +ghcjsRenderJsI :: IsLine doc => RenderJs doc -> Ident -> doc ghcjsRenderJsI _ (TxtI fs) -- Fresh symbols are prefixed with "h$$". They aren't explicitly referred by -- name in user code, only in compiled code. Hence we can rename them if we do @@ -75,7 +75,7 @@ ghcjsRenderJsI _ (TxtI fs) -- | Render as an hexadecimal number in reversed order (because it's faster and we -- don't care about the actual value). -hexDoc :: Word -> Doc +hexDoc :: IsLine doc => Word -> doc hexDoc 0 = char '0' hexDoc v = text $ go v where @@ -91,23 +91,23 @@ hexDoc v = text $ go v -- attempt to resugar some of the common constructs -ghcjsRenderJsS :: RenderJs -> JStat -> Doc +ghcjsRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc ghcjsRenderJsS r s = renderJsS defaultRenderJs r s -- don't quote keys in our object literals, so closure compiler works -ghcjsRenderJsV :: RenderJs -> JVal -> Doc +ghcjsRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc ghcjsRenderJsV r (JHash m) | isNullUniqMap m = text "{}" - | otherwise = braceNest . PP.fsep . punctuate comma . - map (\(x,y) -> quoteIfRequired x <> PP.colon <+> jsToDocR r y) + | otherwise = braceNest . fsep . punctuate comma . + map (\(x,y) -> quoteIfRequired x <> colon <+> jsToDocR r y) -- nonDetEltsUniqMap doesn't introduce non-determinism here because -- we sort the elements lexically . sortOn (LexicalFastString . fst) $ nonDetUniqMapToList m where - quoteIfRequired :: FastString -> Doc + quoteIfRequired :: IsLine doc => FastString -> doc quoteIfRequired x | isUnquotedKey x = ftext x - | otherwise = PP.squotes (ftext x) + | otherwise = char '\'' <> ftext x <> char '\'' isUnquotedKey :: FastString -> Bool isUnquotedKey fs = case unpackFS fs of ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -O0 #-} @@ -45,6 +46,7 @@ import GHC.StgToJS.Linker.Opt import GHC.Data.FastString import GHC.Types.Unique.Map +import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -314,12 +316,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRets] -- | print the embedded RTS to a String -rtsText :: StgToJSConfig -> String -rtsText = show . pretty . jsOptimize . rts +rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc +rtsText = pretty @doc . jsOptimize . rts -- | print the RTS declarations to a String. -rtsDeclsText :: String -rtsDeclsText = show . pretty . jsOptimize $ rtsDecls +rtsDeclsText :: forall doc. JsRender doc => doc +rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' rts :: StgToJSConfig -> Sat.JStat ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -86,6 +86,7 @@ data StgToJSConfig = StgToJSConfig , csInlineLoadRegs :: !Bool , csInlineEnter :: !Bool , csInlineAlloc :: !Bool + , csPrettyRender :: !Bool , csTraceRts :: !Bool , csAssertRts :: !Bool , csBoundsCheck :: !Bool ===================================== docs/users_guide/debugging.rst ===================================== @@ -723,6 +723,16 @@ assembler. Dump the final JavaScript code produced by the JavaScript code generator. +JavaScript code generator +~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. ghc-flag:: -ddisable-js-minifier + :shortdesc: Generate JavaScript code with whitespace + :type: dynamic + + Include human-readable spacing and indentation when generating JavaScript. + + Miscellaneous backend dumps ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfb475635b61a4f7d14a07d74e0b8ec9618f8fd3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfb475635b61a4f7d14a07d74e0b8ec9618f8fd3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 13:31:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 09:31:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 19 commits: testsuite: Add tests for #23146 Message-ID: <646e11a37222c_9760aa80d57c01717615@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - c642ef22 by hainq at 2023-05-24T09:31:00-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 31eb6f67 by Krzysztof Gogolewski at 2023-05-24T09:31:01-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - 2eac0ec1 by Matthew Pickering at 2023-05-24T09:31:01-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - fc24075a by Matthew Pickering at 2023-05-24T09:31:02-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - 779e187a by Matthew Pickering at 2023-05-24T09:31:02-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - e44cbd9c by Ben Gamari at 2023-05-24T09:31:02-04:00 users guide: A few small mark-up fixes - - - - - d902e9c5 by Rodrigo Mesquita at 2023-05-24T09:31:03-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - 6f95aed7 by mangoiv at 2023-05-24T09:31:06-04:00 [feat] add .direnv to the .gitignore file - - - - - 30 changed files: - .gitignore - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21bd0c5d7ebabc5ee578de9ca998665bb062d44a...6f95aed749bb90574be538e434d4f55cdb7705ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21bd0c5d7ebabc5ee578de9ca998665bb062d44a...6f95aed749bb90574be538e434d4f55cdb7705ac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 14:02:19 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 24 May 2023 10:02:19 -0400 Subject: [Git][ghc/ghc][wip/9.2.8] Prepare release 9.2.8 Message-ID: <646e18ebc9bec_9760a9f97d23c17409d8@gitlab.mail> Zubin pushed to branch wip/9.2.8 at Glasgow Haskell Compiler / GHC Commits: b361bcb0 by Zubin Duggal at 2023-05-24T19:31:59+05:30 Prepare release 9.2.8 Allow metric changes for 9.2.8 as baseline is from a release pipeline Metric Decrease: haddock.base haddock.Cabal haddock.compiler Metric Increase: ManyAlternatives ManyConstructors T10421 T10858 T12227 T12425 T12707 T13035 T13253 T13719 T15164 T16577 T18304 T18698a T18698b T3294 T5321FD T5642 T9203 T9233 T9630 T9872a T9872b T9872c T9872d T14697 T12545 T1969 parsing001 - - - - - 3 changed files: - configure.ac - + docs/users_guide/9.2.8-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.7], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.8], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058) ===================================== docs/users_guide/9.2.8-notes.rst ===================================== @@ -0,0 +1,62 @@ +.. _release-9-2-8: + +Version 9.2.8 +============== + +The significant changes to the various parts of the compiler are listed in the +following sections. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +9, 10, 11, or 12. + +Runtime system +-------------- + +- Fix a bug with RTS linker failing with 'internal error: m32_allocator_init: + Failed to map' on newer Linux kernels (:ghc-ticket:`19421`). + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/libiserv/libiserv.cabal: Internal compiler library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + + ===================================== docs/users_guide/release-notes.rst ===================================== @@ -11,3 +11,4 @@ Release notes 9.2.5-notes 9.2.6-notes 9.2.7-notes + 9.2.8-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b361bcb04ff46aaac0e4534b695b715b7c39be98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b361bcb04ff46aaac0e4534b695b715b7c39be98 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 14:55:45 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 24 May 2023 10:55:45 -0400 Subject: [Git][ghc/ghc][wip/unitidset] 128 commits: Add sized primitive literal syntax Message-ID: <646e25711c68a_64cfbc2d44422d@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 6f93a65c by Josh Meredith at 2023-05-24T14:54:38+00:00 Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ddbb211eb3625cfbc8fe5a7f55fef1ee2cea34d8...6f93a65c3780948a175e0eabfe9fdf7e9c5f9b4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ddbb211eb3625cfbc8fe5a7f55fef1ee2cea34d8...6f93a65c3780948a175e0eabfe9fdf7e9c5f9b4a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 15:49:17 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 24 May 2023 11:49:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23355 Message-ID: <646e31fdd2358_64cfbc2d8065425@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23355 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23355 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 15:49:45 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 24 May 2023 11:49:45 -0400 Subject: [Git][ghc/ghc][wip/T23355] Add a test for #23355 Message-ID: <646e321914d56_64cfbc2d08656d@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23355 at Glasgow Haskell Compiler / GHC Commits: 7a51d5f9 by Krzysztof Gogolewski at 2023-05-24T17:49:33+02:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 3 changed files: - + testsuite/tests/ghci/should_run/T22958c.hs - + testsuite/tests/ghci/should_run/T22958c.stdout - testsuite/tests/ghci/should_run/all.T Changes: ===================================== testsuite/tests/ghci/should_run/T22958c.hs ===================================== @@ -0,0 +1,15 @@ +-- Test extracted from text-builder-linear, ticket #23355 +{-# LANGUAGE UnliftedDatatypes #-} +module Main (main) where + +import GHC.Exts (UnliftedType) + +type Buffer :: UnliftedType +data Buffer = Buffer + +main :: IO () +main = case i Buffer of Buffer -> putStrLn "good" + +{-# NOINLINE i #-} +i :: forall (a :: UnliftedType). a -> a +i x = x ===================================== testsuite/tests/ghci/should_run/T22958c.stdout ===================================== @@ -0,0 +1 @@ +good ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -90,3 +90,4 @@ test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], co test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script']) test('T22958a', just_ghci, compile_and_run, ['']) test('T22958b', just_ghci, compile_and_run, ['']) +test('T22958c', just_ghci, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a51d5f918c922ec3b684ce6adfc976664288a82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a51d5f918c922ec3b684ce6adfc976664288a82 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:07:04 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 24 May 2023 12:07:04 -0400 Subject: [Git][ghc/ghc][wip/unitidset] Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) Message-ID: <646e3628b5fb2_64cfbc29987705a@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: 2fb32314 by Josh Meredith at 2023-05-24T16:06:36+00:00 Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) - - - - - 21 changed files: - compiler/GHC.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -395,6 +395,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -418,8 +419,6 @@ import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as S import qualified Data.Sequence as Seq import System.Directory @@ -604,7 +603,7 @@ setSessionDynFlags dflags0 = do logger <- getLogger dflags <- checkNewDynFlags logger dflags0 let all_uids = hsc_all_home_unit_ids hsc_env - case S.toList all_uids of + case uniqDSetToList all_uids of [uid] -> do setUnitDynFlagsNoCheck uid dflags modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags)) @@ -1380,7 +1379,7 @@ data ModuleInfo = ModuleInfo { -- | Request information about a loaded 'Module' getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X getModuleInfo mdl = withSession $ \hsc_env -> do - if moduleUnitId mdl `S.member` hsc_all_home_unit_ids hsc_env + if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env then liftIO $ getHomeModuleInfo hsc_env mdl else liftIO $ getPackageModuleInfo hsc_env mdl @@ -1757,7 +1756,7 @@ isModuleTrusted m = withSession $ \hsc_env -> liftIO $ hscCheckSafe hsc_env m noSrcSpan -- | Return if a module is trusted and the pkgs it depends on to be trusted. -moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId) +moduleTrustReqs :: GhcMonad m => Module -> m (Bool, UnitIdSet) moduleTrustReqs m = withSession $ \hsc_env -> liftIO $ hscGetSafe hsc_env m noSrcSpan ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -56,12 +56,11 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre import GHC.Types.ForeignStubs import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) +import GHC.Types.Unique.DSet import System.Directory import System.FilePath import System.IO -import Data.Set (Set) -import qualified Data.Set as Set {- ************************************************************************ @@ -84,7 +83,7 @@ codeOutput -> (a -> ForeignStubs) -> [(ForeignSrcLang, FilePath)] -- ^ additional files to be compiled with the C compiler - -> Set UnitId -- ^ Dependencies + -> UnitIdSet -- ^ Dependencies -> Stream IO RawCmmGroup a -- Compiled C-- -> IO (FilePath, (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}), @@ -161,11 +160,11 @@ outputC :: Logger -> DynFlags -> FilePath -> Stream IO RawCmmGroup a - -> Set UnitId + -> UnitIdSet -> IO a outputC logger dflags filenm cmm_stream unit_deps = withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do - let pkg_names = map unitIdString (Set.toAscList unit_deps) + let pkg_names = map unitIdString (uniqDSetToAscList unit_deps) doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h "#include \"Stg.h\"\n" ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -127,7 +127,7 @@ hsc_HUE = ue_currentHomeUnitEnv . hsc_unit_env hsc_HUG :: HscEnv -> HomeUnitGraph hsc_HUG = ue_home_unit_graph . hsc_unit_env -hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId +hsc_all_home_unit_ids :: HscEnv -> UnitIdSet hsc_all_home_unit_ids = unitEnv_keys . hsc_HUG hscUpdateHPT_lazy :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -245,6 +245,7 @@ import GHC.Types.Name.Ppr import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.TyThing import GHC.Types.HpcInfo +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint ( Fingerprint ) import GHC.Utils.Panic @@ -274,7 +275,6 @@ import Data.IORef import System.FilePath as FilePath import System.Directory import qualified Data.Set as S -import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) import Data.Bifunctor (first) @@ -1457,15 +1457,15 @@ checkSafeImports tcg_env clearDiagnostics -- Check safe imports are correct - safePkgs <- S.fromList <$> mapMaybeM checkSafe safeImps + safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps safeErrs <- getDiagnostics clearDiagnostics -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] (infErrs, infPkgs) <- case (safeInferOn dflags) of - False -> return (emptyMessages, S.empty) - True -> do infPkgs <- S.fromList <$> mapMaybeM checkSafe regImps + False -> return (emptyMessages, emptyUniqDSet) + True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps infErrs <- getDiagnostics clearDiagnostics return (infErrs, infPkgs) @@ -1516,12 +1516,12 @@ checkSafeImports tcg_env checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l -- what pkg's to add to our trust requirements - pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId -> + pkgTrustReqs :: DynFlags -> UnitIdSet -> UnitIdSet -> Bool -> ImportAvails pkgTrustReqs dflags req inf infPassed | safeInferOn dflags && not (safeHaskellModeEnabled dflags) && infPassed = emptyImportAvails { - imp_trust_pkgs = req `S.union` inf + imp_trust_pkgs = req `unionUniqDSets` inf } pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe = emptyImportAvails @@ -1540,12 +1540,12 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do return $ isEmptyMessages errs -- | Return if a module is trusted and the pkgs it depends on to be trusted. -hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId) +hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, UnitIdSet) hscGetSafe hsc_env m l = runHsc hsc_env $ do (self, pkgs) <- hscCheckSafe' m l good <- isEmptyMessages `fmap` getDiagnostics clearDiagnostics -- don't want them printed... - let pkgs' | Just p <- self = S.insert p pkgs + let pkgs' | Just p <- self = addOneToUniqDSet pkgs p | otherwise = pkgs return (good, pkgs') @@ -1554,7 +1554,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do -- own package be trusted and a list of other packages required to be trusted -- (these later ones haven't been checked) but the own package trust has been. hscCheckSafe' :: Module -> SrcSpan - -> Hsc (Maybe UnitId, Set UnitId) + -> Hsc (Maybe UnitId, UnitIdSet) hscCheckSafe' m l = do hsc_env <- getHscEnv let home_unit = hsc_home_unit hsc_env @@ -1566,7 +1566,7 @@ hscCheckSafe' m l = do -- Not necessary if that is reflected in dependencies | otherwise -> return (Just $ toUnitId (moduleUnit m), pkgs) where - isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId) + isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, UnitIdSet) isModSafe home_unit m l = do hsc_env <- getHscEnv dflags <- getDynFlags @@ -1648,10 +1648,10 @@ hscCheckSafe' m l = do -- | Check the list of packages are trusted. -checkPkgTrust :: Set UnitId -> Hsc () +checkPkgTrust :: UnitIdSet -> Hsc () checkPkgTrust pkgs = do hsc_env <- getHscEnv - let errors = S.foldr go emptyBag pkgs + let errors = foldr go emptyBag $ uniqDSetToList pkgs state = hsc_units hsc_env go pkg acc | unitIsTrusted $ unsafeLookupUnitId state pkg @@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do False -> return tcg_env where - wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = S.empty } + wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet } pprMod = ppr $ moduleName $ tcg_mod tcg_env whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" @@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs in NoStubs `appendStubC` ip_init | otherwise = NoStubs (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) - <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty + <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet rawCmms return stub_c_exists where ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -107,6 +107,7 @@ import GHC.Types.SourceFile import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Types.PkgQual import GHC.Unit @@ -490,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much mkBatchMsg :: HscEnv -> Messager mkBatchMsg hsc_env = - if length (hsc_all_home_unit_ids hsc_env) > 1 + if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 -- This also displays what unit each module is from. then batchMultiMsg else batchMsg @@ -1741,25 +1742,25 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- This function checks then important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -checkHomeUnitsClosed :: UnitEnv -> Set.Set UnitId -> [(UnitId, UnitId)] -> [DriverMessages] +checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages] -- Fast path, trivially closed. checkHomeUnitsClosed ue home_id_set home_imp_ids - | Set.size home_id_set == 1 = [] + | sizeUniqDSet home_id_set == 1 = [] | otherwise = - let res = foldMap loop home_imp_ids + let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids -- Now check whether everything which transitively depends on a home_unit is actually a home_unit -- These units are the ones which we need to load as home packages but failed to do for some reason, -- it's a bug in the tool invoking GHC. - bad_unit_ids = Set.difference res home_id_set - in if Set.null bad_unit_ids + bad_unit_ids = res `minusUniqDSet` home_id_set + in if isEmptyUniqDSet bad_unit_ids then [] - else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)] + else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)] where rootLoc = mkGeneralSrcSpan (fsLit "") -- TODO: This could repeat quite a bit of work but I struggled to write this function. -- Which units transitively depend on a home unit - loop :: (UnitId, UnitId) -> Set.Set UnitId -- The units which transitively depend on a home unit + loop :: (UnitId, UnitId) -> UnitIdSet -- The units which transitively depend on a home unit loop (from_uid, uid) = let us = ue_findHomeUnitEnv from_uid ue in let um = unitInfoMap (homeUnitEnv_units us) in @@ -1767,20 +1768,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids Nothing -> pprPanic "uid not found" (ppr uid) Just ui -> let depends = unitDepends ui - home_depends = Set.fromList depends `Set.intersection` home_id_set - other_depends = Set.fromList depends `Set.difference` home_id_set + home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set + other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set in -- Case 1: The unit directly depends on a home_id - if not (null home_depends) + if not (isEmptyUniqDSet home_depends) then - let res = foldMap (loop . (from_uid,)) other_depends - in Set.insert uid res + let res :: UnitIdSet + res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends + in addOneToUniqDSet res uid -- Case 2: Check the rest of the dependencies, and then see if any of them depended on else - let res = foldMap (loop . (from_uid,)) other_depends + let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends in - if not (Set.null res) - then Set.insert uid res + if not (isEmptyUniqDSet res) + then addOneToUniqDSet res uid else res -- | Update the every ModSummary that is depended on ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -108,6 +108,7 @@ import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceError +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -125,7 +126,7 @@ import Control.Monad import qualified Control.Monad.Catch as MC (handle) import Data.Maybe import Data.Either ( partitionEithers ) -import qualified Data.Set as Set +import Data.List ( sort ) import Data.Time ( getCurrentTime ) import GHC.Iface.Recomp @@ -409,8 +410,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt home_mod_infos = eltsHpt hpt -- the packages we depend on - pkg_deps = Set.toList - $ Set.unions + pkg_deps = uniqDSetToList + $ unionManyUniqDSets $ fmap (dep_direct_pkgs . mi_deps . hm_iface) $ home_mod_infos @@ -419,7 +420,7 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt debugTraceMsg logger 3 (text "link: hmi ..." $$ vcat (map (ppr . mi_module . hm_iface) home_mod_infos)) debugTraceMsg logger 3 (text "link: linkables are ..." $$ vcat (map ppr linkables)) - debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr pkg_deps)) + debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr $ sort pkg_deps)) -- check for the -no-link flag if isNoLink (ghcLink dflags) ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -41,7 +42,6 @@ import Data.IORef import Data.List (sortBy) import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.Set as Set import GHC.Linker.Types import GHC.Unit.Finder @@ -197,7 +197,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do mk_mod_usage_info :: UsageConfig -> HomeUnit - -> Set.Set UnitId + -> UnitIdSet -> Module -> ImportedMods -> NameSet @@ -256,7 +256,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names -- (need to recompile if its export list changes: export_fprint) mkUsage :: Module -> ModIface -> Maybe Usage mkUsage mod iface - | toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids + | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -504,7 +504,7 @@ loadInterface doc_str mod from -- overlapping instances. ; massertPpr ((isOneShot (ghcMode (hsc_dflags hsc_env))) - || moduleUnitId mod `notElem` hsc_all_home_unit_ids hsc_env + || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env) || mod == gHC_PRIM) (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Types.SrcLoc import GHC.Types.Unique.Set import GHC.Types.Fixity.Env import GHC.Types.Unique.Map +import GHC.Types.Unique.DSet import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.State @@ -617,8 +618,8 @@ checkDependencies hsc_env summary iface all_home_units = hsc_all_home_unit_ids hsc_env units = hsc_units hsc_env prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) + prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) @@ -633,7 +634,7 @@ checkDependencies hsc_env summary iface classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) + | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -324,20 +324,20 @@ loadCmdLineLibs interp hsc_env = do loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState loadCmdLineLibs' interp hsc_env pls = snd <$> foldM - (\(done', pls') cur_uid -> load done' cur_uid pls') - (Set.empty, pls) - (hsc_all_home_unit_ids hsc_env) + (\(done', pls') cur_uid -> load done' cur_uid pls') + (emptyUniqDSet, pls) + (uniqDSetToList $ hsc_all_home_unit_ids hsc_env) where - load :: Set.Set UnitId -> UnitId -> LoaderState -> IO (Set.Set UnitId, LoaderState) - load done uid pls | uid `Set.member` done = return (done, pls) + load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState) + load done uid pls | uid `elementOfUniqDSet` done = return (done, pls) load done uid pls = do let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) - (homeUnitDepends (hsc_units hsc')) + (homeUnitDepends (hsc_units hsc')) pls'' <- loadCmdLineLibs'' interp hsc' pls' - return $ (Set.insert uid done', pls'') + return $ (addOneToUniqDSet done' uid, pls'') loadCmdLineLibs'' :: Interp @@ -685,7 +685,7 @@ getLinkDeps :: HscEnv -> Maybe FilePath -- replace object suffixes? -> SrcSpan -- for error messages -> [Module] -- If you need these - -> IO ([Linkable], [Linkable], [UnitId], UniqDSet UnitId) -- ... then link these first + -> IO ([Linkable], [Linkable], [UnitId], UnitIdSet) -- ... then link these first -- The module and package dependencies for the needed modules are returned. -- See Note [Object File Dependencies] -- Fails with an IO exception if it can't find enough files @@ -737,7 +737,7 @@ getLinkDeps hsc_env pls replace_osuf span mods -- It is also a matter of correctness to use the module graph so that dependencies between home units -- is resolved correctly. - make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) + make_deps_loop :: (UnitIdSet, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UnitIdSet, Set.Set NodeKey) make_deps_loop found [] = found make_deps_loop found@(found_units, found_mods) (nk:nexts) | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts @@ -766,7 +766,7 @@ getLinkDeps hsc_env pls replace_osuf span mods HsBootFile -> link_boot_mod_error (mi_module iface) _ -> return $ Just (mi_module iface) - in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod + in (dep_direct_pkgs (mi_deps iface),) <$> mmod Nothing -> let err = text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid in throwGhcExceptionIO (ProgramError (showSDoc dflags err)) @@ -780,9 +780,9 @@ getLinkDeps hsc_env pls replace_osuf span mods -- dependencies of that. Hence we need to traverse the dependency -- tree recursively. See bug #936, testcase ghci/prog007. follow_deps :: [Module] -- modules to follow - -> UniqDSet Module -- accum. module dependencies - -> UniqDSet UnitId -- accum. package dependencies - -> IO ([Module], UniqDSet UnitId) -- result + -> UniqDSet Module -- accum. module dependencies + -> UnitIdSet -- accum. package dependencies + -> IO ([Module], UnitIdSet) -- result follow_deps [] acc_mods acc_pkgs = return (uniqDSetToList acc_mods, acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs @@ -814,7 +814,7 @@ getLinkDeps hsc_env pls replace_osuf span mods acc_mods' = case hsc_home_unit_maybe hsc_env of Nothing -> acc_mods Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) + acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps) case hsc_home_unit_maybe hsc_env of Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Linker.Types where import GHC.Prelude -import GHC.Unit ( UnitId, Module ) +import GHC.Unit ( UnitId, Module, UnitIdSet ) import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) import GHC.Fingerprint.Type ( Fingerprint ) import GHCi.RemoteTypes ( ForeignHValue ) @@ -53,7 +53,6 @@ import Control.Concurrent.MVar import Data.Time ( UTCTime ) import Data.Maybe import GHC.Unit.Module.Env -import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Unit.Module.WholeCoreBindings @@ -146,7 +145,7 @@ data LoadedPkgInfo { loaded_pkg_uid :: !UnitId , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] - , loaded_pkg_trans_deps :: UniqDSet UnitId + , loaded_pkg_trans_deps :: UnitIdSet } instance Outputable LoadedPkgInfo where ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -72,6 +72,7 @@ import GHC.Types.Id import GHC.Types.HpcInfo import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Module.Warnings @@ -210,8 +211,8 @@ rnImports imports = do let merged_import_avail = clobberSourceImports imp_avails dflags <- getDynFlags let final_import_avail = - merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags) - `S.union` imp_dep_direct_pkgs merged_import_avail} + merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags) + `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail} return (decls, rdr_env, final_import_avail, hpc_usage) where @@ -478,7 +479,7 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of -- | Calculate the 'ImportAvails' induced by an import of a particular -- interface, but without 'imp_mods'. calculateAvails :: HomeUnit - -> S.Set UnitId + -> UnitIdSet -> ModIface -> IsSafeImport -> IsBootInterface @@ -533,7 +534,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by -- Trusted packages are a lot like orphans. trusted_pkgs | mod_safe' = dep_trusted_pkgs deps - | otherwise = S.empty + | otherwise = emptyUniqDSet pkg = moduleUnit (mi_module iface) @@ -546,11 +547,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by | isHomeUnit home_unit pkg = ptrust | otherwise = False - dependent_pkgs = if toUnitId pkg `S.member` other_home_units - then S.empty - else S.singleton ipkg + dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units + then emptyUniqDSet + else unitUniqDSet ipkg - direct_mods = mkModDeps $ if toUnitId pkg `S.member` other_home_units + direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) else S.empty ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -143,6 +143,7 @@ import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -181,9 +182,8 @@ import Data.List ( sortBy, sort ) import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE import Data.Ord -import qualified Data.Set as S -import Data.Foldable ( for_ ) import Data.Traversable ( for ) +import Data.Foldable ( for_ ) @@ -2933,7 +2933,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports) , text "Dependent packages:" <+> - ppr (S.toList $ imp_dep_direct_pkgs imports)] + ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)] -- The use of sort is just to reduce unnecessary -- wobbling in testsuite output ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -142,6 +142,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Basic import GHC.Types.CostCentre.State import GHC.Types.HpcInfo @@ -1367,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_direct_dep_mods = emptyInstalledModuleEnv, - imp_dep_direct_pkgs = S.empty, + imp_dep_direct_pkgs = emptyUniqDSet, imp_sig_mods = [], - imp_trust_pkgs = S.empty, + imp_trust_pkgs = emptyUniqDSet, imp_trust_own_pkg = False, imp_boot_mods = emptyInstalledModuleEnv, imp_orphs = [], @@ -1398,8 +1399,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, - imp_dep_direct_pkgs = ddpkgs1 `S.union` ddpkgs2, - imp_trust_pkgs = tpkgs1 `S.union` tpkgs2, + imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2, + imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, ===================================== compiler/GHC/Types/Unique/DSet.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Types.Unique.DSet ( isEmptyUniqDSet, lookupUniqDSet, uniqDSetToList, + uniqDSetToAscList, partitionUniqDSet, mapUniqDSet ) where @@ -43,8 +44,11 @@ import GHC.Types.Unique.DFM import GHC.Types.Unique.Set import GHC.Types.Unique +import GHC.Utils.Binary + import Data.Coerce import Data.Data +import Data.List (sort) -- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here. -- Beyond preserving invariants, we may also want to 'override' typeclass @@ -120,6 +124,9 @@ lookupUniqDSet = lookupUDFM . getUniqDSet uniqDSetToList :: UniqDSet a -> [a] uniqDSetToList = eltsUDFM . getUniqDSet +uniqDSetToAscList :: Ord a => UniqDSet a -> [a] +uniqDSetToAscList = sort . uniqDSetToList + partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a) partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet @@ -140,3 +147,7 @@ instance Outputable a => Outputable (UniqDSet a) where pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList + +instance (Uniquable a, Binary a, Ord a) => Binary (UniqDSet a) where + put_ bh = put_ bh . uniqDSetToAscList + get bh = mkUniqDSet <$> get bh ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -81,6 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) +import GHC.Types.Unique.DSet import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -339,8 +340,8 @@ unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env) unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env -unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey -unitEnv_keys env = Map.keysSet (unitEnv_graph env) +unitEnv_keys :: UnitEnvGraph v -> UnitIdSet +unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) @@ -443,7 +444,7 @@ ue_unitHomeUnit_maybe uid ue_env = ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env -ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId +ue_all_home_unit_ids :: UnitEnv -> UnitIdSet ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph -- ------------------------------------------------------- -- Query and modify the currently active unit ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -55,13 +56,13 @@ data Dependencies = Deps -- ^ All home-package modules which are directly imported by this one. -- This may include modules from other units when using multiple home units - , dep_direct_pkgs :: Set UnitId + , dep_direct_pkgs :: UnitIdSet -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. -- Does not include other home units when using multiple home units. -- Modules from these units will go in `dep_direct_mods` - , dep_plugin_pkgs :: Set UnitId + , dep_plugin_pkgs :: UnitIdSet -- ^ All units needed for plugins ------------------------------------ @@ -71,7 +72,7 @@ data Dependencies = Deps -- ^ Transitive closure of hsig files in the home package - , dep_trusted_pkgs :: Set UnitId + , dep_trusted_pkgs :: UnitIdSet -- Packages which we are required to trust -- when the module is imported as a safe import -- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names @@ -112,7 +113,7 @@ data Dependencies = Deps mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods - plugin_units = Set.fromList (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -199,12 +200,12 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps - { dep_direct_mods = Set.empty - , dep_direct_pkgs = Set.empty - , dep_plugin_pkgs = Set.empty + { dep_direct_mods = mempty + , dep_direct_pkgs = emptyUniqDSet + , dep_plugin_pkgs = emptyUniqDSet , dep_sig_mods = [] - , dep_boot_mods = Set.empty - , dep_trusted_pkgs = Set.empty + , dep_boot_mods = mempty + , dep_trusted_pkgs = emptyUniqDSet , dep_orphs = [] , dep_finsts = [] } @@ -222,11 +223,11 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods = pprWithUnitState unit_state $ vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods, text "boot module dependencies:" <+> ppr_set ppr bmods, - text "direct package dependencies:" <+> ppr_set ppr pkgs, - text "plugin package dependencies:" <+> ppr_set ppr plgns, - if null tps + text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, + text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, + if isEmptyUniqDSet tps then empty - else text "trusted package dependencies:" <+> ppr_set ppr tps, + else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), text "family instance modules:" <+> fsep (map ppr finsts) ] @@ -237,6 +238,9 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc ppr_set w = fsep . fmap w . Set.toAscList + ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc + ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance -- @@ -493,7 +497,7 @@ data ImportAvails imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot, -- ^ Home-package modules directly imported by the module being compiled. - imp_dep_direct_pkgs :: Set UnitId, + imp_dep_direct_pkgs :: UnitIdSet, -- ^ Packages directly needed by the module being compiled imp_trust_own_pkg :: Bool, @@ -504,7 +508,7 @@ data ImportAvails -- Transitive information below here - imp_trust_pkgs :: Set UnitId, + imp_trust_pkgs :: UnitIdSet, -- ^ This records the -- packages the current module needs to trust for Safe Haskell -- compilation to succeed. A package is required to be trusted if ===================================== compiler/GHC/Unit/Module/ModGuts.hs ===================================== @@ -37,8 +37,6 @@ import GHC.Types.SourceFile ( HscSource(..), hscSourceToIsBoot ) import GHC.Types.SrcLoc import GHC.Types.CostCentre -import Data.Set (Set) - -- | A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module @@ -137,7 +135,7 @@ data CgGuts cg_ccs :: [CostCentre], -- List of cost centres used in bindings and rules cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs cg_foreign_files :: ![(ForeignSrcLang, FilePath)], - cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to + cg_dep_pkgs :: !UnitIdSet, -- ^ Dependent packages, used to -- generate #includes for C code gen cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -346,10 +346,10 @@ data UnitConfig = UnitConfig , unitConfigFlagsIgnored :: [IgnorePackageFlag] -- ^ Ignored units , unitConfigFlagsTrusted :: [TrustFlag] -- ^ Trusted units , unitConfigFlagsPlugins :: [PackageFlag] -- ^ Plugins exposed units - , unitConfigHomeUnits :: Set.Set UnitId + , unitConfigHomeUnits :: UnitIdSet } -initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig +initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> UnitConfig initUnitConfig dflags cached_dbs home_units = let !hu_id = homeUnitId_ dflags !hu_instanceof = homeUnitInstanceOf_ dflags @@ -626,7 +626,7 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) +initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) initUnits logger dflags cached_dbs home_units = do let forceUnitInfoMap (state, _) = unitInfoMap state `seq` () @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (Set.toList override_set) $ \pkg -> + forM_ (uniqDSetToList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1374,9 +1374,8 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- The set of UnitIds which appear in both db and pkgs. These are the -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 - override_set :: Set UnitId - override_set = Set.intersection (nonDetUniqMapToKeySet db_map) - (nonDetUniqMapToKeySet pkg_map) + override_set :: UnitIdSet + override_set = mkUniqDSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1688,7 +1687,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = Set.toList home_unit_deps + , homeUnitDepends = uniqDSetToList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,15 +1700,15 @@ mkUnitState logger cfg = do } return (state, raw_dbs) -selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True +selectHptFlag :: UnitIdSet -> PackageFlag -> Bool +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True selectHptFlag _ _ = False -selectHomeUnits :: Set.Set UnitId -> [PackageFlag] -> Set.Set UnitId -selectHomeUnits home_units flags = foldl' go Set.empty flags +selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet +selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags where - go :: Set.Set UnitId -> PackageFlag -> Set.Set UnitId - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = Set.insert (toUnitId uid) cur + go :: UnitIdSet -> PackageFlag -> UnitIdSet + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Unit.Types , GenInstantiatedUnit (..) , InstantiatedUnit , DefUnitId + , UnitIdSet , Instantiations , GenInstantiations , mkInstantiatedUnit @@ -539,6 +540,8 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId +type UnitIdSet = UniqDSet UnitId + unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS ===================================== ghc/GHCi/UI.hs ===================================== @@ -106,6 +106,7 @@ import GHC.Utils.Misc import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Bag (unitBag) import qualified GHC.Data.Strict as Strict +import GHC.Types.Unique.DSet -- Haskell Libraries import System.Console.Haskeline as Haskeline @@ -126,7 +127,6 @@ import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) import Data.List ( elemIndices, find, intercalate, intersperse, minimumBy, isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) ) import qualified Data.List.NonEmpty as NE -import qualified Data.Set as S import Data.Maybe import qualified Data.Map as M import Data.IntMap.Strict (IntMap) @@ -562,7 +562,7 @@ interactiveUI config srcs maybe_exprs = do -- Set to True because Prelude is implicitly imported. impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession - let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1 + let in_multi = sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 empty_cache <- liftIO newIfaceCache startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, @@ -2569,15 +2569,15 @@ isSafeModule m = do -- print info to user... liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")" liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off") - when (not $ S.null good) + when (not $ isEmptyUniqDSet good) (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++ - (intercalate ", " $ map (showPpr dflags) (S.toList good))) - case msafe && S.null bad of + (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good))) + case msafe && isEmptyUniqDSet bad of True -> liftIO $ putStrLn $ mname ++ " is trusted!" False -> do - when (not $ null bad) + when (not $ isEmptyUniqDSet bad) (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): " - ++ (intercalate ", " $ map (showPpr dflags) (S.toList bad))) + ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad))) liftIO $ putStrLn $ mname ++ " is NOT trusted!" where @@ -2587,8 +2587,8 @@ isSafeModule m = do | isHomeModule (hsc_home_unit hsc_env) md = True | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) - tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty) - | otherwise = S.partition part deps + tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet) + | otherwise = partitionUniqDSet part deps where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2fb3231412552cca7a713a996f4a5076f18ed948 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2fb3231412552cca7a713a996f4a5076f18ed948 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:10:36 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 24 May 2023 12:10:36 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] Memory usage fixes for Haddock Message-ID: <646e36fc11c47_64cfbc2d08792a3@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: d6e80d76 by Finley McIlwaine at 2023-05-24T10:07:52-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Strictly evaluate names in `rnHsDoc` to avoid retention of GlobalRdrEnv - Strictly evaluate fields of `IfaceTyConInfo` - Update haddock perf tests to be more accurate and force evaluation of renamed doc thunks using `-fwrite-interface` - Accept a higher increase (40%) in allocations in the renamer due to `-haddock`. - Update Haddock submodule to move over to initial implementation of hi-haddock, including the other memory performance gains recently added to haddock. - - - - - 8 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Types/Name/Occurrence.hs - testsuite/tests/haddock/perf/Fold.hs - testsuite/tests/haddock/perf/Makefile - utils/haddock Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -355,13 +355,13 @@ See Note [The equality types story] in GHC.Builtin.Types.Prim. -} data IfaceTyConInfo -- Used only to guide pretty-printing - = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag + = IfaceTyConInfo { ifaceTyConIsPromoted :: !PromotionFlag -- A PromotionFlag value of IsPromoted indicates -- that the type constructor came from a data -- constructor promoted by -XDataKinds, and thus -- should be printed as 'D to distinguish it from -- an existing type constructor D. - , ifaceTyConSort :: IfaceTyConSort } + , ifaceTyConSort :: !IfaceTyConSort } deriving (Eq) -- This smart constructor allows sharing of the two most common ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -1360,11 +1360,15 @@ mkDocIE (L l_comment hdk_comment) = span = mkSrcSpanPs l_comment mkDocNext :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocNext (L l (HdkCommentNext doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocNext (L l (HdkCommentNext doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocNext _ = Nothing mkDocPrev :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocPrev (L l (HdkCommentPrev doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocPrev (L l (HdkCommentPrev doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocPrev _ = Nothing ===================================== compiler/GHC/Rename/Doc.hs ===================================== @@ -1,5 +1,7 @@ module GHC.Rename.Doc ( rnHsDoc, rnLHsDoc, rnLDocDecl, rnDocDecl ) where +import Control.DeepSeq (force) + import GHC.Prelude import GHC.Tc.Types @@ -33,7 +35,11 @@ rnDocDecl (DocGroup i doc) = do rnHsDoc :: WithHsDocIdentifiers a GhcPs -> RnM (WithHsDocIdentifiers a GhcRn) rnHsDoc (WithHsDocIdentifiers s ids) = do gre <- tcg_rdr_env <$> getGblEnv - pure (WithHsDocIdentifiers s (rnHsDocIdentifiers gre ids)) + + -- This is forced to avoid retention of the GlobalRdrEnv + let !rn = force $ rnHsDocIdentifiers gre ids + + pure (WithHsDocIdentifiers s rn) rnHsDocIdentifiers :: GlobalRdrEnv -> [Located RdrName] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -600,7 +600,7 @@ unitOccEnv (OccName ns s) a = MkOccEnv $ unitFsEnv s (unitUFM ns a) -- | Add a single element to an 'OccEnv'. extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a extendOccEnv (MkOccEnv as) (OccName ns s) a = - MkOccEnv $ extendFsEnv_C plusUFM as s (unitUFM ns a) + MkOccEnv $ extendFsEnv_C plusUFM as s $! unitUFM ns a -- | Extend an 'OccEnv' by a list. -- ===================================== testsuite/tests/haddock/perf/Fold.hs ===================================== @@ -143,6 +143,7 @@ import Prelude import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Control.Monad as Monad +import Control.Monad.Fix import Control.Monad.Reader import qualified Control.Monad.Reader as Reader import Data.Functor ===================================== testsuite/tests/haddock/perf/Makefile ===================================== @@ -4,12 +4,12 @@ include $(TOP)/mk/test.mk # We accept a 5% increase in parser allocations due to -haddock haddock_parser_perf : - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" -# Similarly for the renamer +# We accept a 40% increase in renamer allocations due to -haddock haddock_renamer_perf : - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.20) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.40) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 +Subproject commit 2cbc683d1ffa5c90b48be80f355de2c1023b315d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6e80d76b9b127b4e0a19c93419dbbf14286155f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6e80d76b9b127b4e0a19c93419dbbf14286155f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:11:38 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 24 May 2023 12:11:38 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 22 commits: Make Warn = Located DriverMessage Message-ID: <646e373a7fcc2_64cfbc2d58798a@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 0bf53ae8 by Finley McIlwaine at 2023-05-24T10:11:30-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Strictly evaluate names in `rnHsDoc` to avoid retention of GlobalRdrEnv - Strictly evaluate fields of `IfaceTyConInfo` - Update haddock perf tests to be more accurate and force evaluation of renamed doc thunks using `-fwrite-interface` - Accept a higher increase (40%) in allocations in the renamer due to `-haddock`. - Update Haddock submodule to move over to initial implementation of hi-haddock, including the other memory performance gains recently added to haddock. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser/PostProcess/Haddock.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6e80d76b9b127b4e0a19c93419dbbf14286155f...0bf53ae8427973c0b29e858668b08a37ff5e760e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6e80d76b9b127b4e0a19c93419dbbf14286155f...0bf53ae8427973c0b29e858668b08a37ff5e760e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:41:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 12:41:35 -0400 Subject: [Git][ghc/ghc][master] Migrate errors in GHC.Tc.Validity Message-ID: <646e3e3fa0ea5_64cfbc2d809911a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 30 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/deriving/should_fail/drvfail015.stderr - testsuite/tests/ghci/scripts/T22695.stderr - testsuite/tests/ghci/should_fail/T16013.stderr - testsuite/tests/ghci/should_fail/T16287.stderr - testsuite/tests/indexed-types/should_compile/T15322.stderr - testsuite/tests/indexed-types/should_fail/BadSock.stderr - testsuite/tests/indexed-types/should_fail/T2157.stderr - testsuite/tests/indexed-types/should_fail/T9433.stderr - testsuite/tests/module/mod41.stderr - testsuite/tests/module/mod42.stderr - testsuite/tests/module/mod43.stderr - testsuite/tests/module/mod60.stderr - testsuite/tests/overloadedrecflds/should_fail/all.T - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.stderr - + testsuite/tests/overloadedrecflds/should_fail/hasfieldfail04.hs - + testsuite/tests/overloadedrecflds/should_fail/hasfieldfail04.stderr - testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.stderr - testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.stderr - testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr - testsuite/tests/patsyn/should_fail/T12819.stderr - testsuite/tests/polykinds/T10516.stderr - testsuite/tests/polykinds/T10570.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/838aaf4b6e7020c87023b2daaee2afe6bca821f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/838aaf4b6e7020c87023b2daaee2afe6bca821f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:42:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 12:42:16 -0400 Subject: [Git][ghc/ghc][master] linear lint: Add missing processing of DEFAULT Message-ID: <646e3e68a5417_64cfbc29ac1043b0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - 6 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Tc/Gen/Expr.hs - + testsuite/tests/linear/should_compile/LinearRecUpd.hs - + testsuite/tests/linear/should_compile/T23025.hs - testsuite/tests/linear/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1194,13 +1194,13 @@ checkCanEtaExpand _ _ _ checkLinearity :: UsageEnv -> Var -> LintM UsageEnv checkLinearity body_ue lam_var = case varMultMaybe lam_var of - Just mult -> do ensureSubUsage lhs mult (err_msg mult) - return $ deleteUE body_ue lam_var + Just mult -> do + let (lhs, body_ue') = popUE body_ue lam_var + err_msg = text "Linearity failure in lambda:" <+> ppr lam_var + $$ ppr lhs <+> text "⊈" <+> ppr mult + ensureSubUsage lhs mult err_msg + return body_ue' Nothing -> return body_ue -- A type variable - where - lhs = lookupUE body_ue lam_var - err_msg mult = text "Linearity failure in lambda:" <+> ppr lam_var - $$ ppr lhs <+> text "⊈" <+> ppr mult {- Note [Join points and casts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1551,17 +1551,24 @@ lintCoreAlt :: Var -- Case binder -> LintM UsageEnv -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintCoreAlt _ _ _ alt_ty (Alt DEFAULT args rhs) = +lintCoreAlt case_bndr _ scrut_mult alt_ty (Alt DEFAULT args rhs) = do { lintL (null args) (mkDefaultArgsMsg args) - ; lintAltExpr rhs alt_ty } - -lintCoreAlt _case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) + ; rhs_ue <- lintAltExpr rhs alt_ty + ; let (case_bndr_usage, rhs_ue') = popUE rhs_ue case_bndr + err_msg = text "Linearity failure in the DEFAULT clause:" <+> ppr case_bndr + $$ ppr case_bndr_usage <+> text "⊈" <+> ppr scrut_mult + ; ensureSubUsage case_bndr_usage scrut_mult err_msg + ; return rhs_ue' } + +lintCoreAlt case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) | litIsLifted lit = failWithL integerScrutinisedMsg | otherwise = do { lintL (null args) (mkDefaultArgsMsg args) ; ensureEqTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty) - ; lintAltExpr rhs alt_ty } + ; rhs_ue <- lintAltExpr rhs alt_ty + ; return (deleteUE rhs_ue case_bndr) -- No need for linearity checks + } where lit_ty = literalType lit @@ -3184,9 +3191,14 @@ inCasePat = LintM $ \ env errs -> fromBoxedLResult (Just (is_case_pat env), errs addInScopeId :: Id -> LintedType -> LintM a -> LintM a addInScopeId id linted_ty m - = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set, le_ue_aliases = aliases }) errs -> unLintM m (env { le_ids = extendVarEnv id_set id (id, linted_ty) - , le_joins = add_joins join_set }) errs + , le_joins = add_joins join_set + , le_ue_aliases = delFromNameEnv aliases (idName id) }) errs + -- When shadowing an alias, we need to make sure the Id is no longer + -- classified as such. E.g. in + -- let x = in case x of x { _DEFAULT -> } + -- Occurrences of 'x' in e2 shouldn't count as occurrences of e1. where add_joins join_set | isJoinId id = extendVarSet join_set id -- Overwrite with new arity ===================================== compiler/GHC/Core/UsageEnv.hs ===================================== @@ -6,6 +6,7 @@ module GHC.Core.UsageEnv , bottomUE , deleteUE , lookupUE + , popUE , scaleUE , scaleUsage , supUE @@ -104,5 +105,8 @@ lookupUE (UsageEnv e has_bottom) x = Just w -> MUsage w Nothing -> if has_bottom then Bottom else Zero +popUE :: NamedThing n => UsageEnv -> n -> (Usage, UsageEnv) +popUE ue x = (lookupUE ue x, deleteUE ue x) + instance Outputable UsageEnv where ppr (UsageEnv ne b) = text "UsageEnv:" <+> ppr ne <+> ppr b ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1175,7 +1175,7 @@ desugarRecordUpd record_expr possible_parents rbnds res_ty -- e.g. (x', e1), (y', e2), ... ; let mk_upd_id :: Name -> LHsFieldBind GhcTc fld (LHsExpr GhcRn) -> TcM (Name, (TcId, LHsExpr GhcRn)) mk_upd_id fld_nm (L _ rbind) - = do { let Scaled m arg_ty = lookupNameEnv_NF arg_ty_env fld_nm + = do { let Scaled _ arg_ty = lookupNameEnv_NF arg_ty_env fld_nm nm_occ = rdrNameOcc . nameRdrName $ fld_nm actual_arg_ty = substTy subst arg_ty rhs = hfbRHS rbind @@ -1186,11 +1186,17 @@ desugarRecordUpd record_expr possible_parents rbnds res_ty -- (As we will typecheck the let-bindings later, we can drop this coercion here.) -- See RepPolyRecordUpdate test. ; nm <- newNameAt nm_occ generatedSrcSpan - ; let id = mkLocalId nm m actual_arg_ty + ; let id = mkLocalId nm ManyTy actual_arg_ty -- NB: create fresh names to avoid any accidental shadowing -- occurring in the RHS expressions when creating the let bindings: -- -- let x1 = e1; x2 = e2; ... + -- + -- Above, we use multiplicity Many rather than the one associated to arg_ty. + -- Normally, there shouldn't be a difference, since it's a let binding. + -- But -XStrict can convert the let to a case, and this causes issues + -- in test LinearRecUpd. Since we don't support linear record updates, + -- using Many is simple and safe. ; return (fld_nm, (id, rhs)) } arg_ty_env = mkNameEnv ===================================== testsuite/tests/linear/should_compile/LinearRecUpd.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE Strict #-} +module LinearRecUpd where + +nextM :: Env -> Env +nextM e = e{dfsE=0} + +data Env = Env {dfsE :: Int} ===================================== testsuite/tests/linear/should_compile/T23025.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE LinearTypes, BangPatterns #-} +module T23025 where + +import Data.Void + +f :: a %1 -> a +f !x = x + +g :: Void %m -> Maybe () +g a = Just (case a of {}) ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -40,3 +40,5 @@ test('T18731', normal, compile, ['']) test('T19400', unless(compiler_debugged(), skip), compile, ['']) test('T20023', normal, compile, ['']) test('T22546', normal, compile, ['']) +test('T23025', normal, compile, ['-dlinear-core-lint']) +test('LinearRecUpd', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8539764b2be769a68dc2fbbf9f48399441cab9fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8539764b2be769a68dc2fbbf9f48399441cab9fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:42:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 12:42:53 -0400 Subject: [Git][ghc/ghc][master] Remove outdated "Don't check hs-boot type family instances too early" note Message-ID: <646e3e8d4109b_64cfbc29981077d1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 1 changed file: - compiler/GHC/Tc/Instance/Family.hs Changes: ===================================== compiler/GHC/Tc/Instance/Family.hs ===================================== @@ -189,9 +189,6 @@ For every other pair of family instance modules we import (directly or indirectly), we check that they are consistent now. (So that we can be certain that the modules in our `GHC.Driver.Env.dep_finsts' are consistent.) -There is some fancy footwork regarding hs-boot module loops, see -Note [Don't check hs-boot type family instances too early] - Note [Checking family instance optimization] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As explained in Note [Checking family instance consistency] @@ -245,9 +242,6 @@ a set of utility modules that every module imports directly or indirectly. This is basically the idea from #13092, comment:14. -} --- This function doesn't check ALL instances for consistency, --- only ones that aren't involved in recursive knot-tying --- loops; see Note [Don't check hs-boot type family instances too early]. -- We don't need to check the current module, this is done in -- tcExtendLocalFamInstEnv. -- See Note [The type family instance consistency story]. @@ -350,68 +344,7 @@ checkFamInstConsistency directlyImpMods sizeE2 = famInstEnvSize env2' (env1, env2) = if sizeE1 < sizeE2 then (env1', env2') else (env2', env1') - -- Note [Don't check hs-boot type family instances too early] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- Family instance consistency checking involves checking that - -- the family instances of our imported modules are consistent with - -- one another; this might lead you to think that this process - -- has nothing to do with the module we are about to typecheck. - -- Not so! Consider the following case: - -- - -- -- A.hs-boot - -- type family F a - -- - -- -- B.hs - -- import {-# SOURCE #-} A - -- type instance F Int = Bool - -- - -- -- A.hs - -- import B - -- type family F a - -- - -- When typechecking A, we are NOT allowed to poke the TyThing - -- for F until we have typechecked the family. Thus, we - -- can't do consistency checking for the instance in B - -- (checkFamInstConsistency is called during renaming). - -- Failing to defer the consistency check lead to #11062. - -- - -- Additionally, we should also defer consistency checking when - -- type from the hs-boot file of the current module occurs on - -- the left hand side, as we will poke its TyThing when checking - -- for overlap. - -- - -- -- F.hs - -- type family F a - -- - -- -- A.hs-boot - -- import F - -- data T - -- - -- -- B.hs - -- import {-# SOURCE #-} A - -- import F - -- type instance F T = Int - -- - -- -- A.hs - -- import B - -- data T = MkT - -- - -- In fact, it is even necessary to defer for occurrences in - -- the RHS, because we may test for *compatibility* in event - -- of an overlap. - -- - -- Why don't we defer ALL of the checks to later? Well, many - -- instances aren't involved in the recursive loop at all. So - -- we might as well check them immediately; and there isn't - -- a good time to check them later in any case: every time - -- we finish kind-checking a type declaration and add it to - -- a context, we *then* consistency check all of the instances - -- which mentioned that type. We DO want to check instances - -- as quickly as possible, so that we aren't typechecking - -- values with inconsistent axioms in scope. - -- - -- See also Note [Tying the knot] - -- for why we are doing this at all. + ; let check_now = famInstEnvElts env1 ; mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now ; mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae683454e66913ad735269b09f89a49cf6a7101d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae683454e66913ad735269b09f89a49cf6a7101d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:43:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 12:43:30 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts: Define ticky macro stubs Message-ID: <646e3eb29edd_64cfb30c71ac11291a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - 7 changed files: - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Threads.c - rts/Ticky.c - rts/include/Cmm.h - rts/include/stg/Ticky.h - rts/sm/Storage.c Changes: ===================================== rts/RaiseAsync.c ===================================== @@ -877,7 +877,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); - TICK_ALLOC_UP_THK(WDS(words+1),0); + TICK_ALLOC_UP_THK(AP_STACK_sizeW(words),0); //IF_DEBUG(scheduler, // debugBelch("sched: Updating "); @@ -927,7 +927,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, } SET_HDR(ap,&stg_AP_STACK_NOUPD_info,stack->header.prof.ccs); - TICK_ALLOC_SE_THK(WDS(words+1),0); + TICK_ALLOC_SE_THK(AP_STACK_sizeW(words),0); stack->sp = sp; threadStackUnderflow(cap,tso); @@ -963,7 +963,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, // handler in this frame. // raise = (StgThunk *)allocate(cap,sizeofW(StgThunk)+1); - TICK_ALLOC_SE_THK(WDS(1),0); + TICK_ALLOC_SE_THK(sizeofW(StgThunk)+1,0); SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs); raise->payload[0] = exception; ===================================== rts/RtsSymbols.c ===================================== @@ -402,9 +402,9 @@ extern char **environ; SymI_HasProto(ALLOC_PAP_gds) \ SymI_HasProto(ALLOC_PAP_slp) \ SymI_HasProto(ALLOC_TSO_ctr) \ - SymI_HasProto(ALLOC_TSO_adm) \ - SymI_HasProto(ALLOC_TSO_gds) \ - SymI_HasProto(ALLOC_TSO_slp) \ + SymI_HasProto(ALLOC_TSO_tot) \ + SymI_HasProto(ALLOC_STACK_ctr) \ + SymI_HasProto(ALLOC_STACK_tot) \ SymI_HasProto(RET_NEW_ctr) \ SymI_HasProto(RET_OLD_ctr) \ SymI_HasProto(RET_UNBOXED_TUP_ctr) \ ===================================== rts/Threads.c ===================================== @@ -89,7 +89,7 @@ createThread(Capability *cap, W_ size) stack->marking = 0; tso = (StgTSO *)allocate(cap, sizeofW(StgTSO)); - TICK_ALLOC_TSO(); + TICK_ALLOC_TSO(sizeofW(StgTSO)); SET_HDR(tso, &stg_TSO_info, CCS_SYSTEM); // Always start with the compiled code evaluator @@ -873,7 +873,7 @@ StgMutArrPtrs *listThreads(Capability *cap) StgMutArrPtrs *arr = (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size); SET_HDR(arr, &stg_MUT_ARR_PTRS_DIRTY_info, CCS_SYSTEM); - TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0); + TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), size, 0); arr->ptrs = n_threads; arr->size = size; ===================================== rts/Ticky.c ===================================== @@ -260,6 +260,12 @@ PrintTickyInfo(void) PR_CTR(ALLOC_PRIM_gds); PR_CTR(ALLOC_PRIM_slp); + PR_CTR(ALLOC_TSO_ctr); + PR_CTR(ALLOC_TSO_tot); + + PR_CTR(ALLOC_STACK_ctr); + PR_CTR(ALLOC_STACK_tot); + PR_CTR(ENT_VIA_NODE_ctr); PR_CTR(ENT_STATIC_CON_ctr); PR_CTR(ENT_DYN_CON_ctr); ===================================== rts/include/Cmm.h ===================================== @@ -414,7 +414,7 @@ TICK_BUMP(HEAP_CHK_ctr); \ Hp = Hp + (bytes); \ if (Hp > HpLim) { HpAlloc = (bytes); failure; } \ - TICK_ALLOC_HEAP_NOCTR(bytes); + TICK_ALLOC_RTS(bytes); #define ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,failure) \ HEAP_CHECK(bytes,failure) \ @@ -435,7 +435,7 @@ #define HP_CHK_GEN_TICKY(bytes) \ HP_CHK_GEN(bytes); \ - TICK_ALLOC_HEAP_NOCTR(bytes); + TICK_ALLOC_RTS(bytes); #define HP_CHK_P(bytes, fun, arg) \ HEAP_CHECK(bytes, GC_PRIM_P(fun,arg)) @@ -444,7 +444,7 @@ // -NSF March 2013 #define ALLOC_P_TICKY(bytes, fun, arg) \ HP_CHK_P(bytes); \ - TICK_ALLOC_HEAP_NOCTR(bytes); + TICK_ALLOC_RTS(bytes); #define CHECK_GC() \ (bdescr_link(CurrentNursery) == NULL || \ @@ -789,7 +789,7 @@ TICK_BUMP(UPD_CON_IN_NEW_ctr); \ TICK_HISTO(UPD_CON_IN_NEW,n) -#define TICK_ALLOC_HEAP_NOCTR(bytes) \ +#define TICK_ALLOC_RTS(bytes) \ TICK_BUMP(ALLOC_RTS_ctr); \ TICK_BUMP_BY(ALLOC_RTS_tot,bytes) ===================================== rts/include/stg/Ticky.h ===================================== @@ -170,9 +170,10 @@ EXTERN StgInt ALLOC_PAP_gds INIT(0); EXTERN StgInt ALLOC_PAP_slp INIT(0); EXTERN StgInt ALLOC_TSO_ctr INIT(0); -EXTERN StgInt ALLOC_TSO_adm INIT(0); -EXTERN StgInt ALLOC_TSO_gds INIT(0); -EXTERN StgInt ALLOC_TSO_slp INIT(0); +EXTERN StgInt ALLOC_TSO_tot INIT(0); + +EXTERN StgInt ALLOC_STACK_ctr INIT(0); +EXTERN StgInt ALLOC_STACK_tot INIT(0); EXTERN StgInt RET_NEW_ctr INIT(0); EXTERN StgInt RET_OLD_ctr INIT(0); @@ -215,15 +216,37 @@ EXTERN StgInt RET_UNBOXED_TUP_hst[TICKY_BIN_COUNT] INIT({0}); #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) -#define TICK_ALLOC_PRIM(x,y,z) // FIXME: update counter #define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr) #define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr) #define TICK_UPD_SQUEEZED() TICK_BUMP(UPD_SQUEEZED_ctr) -#define TICK_ALLOC_HEAP_NOCTR(bytes) // FIXME: update counter -#define TICK_GC_FAILED_PROMOTION() // FIXME: update counter -#define TICK_ALLOC_TSO() // FIXME: update counter -#define TICK_ALLOC_STACK(g) // FIXME: update counter -#define TICK_ALLOC_UP_THK(g,s) // FIXME: update counter -#define TICK_ALLOC_SE_THK(g,s) // FIXME: update counter +#define TICK_ALLOC_PRIM(hdr,goods,slop)\ + TICK_BUMP(ALLOC_PRIM_ctr);\ + TICK_BUMP_BY(ALLOC_PRIM_adm,hdr);\ + TICK_BUMP_BY(ALLOC_PRIM_gds,goods);\ + TICK_BUMP_BY(ALLOC_PRIM_slp,slop); + +#define TICK_GC_FAILED_PROMOTION() TICK_BUMP(GC_FAILED_PROMOTION_ctr) + +#define TICK_ALLOC_TSO(n)\ + TICK_BUMP(ALLOC_TSO_ctr);\ + TICK_BUMP_BY(ALLOC_TSO_tot,n); + +#define TICK_ALLOC_STACK(n)\ + TICK_BUMP(ALLOC_STACK_ctr);\ + TICK_BUMP_BY(ALLOC_STACK_tot,n); + +#define TICK_ALLOC_UP_THK(g,s)\ + TICK_BUMP(ALLOC_UP_THK_ctr);\ + TICK_BUMP_BY(ALLOC_THK_gds,g);\ + TICK_BUMP_BY(ALLOC_THK_slp,s);\ + +#define TICK_ALLOC_SE_THK(g,s)\ + TICK_BUMP(ALLOC_SE_THK_ctr);\ + TICK_BUMP_BY(ALLOC_THK_gds,g);\ + TICK_BUMP_BY(ALLOC_THK_slp,s);\ + +#define TICK_ALLOC_RTS(bytes)\ + TICK_BUMP(ALLOC_RTS_ctr);\ + TICK_BUMP_BY(ALLOC_RTS_tot,n); #endif ===================================== rts/sm/Storage.c ===================================== @@ -996,7 +996,7 @@ move_STACK (StgStack *src, StgStack *dest) void accountAllocation(Capability *cap, W_ n) { - TICK_ALLOC_HEAP_NOCTR(WDS(n)); + TICK_ALLOC_RTS(WDS(n)); CCS_ALLOC(cap->r.rCCCS,n); if (cap->r.rCurrentTSO != NULL) { // cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae683454e66913ad735269b09f89a49cf6a7101d...b2dabe3a845f0068e40396fd82a8d97b29896564 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae683454e66913ad735269b09f89a49cf6a7101d...b2dabe3a845f0068e40396fd82a8d97b29896564 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:44:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 12:44:00 -0400 Subject: [Git][ghc/ghc][master] users guide: A few small mark-up fixes Message-ID: <646e3ed03d135_64cfbc2d3011636e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -25,11 +25,11 @@ given compilation phase: Use ⟨cmd⟩ as the literate pre-processor. .. ghc-flag:: -pgmP ⟨cmd⟩ - :shortdesc: Use ⟨cmd⟩ as the C pre-processor (with ``-cpp`` only) + :shortdesc: Use ⟨cmd⟩ as the C pre-processor (with :ghc-flag:`-cpp` only) :type: dynamic :category: phase-programs - Use ⟨cmd⟩ as the C pre-processor (with ``-cpp`` only). + Use ⟨cmd⟩ as the C pre-processor (with :ghc-flag:`-cpp` only). .. ghc-flag:: -pgmc ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the C compiler @@ -159,11 +159,11 @@ the following flags: Pass ⟨option⟩ to the literate pre-processor .. ghc-flag:: -optP ⟨option⟩ - :shortdesc: pass ⟨option⟩ to cpp (with ``-cpp`` only) + :shortdesc: pass ⟨option⟩ to cpp (with :ghc-flag:`-cpp` only) :type: dynamic :category: phase-options - Pass ⟨option⟩ to CPP (makes sense only if ``-cpp`` is also on). + Pass ⟨option⟩ to CPP (makes sense only if :ghc-flag:`-cpp` is also on). .. ghc-flag:: -optF ⟨option⟩ :shortdesc: pass ⟨option⟩ to the custom pre-processor @@ -308,9 +308,9 @@ Options affecting the C pre-processor :category: cpp The C pre-processor :command:`cpp` is run over your Haskell code if - the ``-cpp`` option or ``-XCPP`` extension are given. Unless you are building a - large system with significant doses of conditional compilation, you - really shouldn't need it. + the :ghc-flag:`-cpp` option or :extension:`CPP` extension are given. Unless + you are building a large system with significant doses of conditional + compilation, you really shouldn't need it. .. ghc-flag:: -D⟨symbol⟩[=⟨value⟩] :shortdesc: Define a symbol in the C pre-processor View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eac4420a8aab12a830037a4b65789d307aec0456 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eac4420a8aab12a830037a4b65789d307aec0456 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:44:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 12:44:38 -0400 Subject: [Git][ghc/ghc][master] configure: Fix support check for response files. Message-ID: <646e3ef69672c_64cfbc2d3012131@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - 1 changed file: - m4/fp_ld_supports_response_files.m4 Changes: ===================================== m4/fp_ld_supports_response_files.m4 ===================================== @@ -5,7 +5,7 @@ AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ AC_MSG_CHECKING([whether $LD supports response files]) echo 'int main(void) {return 0;}' > conftest.c "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf "-o\nconftest\nconftest.o\n" > args.txt + printf -- "-o\nconftest\nconftest.o\n" > args.txt if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 then LdSupportsResponseFiles=YES View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a320ca761c47ea90f9083165f44537bc939cccf6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a320ca761c47ea90f9083165f44537bc939cccf6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 16:45:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 12:45:19 -0400 Subject: [Git][ghc/ghc][master] [feat] add .direnv to the .gitignore file Message-ID: <646e3f1f39e39_64cfb34bdff4125544@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 1 changed file: - .gitignore Changes: ===================================== .gitignore ===================================== @@ -239,6 +239,7 @@ ghc.nix/ # direnv .envrc +.direnv # Visual Studio Code .vscode View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f21ce0e4357d527d29595ce32491b02ae3d6a564 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f21ce0e4357d527d29595ce32491b02ae3d6a564 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 19:58:17 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 24 May 2023 15:58:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23400 Message-ID: <646e6c591900b_64cfb3f40cd8159241@gitlab.mail> Ben Gamari pushed new branch wip/T23400 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23400 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 19:59:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 24 May 2023 15:59:22 -0400 Subject: [Git][ghc/ghc][wip/T23400] rts: Ensure that pinned allocations respect block size Message-ID: <646e6c9aca6cf_64cfb3f40cd8159440@gitlab.mail> Ben Gamari pushed to branch wip/T23400 at Glasgow Haskell Compiler / GHC Commits: 26480033 by Ben Gamari at 2023-05-24T15:58:32-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 1 changed file: - rts/sm/Storage.c Changes: ===================================== rts/sm/Storage.c ===================================== @@ -1231,6 +1231,74 @@ allocateMightFail (Capability *cap, W_ n) */ #define MEMSET_SLOP_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) +/** + * Finish the capability's current pinned object accumulator block + * (cap->pinned_object_block), if any, and start a new one. + */ +static bdescr * +start_new_pinned_block(Capability *cap) +{ + bdescr *bd = cap->pinned_object_block; + + // stash the old block on cap->pinned_object_blocks. On the + // next GC cycle these objects will be moved to + // g0->large_objects. + if (bd != NULL) { + // add it to the allocation stats when the block is full + finishedNurseryBlock(cap, bd); + dbl_link_onto(bd, &cap->pinned_object_blocks); + } + + // We need to find another block. We could just allocate one, + // but that means taking a global lock and we really want to + // avoid that (benchmarks that allocate a lot of pinned + // objects scale really badly if we do this). + // + // See Note [Sources of Block Level Fragmentation] + // for a more complete history of this section. + bd = cap->pinned_object_empty; + if (bd == NULL) { + // The pinned block list is empty: allocate a fresh block (we can't fail + // here). + ACQUIRE_SM_LOCK; + bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE); + RELEASE_SM_LOCK; + } + + // Bump up the nursery pointer to avoid the pathological situation + // where a program is *only* allocating pinned objects. + // T4018 fails without this safety. + // This has the effect of counting a full pinned block in the same way + // as a full nursery block, so GCs will be triggered at the same interval + // if you are only allocating pinned data compared to normal allocations + // via allocate(). + bdescr *nbd = cap->r.rCurrentNursery->link; + if (nbd != NULL){ + newNurseryBlock(nbd); + cap->r.rCurrentNursery->link = nbd->link; + if (nbd->link != NULL) { + nbd->link->u.back = cap->r.rCurrentNursery; + } + dbl_link_onto(nbd, &cap->r.rNursery->blocks); + // Important for accounting purposes + if (cap->r.rCurrentAlloc){ + finishedNurseryBlock(cap, cap->r.rCurrentAlloc); + } + cap->r.rCurrentAlloc = nbd; + } + + cap->pinned_object_empty = bd->link; + newNurseryBlock(bd); + if (bd->link != NULL) { + bd->link->u.back = cap->pinned_object_empty; + } + initBdescr(bd, g0, g0); + + cap->pinned_object_block = bd; + bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED; + return bd; +} + /* --------------------------------------------------------------------------- Allocate a fixed/pinned object. @@ -1258,135 +1326,76 @@ allocateMightFail (Capability *cap, W_ n) StgPtr allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ align_off /*bytes*/) { - StgPtr p; - bdescr *bd; - // Alignment and offset have to be a power of two - ASSERT(alignment && !(alignment & (alignment - 1))); - ASSERT(alignment >= sizeof(W_)); - - ASSERT(!(align_off & (align_off - 1))); + CHECK(alignment && !(alignment & (alignment - 1))); + CHECK(!(align_off & (align_off - 1))); + // We don't support sub-word alignments + CHECK(alignment >= sizeof(W_)); + + bdescr *bd = cap->pinned_object_block; + if (bd == NULL) { + bd = start_new_pinned_block(cap); + } const StgWord alignment_w = alignment / sizeof(W_); + W_ off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + + // If the request is is smaller than LARGE_OBJECT_THRESHOLD then + // allocate into the pinned object accumulator. + if (n + off_w < LARGE_OBJECT_THRESHOLD/sizeof(W_)) { + // If the current pinned object block isn't large enough to hold the new + // object, get a new one. + if ((bd->free + off_w + n) > (bd->start + BLOCK_SIZE_W)) { + bd = start_new_pinned_block(cap); + + // The pinned_object_block remains attached to the capability + // until it is full, even if a GC occurs. We want this + // behaviour because otherwise the unallocated portion of the + // block would be forever slop, and under certain workloads + // (allocating a few ByteStrings per GC) we accumulate a lot + // of slop. + // + // So, the pinned_object_block is initially marked + // BF_EVACUATED so the GC won't touch it. When it is full, + // we place it on the large_objects list, and at the start of + // the next GC the BF_EVACUATED flag will be cleared, and the + // block will be promoted as usual (if anything in it is + // live). + + off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + } - // If the request is for a large object, then allocate() - // will give us a pinned object anyway. - if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - // For large objects we don't bother optimizing the number of words - // allocated for alignment reasons. Here we just allocate the maximum - // number of extra words we could possibly need to satisfy the alignment - // constraint. - p = allocateMightFail(cap, n + alignment_w - 1); - if (p == NULL) { - return NULL; - } else { - Bdescr(p)->flags |= BF_PINNED; - W_ off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); + // N.B. it is important that we account for the alignment padding + // when determining large-object-ness, lest we may over-fill the + // block. See #23400. + if (n + off_w < LARGE_OBJECT_THRESHOLD/sizeof(W_)) { + StgPtr p = bd->free; MEMSET_SLOP_W(p, 0, off_w); + n += off_w; p += off_w; - MEMSET_SLOP_W(p + n, 0, alignment_w - off_w - 1); + bd->free += n; + ASSERT(bd->free <= bd->start + bd->blocks * BLOCK_SIZE_W); + accountAllocation(cap, n); return p; } } - bd = cap->pinned_object_block; - - W_ off_w = 0; - - if(bd) - off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); - - // If we don't have a block of pinned objects yet, or the current - // one isn't large enough to hold the new object, get a new one. - if (bd == NULL || (bd->free + off_w + n) > (bd->start + BLOCK_SIZE_W)) { - - // stash the old block on cap->pinned_object_blocks. On the - // next GC cycle these objects will be moved to - // g0->large_objects. - if (bd != NULL) { - // add it to the allocation stats when the block is full - finishedNurseryBlock(cap, bd); - dbl_link_onto(bd, &cap->pinned_object_blocks); - } - - // We need to find another block. We could just allocate one, - // but that means taking a global lock and we really want to - // avoid that (benchmarks that allocate a lot of pinned - // objects scale really badly if we do this). - // - // See Note [Sources of Block Level Fragmentation] - // for a more complete history of this section. - bd = cap->pinned_object_empty; - if (bd == NULL) { - // The pinned block list is empty: allocate a fresh block (we can't fail - // here). - ACQUIRE_SM_LOCK; - bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE); - RELEASE_SM_LOCK; - } - - // Bump up the nursery pointer to avoid the pathological situation - // where a program is *only* allocating pinned objects. - // T4018 fails without this safety. - // This has the effect of counting a full pinned block in the same way - // as a full nursery block, so GCs will be triggered at the same interval - // if you are only allocating pinned data compared to normal allocations - // via allocate(). - bdescr * nbd; - nbd = cap->r.rCurrentNursery->link; - if (nbd != NULL){ - newNurseryBlock(nbd); - cap->r.rCurrentNursery->link = nbd->link; - if (nbd->link != NULL) { - nbd->link->u.back = cap->r.rCurrentNursery; - } - dbl_link_onto(nbd, &cap->r.rNursery->blocks); - // Important for accounting purposes - if (cap->r.rCurrentAlloc){ - finishedNurseryBlock(cap, cap->r.rCurrentAlloc); - } - cap->r.rCurrentAlloc = nbd; - } - - - cap->pinned_object_empty = bd->link; - newNurseryBlock(bd); - if (bd->link != NULL) { - bd->link->u.back = cap->pinned_object_empty; - } - initBdescr(bd, g0, g0); - - cap->pinned_object_block = bd; - bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED; - - // The pinned_object_block remains attached to the capability - // until it is full, even if a GC occurs. We want this - // behaviour because otherwise the unallocated portion of the - // block would be forever slop, and under certain workloads - // (allocating a few ByteStrings per GC) we accumulate a lot - // of slop. - // - // So, the pinned_object_block is initially marked - // BF_EVACUATED so the GC won't touch it. When it is full, - // we place it on the large_objects list, and at the start of - // the next GC the BF_EVACUATED flag will be cleared, and the - // block will be promoted as usual (if anything in it is - // live). - - off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + // Otherwise handle the request as a large object + // For large objects we don't bother optimizing the number of words + // allocated for alignment reasons. Here we just allocate the maximum + // number of extra words we could possibly need to satisfy the alignment + // constraint. + StgPtr p = allocateMightFail(cap, n + alignment_w - 1); + if (p == NULL) { + return NULL; + } else { + Bdescr(p)->flags |= BF_PINNED; + off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); + MEMSET_SLOP_W(p, 0, off_w); + p += off_w; + MEMSET_SLOP_W(p + n, 0, alignment_w - off_w - 1); + return p; } - - p = bd->free; - - MEMSET_SLOP_W(p, 0, off_w); - - n += off_w; - p += off_w; - bd->free += n; - - accountAllocation(cap, n); - - return p; } /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/264800330b6e83ec1405ba8f646a36c3cdcbc300 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/264800330b6e83ec1405ba8f646a36c3cdcbc300 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 20:51:32 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 24 May 2023 16:51:32 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] 108 commits: testsuite: Add test for atomicSwapIORef Message-ID: <646e78d48adcd_64cfb7e2102416481b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - de3ff947 by Rodrigo Mesquita at 2023-05-24T09:57:51+01:00 WIP: Anotate provenance and mult or usageenv - - - - - 67c96946 by Rodrigo Mesquita at 2023-05-24T09:57:52+01:00 More fixes, in particular in bindNonRec... In bindNonRec make sure if we return a case instead of a let we make the idBinding correct - - - - - 089d823b by Rodrigo Mesquita at 2023-05-24T09:57:52+01:00 Lint binding site matches id binding - - - - - 904c7ecf by Rodrigo Mesquita at 2023-05-24T09:57:52+01:00 ROMES: WIP improvements In particular, we note that in dsUnliftedBind we pass to matchEquations variables which were let bound, which get further down the line used in matchOneConLike (and in bindNonRec too) as case-pattern bound variables! In this situation, where we use originally let-bound variables as case bound variables, we must ensure the case bound variables are set to be `LambdaBound` with the correct multiplicity (which should be some mix of scaling with the constructor annotated multiplicities) TODO: The multiplicity corresponding to the constructor multiplicity scaled by ... This broke through one more wall in the compilation of stage1 caused by incorrect provenences (well, really, by variables being moved around binding types while the provenence isn't updated) - - - - - 751c3c3b by Rodrigo Mesquita at 2023-05-24T09:57:52+01:00 Document 'selectMatchVars' - - - - - c687f6a9 by Rodrigo Mesquita at 2023-05-24T09:57:52+01:00 Make match variables always lambda bound The burning question being: Will variables selected for match (`selectMatchVar`) always be bound in case patterns? - - - - - ba6ab3e7 by Rodrigo Mesquita at 2023-05-24T09:57:52+01:00 ROMES WIP - - - - - d6ec303a by Rodrigo Mesquita at 2023-05-24T11:53:14+01:00 Temporary assertions bsed on typeable Drop this commit! - - - - - d1b53f3c by Rodrigo Mesquita at 2023-05-24T21:50:58+01:00 Fix IdBindings of multiple top-level let bindings - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d97c081f88fc793e336e76ac59c5c5c57e557612...d1b53f3c0a481b2f7e55076f37e0c8f634a42446 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d97c081f88fc793e336e76ac59c5c5c57e557612...d1b53f3c0a481b2f7e55076f37e0c8f634a42446 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 21:16:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 24 May 2023 17:16:18 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] Fix IdBindings of multiple top-level let bindings Message-ID: <646e7ea26a19_64cfb3f40c1016527@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 6d180bbb by Rodrigo Mesquita at 2023-05-24T22:16:02+01:00 Fix IdBindings of multiple top-level let bindings - - - - - 22 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/UsageEnv.hs-boot - compiler/GHC/Core/Utils.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Binds.hs-boot - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Expr.hs-boot - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Types/Var.hs - compiler/Language/Haskell/Syntax/Binds.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -253,7 +253,7 @@ data Expr b | Lit Literal | App (Expr b) (Arg b) | HasCallStack => Lam b (Expr b) - | Let (Bind b) (Expr b) + | HasCallStack => Let (Bind b) (Expr b) | Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants] -- and Note [Why does Case have a 'Type' field?] | Cast (Expr b) CoercionR -- The Coercion has Representational role @@ -313,9 +313,10 @@ instance Ord AltCon where -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint -data Bind b = NonRec b (Expr b) - | Rec [(b, (Expr b))] - deriving Data +data Bind b = HasCallStack => NonRec b (Expr b) + | HasCallStack => Rec [(b, (Expr b))] + +deriving instance Data b => Data (Bind b) {- Note [Shadowing] @@ -1928,23 +1929,23 @@ mkDoubleLitDouble d = Lit (mkLitDouble (toRational d)) -- | Bind all supplied binding groups over an expression in a nested let expression. Assumes -- that the rhs satisfies the let-can-float invariant. Prefer to use -- 'GHC.Core.Make.mkCoreLets' if possible, which does guarantee the invariant -mkLets :: Typeable b => [Bind b] -> Expr b -> Expr b +mkLets :: HasCallStack => Typeable b => [Bind b] -> Expr b -> Expr b -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to -- use 'GHC.Core.Make.mkCoreLams' if possible mkLams :: forall b. HasCallStack => Typeable b => [b] -> Expr b -> Expr b -mkLams binders body = case eqT @b @Id of Just Refl -> assertPpr (all isLambdaBinding binders) (text "mkLams: A let-bound var [" <+> hsep (map pprIdWithBinding binders) <+> text "] was used to construct a lambda binder!") $ foldr Lam body binders +mkLams binders body = case eqT @b @Id of Just Refl -> if not (all isLambdaBinding binders) then pprPanic "mkLams" (text "A let-bound var [" <+> hsep (map pprIdWithBinding binders) <+> text "] was used to construct a lambda binder!") else foldr Lam body binders Nothing -> foldr Lam body binders mkLets binds body = foldr mkLet body binds -- ROMES:TODO: temporary assertions, this is validated in the linter... -mkLet :: forall b. Typeable b +mkLet :: forall b. HasCallStack => Typeable b => Bind b -> Expr b -> Expr b -- The desugarer sometimes generates an empty Rec group -- which Lint rejects, so we kill it off right away mkLet (Rec []) body = body -mkLet bind body = case (eqT @b @Id) of Just Refl -> assertPpr (isLetBinder bind) (text "mkLet: A lambda-bound var [" <+> pprLetBinderId bind <+> text "] was used to construct a let binder!") $ Let bind body +mkLet bind body = case (eqT @b @Id) of Just Refl -> if not (isLetBinder bind) then pprPanic "mkLet" (text "A lambda-bound var [" <+> pprLetBinderId bind <+> text "] was used to construct a let binder!") else Let bind body Nothing -> Let bind body where isLetBinder (NonRec b _) = isLetBinding b ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -112,7 +112,7 @@ sortQuantVars vs = sorted_tcvs ++ ids -- | Bind a binding group over an expression, using a @let@ or @case@ as -- appropriate (see "GHC.Core#let_can_float_invariant") -mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr +mkCoreLet :: HasCallStack => CoreBind -> CoreExpr -> CoreExpr mkCoreLet (NonRec bndr rhs) body -- See Note [Core let-can-float invariant] = bindNonRec bndr rhs body mkCoreLet bind body ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -549,6 +549,7 @@ instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where -- only exist for Ids, not TyVars and such -- The impl for varMultMaybe will surely chnge data BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a)) +-- ROMES:TODO: AGAIN; FIX THIS. -- TODO(22292): derive instance Functor BndrMap where ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2360,6 +2360,10 @@ occAnal env (Case scrut bndr ty alts) (alt_usg, Alt con tagged_bndrs rhs1) occAnal env (Let bind body) + | NonRec b _ <- bind + , isLambdaBinding b + = pprPanic "occAnal" (pprIdWithBinding b) + | otherwise = let body_env = env { occ_encl = OccVanilla } `addInScope` bindersOf bind (WithUsageDetails body_usage body') = occAnal body_env body ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -602,10 +602,11 @@ lvlNonTailMFE :: LevelEnv -- Level of in-scope names/tyvars lvlNonTailMFE env strict_ctxt ann_expr = lvlMFE (placeJoinCeiling env) strict_ctxt ann_expr -lvlMFE :: LevelEnv -- Level of in-scope names/tyvars - -> Bool -- True <=> strict context [body of case or let] - -> CoreExprWithFVs -- input expression - -> LvlM LevelledExpr -- Result expression +lvlMFE :: HasCallStack + => LevelEnv -- Level of in-scope names/tyvars + -> Bool -- True <=> strict context [body of case or let] + -> CoreExprWithFVs -- input expression + -> LvlM LevelledExpr -- Result expression -- lvlMFE is just like lvlExpr, except that it might let-bind -- the expression, so that it can itself be floated. @@ -1274,7 +1275,7 @@ lvlRhs env rec_flag is_bot mb_join_arity expr = lvlFloatRhs [] (le_ctxt_lvl env) env rec_flag is_bot mb_join_arity expr --- ROMES:TODO: Document this function, what does it do? +-- ROMES:TODO: Document this function, what does it do? With some examples. lvlFloatRhs :: HasCallStack => [OutVar] -> Level -> LevelEnv -> RecFlag -> Bool -- Binding is for a bottoming function -> Maybe JoinArity @@ -1293,7 +1294,7 @@ lvlFloatRhs abs_vars dest_lvl env rec is_bot mb_join_arity rhs | otherwise = collectAnnBndrs rhs (env1, bndrs1) = substBndrsSL NonRecursive env bndrs - all_bndrs = pprTrace "lvlFloatRhs" (text "abs_vars:" <+> ppr abs_vars $$ text "bndrs1:" <+> ppr bndrs1) $ abs_vars ++ bndrs1 + all_bndrs = abs_vars ++ bndrs1 (body_env, bndrs') | Just _ <- mb_join_arity = lvlJoinBndrs env1 dest_lvl rec all_bndrs | otherwise ===================================== compiler/GHC/Core/UsageEnv.hs-boot ===================================== @@ -6,6 +6,7 @@ import {-# SOURCE #-} GHC.Core.TyCo.Rep (Mult) data Usage -- = Zero | Bottom | MUsage Mult data UsageEnv -- = UsageEnv !(NameEnv Mult) Bool +zeroUE :: UsageEnv nonDetMults :: UsageEnv -> [Mult] mapUE :: (Mult -> Mult) -> UsageEnv -> UsageEnv mapUEM :: Applicative m => (Mult -> m Mult) -> UsageEnv -> m UsageEnv ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -113,6 +113,7 @@ import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL ) import Data.Ord ( comparing ) import qualified Data.Set as Set import GHC.Types.RepType (isZeroBitTy) +import GHC.Core.UsageEnv (zeroUE) {- ************************************************************************ @@ -492,7 +493,7 @@ stripTicksT p expr = fromOL $ go expr ************************************************************************ -} -bindNonRec :: HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr +bindNonRec :: HasCallStack => HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr -- ^ @bindNonRec x r b@ produces either: -- -- > let x = r in b @@ -519,8 +520,10 @@ bindNonRec bndr rhs body | needsCaseBinding (idType bndr) rhs = pprTrace "bindNonRec:needsCaseBinding:" (ppr bndr <+> ppr (idBinding bndr)) case_bind | otherwise = let_bind where - case_bind = mkDefaultCase rhs (setIdBinding bndr (maybe (LambdaBound ManyTy) LambdaBound (varMultMaybe bndr))) body -- ROMES:TODO: Explain - let_bind = Let (NonRec bndr rhs) body + lambda_bndr = setIdBinding bndr (maybe (LambdaBound ManyTy) LambdaBound (varMultMaybe bndr)) -- ROMES:TODO: Explain, is this the best place to do this? + case_bind = mkDefaultCase rhs lambda_bndr body + -- ROMES:TODO: I couldn't find the root cause, for now we simply override the idBinding here + let_bind = Let (NonRec (bndr `setIdBinding` LetBound zeroUE) rhs) body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -786,7 +786,7 @@ mkHsWrapPatCo :: TcCoercionN -> Pat GhcTc -> Type -> Pat GhcTc mkHsWrapPatCo co pat ty | isReflCo co = pat | otherwise = XPat $ CoPat (mkWpCastN co) pat ty -mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc +mkHsDictLet :: HasCallStack => TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr {- @@ -816,10 +816,10 @@ mkTopFunBind origin fn ms = FunBind { fun_id = fn -- binding } -mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs +mkHsVarBind :: HasCallStack => SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs mkHsVarBind loc var rhs = mkSimpleGeneratedFunBind loc var [] rhs -mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p) +mkVarBind :: HasCallStack => IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p) mkVarBind var rhs = L (getLoc rhs) $ VarBind { var_ext = noExtField, var_id = var, var_rhs = rhs } ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -109,7 +109,7 @@ import Data.Traversable (for) -} -- | Main entry point to the desugarer. -deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages DsMessage, Maybe ModGuts) +deSugar :: HasCallStack => HscEnv -> ModLocation -> TcGblEnv -> IO (Messages DsMessage, Maybe ModGuts) -- Can modify PCS by faulting in more declarations deSugar hsc_env ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Types.Id.Make ( nospecId ) import GHC.Types.Name import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Types.Var( EvVar ) +import GHC.Types.Var( EvVar, isLetBinding ) import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Unique.Set( nonDetEltsUniqSet ) @@ -94,7 +94,8 @@ import Control.Monad -- | Desugar top level binds, strict binds are treated like normal -- binds since there is no good time to force before first usage. -dsTopLHsBinds :: LHsBinds GhcTc -> DsM (OrdList (Id,CoreExpr)) +dsTopLHsBinds :: HasCallStack + => LHsBinds GhcTc -> DsM (OrdList (Id,CoreExpr)) dsTopLHsBinds binds -- see Note [Strict binds checks] | not (isEmptyBag unlifted_binds) || not (isEmptyBag bang_binds) @@ -122,20 +123,23 @@ dsTopLHsBinds binds -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] -dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) +dsLHsBinds :: HasCallStack + => LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { ds_bs <- mapBagM dsLHsBind binds ; return (foldBag (\(a, a') (b, b') -> (a ++ b, a' ++ b')) id ([], []) ds_bs) } ------------------------ -dsLHsBind :: LHsBind GhcTc +dsLHsBind :: HasCallStack + => LHsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). -dsHsBind :: DynFlags +dsHsBind :: HasCallStack + => DynFlags -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) -- ^ The Ids of strict binds, to be forced in the body of the @@ -144,6 +148,9 @@ dsHsBind :: DynFlags dsHsBind dflags (VarBind { var_id = var , var_rhs = expr }) + | not (isLetBinding var) + = pprPanic "dsHsBind:VarBind" (ppr var <+> text " should be let bound!") + | otherwise = do { core_expr <- dsLExpr expr -- Dictionary bindings are always VarBinds, -- so we only need do this here @@ -157,6 +164,9 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun , fun_matches = matches , fun_ext = (co_fn, tick) }) + | not (isLetBinding fun) + = pprPanic "dsHsBind:FunBind" (ppr fun <+> text " should be let bound!") + | otherwise = do { dsHsWrapper co_fn $ \core_wrap -> do { (args, body) <- addTyCs FromSource (hsWrapDictBinders co_fn) $ -- FromSource might not be accurate (we don't have any @@ -1183,7 +1193,7 @@ dsl_coherence field of DsM's local environment. -} -dsHsWrapper :: HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a +dsHsWrapper :: HasCallStack => HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a dsHsWrapper WpHole k = k $ \e -> e dsHsWrapper (WpTyApp ty) k = k $ \e -> App e (Type ty) dsHsWrapper (WpEvLam ev) k = k $ Lam ev @@ -1223,20 +1233,25 @@ dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> dsHsWrappers [] k = k [] -------------------------------------- -dsTcEvBinds_s :: [TcEvBinds] -> ([CoreBind] -> DsM a) -> DsM a +dsTcEvBinds_s :: HasCallStack => [TcEvBinds] -> ([CoreBind] -> DsM a) -> DsM a dsTcEvBinds_s [] k = k [] dsTcEvBinds_s (b:rest) k = assert (null rest) $ -- Zonker ensures null dsTcEvBinds b k -dsTcEvBinds :: TcEvBinds -> ([CoreBind] -> DsM a) -> DsM a -dsTcEvBinds (TcEvBinds {}) = panic "dsEvBinds" -- Zonker has got rid of this -dsTcEvBinds (EvBinds bs) = dsEvBinds bs +dsTcEvBinds :: HasCallStack => TcEvBinds -> ([CoreBind] -> DsM a) -> DsM a +dsTcEvBinds (TcEvBinds {}) _ = panic "dsEvBinds" -- Zonker has got rid of this +dsTcEvBinds (EvBinds bs) f = do + -- ROMES:TODO: + -- mapBagM (\b -> if not (isLetBinding (evBindVar b)) then pprPanic "dsTcEvBinds" (ppr $ evBindVar b) else pure ()) bs + dsEvBinds bs f -- * Desugars the ev_binds, sorts them into dependency order, and -- passes the resulting [CoreBind] to thing_inside -- * Extends the DsM (dsl_coherence field) with coherence information -- for each binder in ev_binds, before invoking thing_inside -dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a +-- +-- ROMES:TODO: Does this always result in let bindings? +dsEvBinds :: HasCallStack => Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside = do { ds_binds <- mapBagM dsEvBind ev_binds ; let comps = sort_ev_binds ds_binds ===================================== compiler/GHC/HsToCore/Binds.hs-boot ===================================== @@ -2,5 +2,6 @@ module GHC.HsToCore.Binds where import GHC.HsToCore.Monad ( DsM ) import GHC.Core ( CoreExpr ) import GHC.Tc.Types.Evidence (HsWrapper) +import GHC.Stack (HasCallStack) -dsHsWrapper :: HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a +dsHsWrapper :: HasCallStack => HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -76,7 +76,7 @@ import Control.Monad ************************************************************************ -} -dsLocalBinds :: HsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr +dsLocalBinds :: HasCallStack => HsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr dsLocalBinds (EmptyLocalBinds _) body = return body dsLocalBinds b@(HsValBinds _ binds) body = putSrcSpanDs (spanHsLocaLBinds b) $ dsValBinds binds body @@ -84,7 +84,7 @@ dsLocalBinds (HsIPBinds _ binds) body = dsIPBinds binds body ------------------------- -- caller sets location -dsValBinds :: HsValBinds GhcTc -> CoreExpr -> DsM CoreExpr +dsValBinds :: HasCallStack => HsValBinds GhcTc -> CoreExpr -> DsM CoreExpr dsValBinds (XValBindsLR (NValBinds binds _)) body = foldrM ds_val_bind body binds dsValBinds (ValBinds {}) _ = panic "dsValBinds ValBindsIn" @@ -105,7 +105,7 @@ dsIPBinds (IPBinds ev_binds ip_binds) body ------------------------- -- caller sets location -ds_val_bind :: (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr +ds_val_bind :: HasCallStack => (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr -- Special case for bindings which bind unlifted variables -- We need to do a case right away, rather than building -- a tuple and doing selections. ===================================== compiler/GHC/HsToCore/Expr.hs-boot ===================================== @@ -3,8 +3,9 @@ import GHC.Hs ( HsExpr, LHsExpr, HsLocalBinds, SyntaxExpr ) import GHC.HsToCore.Monad ( DsM ) import GHC.Core ( CoreExpr ) import GHC.Hs.Extension ( GhcTc) +import GHC.Stack ( HasCallStack ) dsExpr :: HsExpr GhcTc -> DsM CoreExpr dsLExpr :: LHsExpr GhcTc -> DsM CoreExpr dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr -dsLocalBinds :: HsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr +dsLocalBinds :: HasCallStack => HsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/GuardedRHSs.hs ===================================== @@ -55,7 +55,7 @@ dsGuarded grhss rhs_ty rhss_nablas = do -- In contrast, @dsGRHSs@ produces a @MatchResult CoreExpr at . -dsGRHSs :: HsMatchContext GhcRn +dsGRHSs :: HasCallStack => HsMatchContext GhcRn -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ Guarded RHSs -> Type -- ^ Type of RHS -> NonEmpty Nablas -- ^ Refined pattern match checking ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -738,7 +738,8 @@ Call @match@ with all of this information! -- p2 q2 -> ... matchWrapper - :: HsMatchContext GhcRn -- ^ For shadowing warning messages + :: HasCallStack + => HsMatchContext GhcRn -- ^ For shadowing warning messages -> Maybe [LHsExpr GhcTc] -- ^ Scrutinee(s) -- see Note [matchWrapper scrutinees] -> MatchGroup GhcTc (LHsExpr GhcTc) -- ^ Matches being desugared ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -16,7 +16,8 @@ match :: HasCallStack => [Id] -> DsM (MatchResult CoreExpr) matchWrapper - :: HsMatchContext GhcRn + :: HasCallStack + => HsMatchContext GhcRn -> Maybe [LHsExpr GhcTc] -> MatchGroup GhcTc (LHsExpr GhcTc) -> DsM ([Id], CoreExpr) ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -92,6 +92,8 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (maybeToList) import qualified Data.List.NonEmpty as NEL +import GHC.Core.UsageEnv (zeroUE) + {- ************************************************************************ * * @@ -378,7 +380,7 @@ mkDataConCase var ty alts@(alt1 :| _) , alt_result = match_result } = flip adjustMatchResultDs match_result $ \body -> do case dataConBoxer con of - Nothing -> pprTrace "mk_alt" (ppr (map (\x -> (idBinding x, x)) args)) $ return (Alt (DataAlt con) args body) + Nothing -> pprTrace "mk_alt" (hsep (map pprIdWithBinding args)) $ return (Alt (DataAlt con) args body) Just (DCB boxer) -> do us <- newUniqueSupply let (rep_ids, binds) = initUs_ us (boxer ty_args args) @@ -923,7 +925,7 @@ mkFailurePair :: CoreExpr -- Result type of the whole case expression CoreExpr) -- Fail variable applied to realWorld# -- See Note [Failure thunks and CPR] mkFailurePair expr - = do { fail_fun_var <- newFailLocalDs (LambdaBound ManyTy) (unboxedUnitTy `mkVisFunTyMany` ty) -- ROMES:TODO: Failure pair LambdaBound? + = do { fail_fun_var <- newFailLocalDs (LetBound zeroUE) (unboxedUnitTy `mkVisFunTyMany` ty) ; fail_fun_arg <- newSysLocalDs (LambdaBound ManyTy) unboxedUnitTy ; let real_arg = setOneShotLambda fail_fun_arg ; return (NonRec fail_fun_var (Lam real_arg expr), ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Data.Maybe( orElse, whenIsJust ) import Data.Maybe( mapMaybe ) import qualified Data.List.NonEmpty as NE import Control.Monad( unless ) +import GHC.Core.UsageEnv (zeroUE) {- ------------------------------------------------------------- @@ -231,7 +232,10 @@ tcUserTypeSig loc hs_sig_ty mb_name = do { sigma_ty <- tcHsSigWcType ctxt_no_rrc hs_sig_ty ; traceTc "tcuser" (ppr sigma_ty) ; return $ - CompleteSig { sig_bndr = mkLocalId name (LambdaBound ManyTy) sigma_ty -- ROMES:TODO: LambdaBound? + -- Romes: If this identifier gets bound, it is a + -- top-level let binder with a closed usage + -- env. + CompleteSig { sig_bndr = mkLocalId name (LetBound zeroUE) sigma_ty -- We use `Many' as the multiplicity here, -- as if this identifier corresponds to -- anything, it is a top-level ===================================== compiler/GHC/Tc/Instance/Typeable.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Unit.Module import GHC.Hs import GHC.Driver.Session import GHC.Data.Bag -import GHC.Types.Var ( VarBndr(..) ) +import GHC.Types.Var ( VarBndr(..), pprIdWithBinding ) import GHC.Core.Map.Type import GHC.Settings.Constants import GHC.Utils.Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints) @@ -49,6 +49,9 @@ import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Class (lift) import Data.Maybe ( isJust ) +import GHC.Core.UsageEnv (zeroUE) +import GHC.Stack ( HasCallStack ) + {- Note [Grand plan for Typeable] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The overall plan is this: @@ -273,7 +276,7 @@ todoForExportedKindReps kinds = do return $ ExportedKindRepsTodo $ map mkId kinds -- | Generate TyCon bindings for a set of type constructors -mkTypeRepTodoBinds :: [TypeRepTodo] -> TcM TcGblEnv +mkTypeRepTodoBinds :: HasCallStack => [TypeRepTodo] -> TcM TcGblEnv mkTypeRepTodoBinds [] = getGblEnv mkTypeRepTodoBinds todos = do { stuff <- collect_stuff @@ -417,7 +420,7 @@ mkTrNameLit = do return trNameLit -- | Make Typeable bindings for the given 'TyCon'. -mkTyConRepBinds :: TypeableStuff -> TypeRepTodo +mkTyConRepBinds :: HasCallStack => TypeableStuff -> TypeRepTodo -> TypeableTyCon -> KindRepM (LHsBinds GhcTc) mkTyConRepBinds stuff todo (TypeableTyCon {..}) = do -- Make a KindRep @@ -523,7 +526,7 @@ addKindRepBind in_scope k bndr rhs = -- | Run a 'KindRepM' and add the produced 'KindRep's to the typechecking -- environment. -runKindRepM :: KindRepM a -> TcRn (TcGblEnv, a) +runKindRepM :: HasCallStack => KindRepM a -> TcRn (TcGblEnv, a) runKindRepM (KindRepM action) = do kindRepEnv <- initialKindRepEnv (res, reps_env) <- runStateT action kindRepEnv @@ -552,11 +555,13 @@ getKindRep stuff@(Stuff {..}) in_scope = go = return (nlHsVar id, env) -- We need to construct a new KindRep binding + -- (Romes: This will be a top level binding, so the binding is + -- let-bound with a closed usage env) | otherwise = do -- Place a NOINLINE pragma on KindReps since they tend to be quite -- large and bloat interface files. rep_bndr <- (`setInlinePragma` neverInlinePragma) - <$> newSysLocalId (fsLit "$krep") (LambdaBound ManyTy) (mkTyConTy kindRepTyCon) -- ROMES:TODO: Are these type variables? What provenance should we give them + <$> newSysLocalId (fsLit "$krep") (LetBound zeroUE) (mkTyConTy kindRepTyCon) -- do we need to tie a knot here? flip runStateT env $ unKindRepM $ do ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE StandaloneDeriving #-} module GHC.Tc.Types.Evidence ( @@ -169,13 +171,13 @@ data HsWrapper | WpTyApp KindOrType -- [] t the 't' is a type (not coercion) - | WpLet TcEvBinds -- Non-empty (or possibly non-empty) evidence bindings, + | HasCallStack => WpLet TcEvBinds -- Non-empty (or possibly non-empty) evidence bindings, -- so that the identity coercion is always exactly WpHole | WpMultCoercion Coercion -- Require that a Coercion be reflexive; otherwise, -- error in the desugarer. See GHC.Tc.Utils.Unify -- Note [Wrapper returned from tcSubMult] - deriving Data.Data +deriving instance Data.Data HsWrapper -- | The Semigroup instance is a bit fishy, since @WpCompose@, as a data -- constructor, is "syntactic" and not associative. Concretely, if @a@, @b@, @@ -261,10 +263,15 @@ mkWpTyLams ids = mk_co_lam_fn WpTyLam ids mkWpEvLams :: [Var] -> HsWrapper mkWpEvLams ids = mk_co_lam_fn WpEvLam ids -mkWpLet :: TcEvBinds -> HsWrapper +mkWpLet :: HasCallStack => TcEvBinds -> HsWrapper -- This no-op is a quite a common case mkWpLet (EvBinds b) | isEmptyBag b = WpHole -mkWpLet ev_binds = WpLet ev_binds +mkWpLet ev_binds + | EvBinds bs <- ev_binds + , anyBag (isLambdaBinding . evBindVar) bs + = pprPanic "mkWpEvLams" (ppr $ mapBag (pprIdWithBinding . evBindVar) bs) + | otherwise + = WpLet ev_binds mk_co_lam_fn :: (a -> HsWrapper) -> [a] -> HsWrapper mk_co_lam_fn f as = foldr (\x wrap -> f x <.> wrap) WpHole as ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -6,7 +6,7 @@ -} {-# LANGUAGE FlexibleContexts, MultiWayIf, FlexibleInstances, DeriveDataTypeable, - PatternSynonyms, BangPatterns, GADTs #-} + PatternSynonyms, BangPatterns, GADTs, RankNTypes #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} -- | @@ -130,6 +130,8 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain +import {-# SOURCE #-} GHC.Core.UsageEnv (zeroUE) + import Data.Data {- @@ -273,7 +275,7 @@ data Var realUnique :: {-# UNPACK #-} !Int, varType :: Type, -- ROMES:TODO: merge binding and scope? - idBinding :: IdBinding, -- See Note [Multiplicity of let binders] + idBinding :: HasCallStack => IdBinding, -- See Note [Multiplicity of let binders] idScope :: IdScope, id_details :: IdDetails, -- Stable, doesn't change id_info :: IdInfo } -- Unstable, updated by simplifier @@ -286,17 +288,29 @@ data IdBinding where -- Might no longer make sense to merge with IdScope at all pprIdWithBinding :: Id -> SDoc -pprIdWithBinding x = ppr x <> text "[" <> ppr (idBinding x) <> text "]" +pprIdWithBinding x + | isId x + = ppr x <> text "[" <> ppr (idBinding x) <> text "]" + | otherwise + = ppr x <+> text "is not an Id" isLetBinding :: Id -> Bool -isLetBinding x = case idBinding x of +isLetBinding x + | isId x + = case idBinding x of LetBound _ -> True LambdaBound _ -> False + | otherwise + = True -- ROMES:TODO: ouch isLambdaBinding :: Id -> Bool -isLambdaBinding x = case idBinding x of +isLambdaBinding x + | isId x + = case idBinding x of LetBound _ -> False LambdaBound _ -> True + | otherwise + = True -- ROMES:TODO: ouch {- Note the binding sites considered in Core (see lintCoreExpr, lintIdBinder) @@ -1177,8 +1191,8 @@ idDetails other = pprPanic "idDetails" (ppr other) -- Ids, because "GHC.Types.Id" uses 'mkGlobalId' etc with different types mkGlobalVar :: IdDetails -> Name -> Type -> IdInfo -> Id mkGlobalVar details name ty info - -- ROMES: This doesn't really classify as LambdaBound, but has the semantics we want... - = mk_id name (LambdaBound manyDataConTy) ty GlobalId details info + -- ROMES: A global variable is let-bound with a closed linear environment + = mk_id name (LetBound zeroUE) ty GlobalId details info -- There is no support for linear global variables yet. They would require -- being checked at link-time, which can be useful, but is not a priority. @@ -1194,8 +1208,8 @@ mkCoVar name ty = mk_id name (LambdaBound manyDataConTy) ty (LocalId NotExported -- | Exported 'Var's will not be removed as dead code mkExportedLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id mkExportedLocalVar details name ty info - -- ROMES:TODO: As in mkGlobalVar, this isn't really LambdaBound I figure - = mk_id name (LambdaBound manyDataConTy) ty (LocalId Exported) details info + -- ROMES: Exported variables are as global bound, let-bound with a closed usage env + = mk_id name (LetBound zeroUE) ty (LocalId Exported) details info -- There is no support for exporting linear variables. See also [mkGlobalVar] mk_id :: Name -> IdBinding -> Type -> IdScope -> IdDetails -> IdInfo -> Id ===================================== compiler/Language/Haskell/Syntax/Binds.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes, ExistentialQuantification #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] @@ -42,6 +43,8 @@ import Data.Void import Data.Bool import Data.Maybe +import GHC.Stack (HasCallStack) + {- ************************************************************************ * * @@ -193,11 +196,11 @@ data HsBindLR idL idR -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose', -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - FunBind { + HasCallStack => FunBind { fun_ext :: XFunBind idL idR, - fun_id :: LIdP idL, -- Note [fun_id in Match] in GHC.Hs.Expr + fun_id :: HasCallStack => LIdP idL, -- Note [fun_id in Match] in GHC.Hs.Expr ROMES:TODO: Revive note fun_matches :: MatchGroup idR (LHsExpr idR) -- ^ The payload @@ -226,9 +229,9 @@ data HsBindLR idL idR -- -- Dictionary binding and suchlike. -- All VarBinds are introduced by the type checker - | VarBind { + | HasCallStack => VarBind { var_ext :: XVarBind idL idR, - var_id :: IdP idL, + var_id :: HasCallStack => IdP idL, var_rhs :: LHsExpr idR -- ^ Located only for consistency } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d180bbb41c0df7f0bdc2596ede7ea28d46b8307 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d180bbb41c0df7f0bdc2596ede7ea28d46b8307 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 21:48:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 17:48:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Migrate errors in GHC.Tc.Validity Message-ID: <646e862d1dd58_64cfb3f40cd8175845@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 22251dfd by Bodigrim at 2023-05-24T17:48:20-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - a588b801 by Bartłomiej Cieślar at 2023-05-24T17:48:23-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 30 changed files: - .gitignore - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/phases.rst - libraries/base/Data/List.hs - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/base/changelog.md - m4/fp_ld_supports_response_files.m4 - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Threads.c - rts/Ticky.c - rts/include/Cmm.h - rts/include/stg/Ticky.h - rts/sm/Storage.c - testsuite/driver/testlib.py - + testsuite/tests/backpack/should_compile/T23424.bkp - testsuite/tests/backpack/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f95aed749bb90574be538e434d4f55cdb7705ac...a588b8013f733fe91e1285f63cdb36e56284084e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f95aed749bb90574be538e434d4f55cdb7705ac...a588b8013f733fe91e1285f63cdb36e56284084e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 22:14:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 24 May 2023 18:14:16 -0400 Subject: [Git][ghc/ghc][ghc-9.6] 2 commits: docs: 9.6.2 release notes Message-ID: <646e8c381b1f4_64cfb9f597f0191616@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: 7e70df17 by Ben Gamari at 2023-05-22T20:18:09-04:00 docs: 9.6.2 release notes - - - - - 9a1dcec1 by Ben Gamari at 2023-05-22T20:18:17-04:00 configure: RELEASE=NO - - - - - 3 changed files: - configure.ac - + docs/users_guide/9.6.2-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== configure.ac ===================================== @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.2], [glasgow-has AC_CONFIG_MACRO_DIRS([m4]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=YES} +: ${RELEASE=NO} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== docs/users_guide/9.6.2-notes.rst ===================================== @@ -0,0 +1,88 @@ +.. _release-9-6-2: + +Version 9.6.2 +============== + +The significant changes to the various parts of the compiler are listed below. +See the `migration guide +`_ on the GHC Wiki +for specific guidance on migrating programs to this release. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +11, 12, 13, 14 or 15. + +- A :ghc-ticket:`simplifier bug <22761>` resulting in compiler crashes in some + situations involving rules has been fixed. + +- Several issues affecting the bytecode interpreter's handling of optimised + programs have been fixed (:ghc-ticket:`23068`, :ghc-ticket:`22958`) + +- A specialisation bug resulting looping of some programs involving + non-trivial chains of instances (namely, requiring + :extension:`UndecidableInstances`) has been fixed (:ghc-ticket:`22549`) + +- A bug resulting in crashes of programs using the new ``listThreads#`` primop + has been fixed (:ghc-ticket:`23071`). + +- A compiler crash triggered by certain uses of quantified constraints has been + fixed (:ghc-ticket:`23171`) + +- Various bugs in the Javascript backend have been fixed (:ghc-ticket:`23399`, + :ghc-ticket:`23360`, :ghc-ticket:`23346`) + +- The non-moving garbage collector's treatment of weak pointers has been + revamped which should allow more reliable finalization of ``Weak#`` + closures (:ghc-ticket:`22327`) + +- The non-moving garbage collector now bounds the amount of marking it will + do during the post-marking stop-the-world phase, greatly reducing tail + latencies in some programs (:ghc-ticket:`22929`) + +- A missing write barrier in the non-moving collector's handling of selector + thunks has been fixed (:ghc-ticket:`22930`). + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/libiserv/libiserv.cabal: Internal compiler library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + ===================================== docs/users_guide/release-notes.rst ===================================== @@ -5,3 +5,4 @@ Release notes :maxdepth: 1 9.6.1-notes + 9.6.2-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07243d1b1ad92c98f4728afb31fc9c39573c14f0...9a1dcec1be8421d415c4592231e6c24af7e7e013 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07243d1b1ad92c98f4728afb31fc9c39573c14f0...9a1dcec1be8421d415c4592231e6c24af7e7e013 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 22:46:30 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 24 May 2023 18:46:30 -0400 Subject: [Git][ghc/ghc][wip/expand-do] add correct source spans for warnDiscardedDoBindings Message-ID: <646e93c6db34a_64cfb4108db8195568@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 4fdaa4de by Apoorv Ingle at 2023-05-24T17:46:08-05:00 add correct source spans for warnDiscardedDoBindings - - - - - 3 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -752,9 +752,10 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr x instance Outputable XXExprGhcRn where - ppr (ExpansionExprRn (HsExpanded (Left e) _)) = ppr e - ppr (ExpansionExprRn (HsExpanded (Right e) _)) = ppr e - ppr (PopSrcSpan e) = ppr e + ppr (ExpansionExprRn (HsExpanded (Left o) e)) = ppr (HsExpanded o e) + ppr (ExpansionExprRn (HsExpanded (Right o) e)) = ppr (HsExpanded o e) + ppr (PopSrcSpan e) = ifPprDebug (text "PopSrcSpan" <+> ppr e) + (ppr e) instance Outputable XXExprGhcTc where ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -855,7 +855,7 @@ warnDiscardedDoBindings rhs rhs_ty warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () -warnUnusedBindValue fun arg arg_ty +warnUnusedBindValue fun arg@(L loc _) arg_ty | Just (l, f) <- fish_var fun , f `hasKey` thenMClassOpKey -- it is a (>>) , isNoSrcSpan l || isGeneratedSrcSpan l -- it is compiler generated @@ -865,7 +865,7 @@ warnUnusedBindValue fun arg arg_ty , text "locGen?" <+> ppr (isGeneratedSrcSpan l) , text "noLoc?" <+> ppr (isNoSrcSpan l) ]) - warnDiscardedDoBindings arg arg_ty + putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty where -- retrieve the location info and the head of the application -- It is important that we /do not/ look through HsApp to avoid ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1369,24 +1369,46 @@ mk_failable_lexpr_tcm pat lexpr fail_op = mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ - (noLocA [ mkHsCaseAlt pat (genPopSrcSpanExpr lexpr) -- pat -> expr + return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ + (noLocA [ mkHsCaseAlt pat (genPopSrcSpanExpr lexpr) -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" - (noLocA $ genHsApp fail_op - (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) + (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) ])) where - mk_fail_msg_expr :: DynFlags -> HsDoFlavour -> LPat GhcRn -> LHsExpr GhcRn - mk_fail_msg_expr dflags ctx pat + mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn + mk_fail_msg_expr dflags pat = nlHsLit $ mkHsString $ showPpr dflags $ - text "Pattern match failure in" <+> pprHsDoFlavour ctx + text "Pattern match failure in" <+> pprHsDoFlavour (DoExpr Nothing) <+> text "at" <+> ppr (getLocA pat) mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty {- Note [Desugaring Do with HsExpansion] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We expand do blocks before typeching it rather than after type checking it +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We expand do blocks before typechecking it rather than after type checking it using the +HsExpansion mechanism similar to HsIf expansions for rebindable syntax. + +Consider a do expression written in by the user + +f = {l0} do {l1} p <- {l1'}e1 + {l2} g p + {l3} return {l3'}p + +The {l1} etc are location/source span information stored in the AST, +{g1} are compiler generated source spans + +The expanded version (performed by expand_do_stmts) looks as follows: + +f = {g1} (>>=) ({l1'} e1) (\ p -> + {g2} (>>) ({l2} g p) + ({l3} return p) + ) + +The points to consider are: +1. Generate appropriate warnings for discarded results, eg. say g p :: m Int +2. Decorate an expression a fail block if the pattern match is irrefutable +3. Generating approprate type error messages that blame the correct source spans + TODO expand using examples -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fdaa4deec364fec555f4059db9ed66d9d088a30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fdaa4deec364fec555f4059db9ed66d9d088a30 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 24 22:47:39 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 24 May 2023 18:47:39 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 31 commits: testsuite: fix predicate on rdynamic test Message-ID: <646e940b5eeb0_64cfb4108da41960f9@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 43bc8d92 by Apoorv Ingle at 2023-05-24T17:46:56-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - baf6b242 by Apoorv Ingle at 2023-05-24T17:46:57-05:00 PopSrcSpan as a XXExprGhcRn - - - - - e0b9828a by Apoorv Ingle at 2023-05-24T17:46:57-05:00 add PopSrcSpan in appropriate places while desugaring - - - - - 5166d9d9 by Apoorv Ingle at 2023-05-24T17:46:57-05:00 add correct source spans for warnDiscardedDoBindings - - - - - 30 changed files: - .gitignore - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fdaa4deec364fec555f4059db9ed66d9d088a30...5166d9d905895b78f5b10204114fd32378ed2792 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fdaa4deec364fec555f4059db9ed66d9d088a30...5166d9d905895b78f5b10204114fd32378ed2792 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 00:58:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 20:58:50 -0400 Subject: [Git][ghc/ghc][master] Add Data.List.unsnoc Message-ID: <646eb2ca2c270_64cfb6388744208037@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - 7 changed files: - libraries/base/Data/List.hs - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/base/changelog.md - + testsuite/tests/lib/base/Unsnoc.hs - + testsuite/tests/lib/base/Unsnoc.stdout - testsuite/tests/lib/base/all.T Changes: ===================================== libraries/base/Data/List.hs ===================================== @@ -25,6 +25,7 @@ module Data.List , tail , init , uncons + , unsnoc , singleton , null , length ===================================== libraries/base/Data/OldList.hs ===================================== @@ -26,6 +26,7 @@ module Data.OldList , tail , init , uncons + , unsnoc , singleton , null , length ===================================== libraries/base/GHC/List.hs ===================================== @@ -31,7 +31,7 @@ module GHC.List ( -- Other functions foldl1', concat, concatMap, map, (++), filter, lookup, - head, last, tail, init, uncons, (!?), (!!), + head, last, tail, init, uncons, unsnoc, (!?), (!!), scanl, scanl1, scanl', scanr, scanr1, iterate, iterate', repeat, replicate, cycle, take, drop, splitAt, takeWhile, dropWhile, span, break, reverse, @@ -97,11 +97,11 @@ badHead = errorEmptyList "head" head (augment g xs) = g (\x _ -> x) (head xs) #-} --- | \(\mathcal{O}(1)\). Decompose a list into its head and tail. +-- | \(\mathcal{O}(1)\). Decompose a list into its 'head' and 'tail'. -- -- * If the list is empty, returns 'Nothing'. -- * If the list is non-empty, returns @'Just' (x, xs)@, --- where @x@ is the head of the list and @xs@ its tail. +-- where @x@ is the 'head' of the list and @xs@ its 'tail'. -- -- @since 4.8.0.0 -- @@ -115,6 +115,41 @@ uncons :: [a] -> Maybe (a, [a]) uncons [] = Nothing uncons (x:xs) = Just (x, xs) +-- | \(\mathcal{O}(n)\). Decompose a list into 'init' and 'last'. +-- +-- * If the list is empty, returns 'Nothing'. +-- * If the list is non-empty, returns @'Just' (xs, x)@, +-- where @xs@ is the 'init'ial part of the list and @x@ is its 'last' element. +-- +-- @since 4.19.0.0 +-- +-- >>> unsnoc [] +-- Nothing +-- >>> unsnoc [1] +-- Just ([],1) +-- >>> unsnoc [1, 2, 3] +-- Just ([1,2],3) +-- +-- Laziness: +-- +-- >>> fst <$> unsnoc [undefined] +-- Just [] +-- >>> head . fst <$> unsnoc (1 : undefined) +-- Just *** Exception: Prelude.undefined +-- >>> head . fst <$> unsnoc (1 : 2 : undefined) +-- Just 1 +-- +-- 'unsnoc' is dual to 'uncons': for a finite list @xs@ +-- +-- > unsnoc xs = (\(hd, tl) -> (reverse tl, hd)) <$> uncons (reverse xs) +-- +unsnoc :: [a] -> Maybe ([a], a) +-- The lazy pattern ~(a, b) is important to be productive on infinite lists +-- and not to be prone to stack overflows. +-- Expressing the recursion via 'foldr' provides for list fusion. +unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing +{-# INLINABLE unsnoc #-} + -- | \(\mathcal{O}(1)\). Extract the elements after the head of a list, which -- must be non-empty. -- @@ -143,8 +178,7 @@ tail [] = errorEmptyList "tail" -- >>> last [] -- *** Exception: Prelude.last: empty list -- --- WARNING: This function is partial. You can use 'reverse' with case-matching, --- 'uncons' or 'listToMaybe' instead. +-- WARNING: This function is partial. Consider using 'unsnoc' instead. last :: HasCallStack => [a] -> a #if defined(USE_REPORT_PRELUDE) last [x] = x @@ -172,8 +206,7 @@ lastError = errorEmptyList "last" -- >>> init [] -- *** Exception: Prelude.init: empty list -- --- WARNING: This function is partial. You can use 'reverse' with case-matching --- or 'uncons' instead. +-- WARNING: This function is partial. Consider using 'unsnoc' instead. init :: HasCallStack => [a] -> [a] #if defined(USE_REPORT_PRELUDE) init [x] = [] ===================================== libraries/base/changelog.md ===================================== @@ -16,6 +16,7 @@ * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) * Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) * Add `System.Mem.Weak.printToHandleFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to the given `Handle`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) + * Add `Data.List.unsnoc` ([CLC proposal #165](https://github.com/haskell/core-libraries-committee/issues/165)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. ===================================== testsuite/tests/lib/base/Unsnoc.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -Wno-x-partial #-} + +module Main (main) where + +import Data.List (unsnoc) + +main :: IO () +main = do + print $ unsnoc ([] :: [Int]) + print $ unsnoc [1] + print $ unsnoc [1, 2, 3] + print $ fst <$> unsnoc [undefined :: Int] + print $ head . fst <$> unsnoc (1 : 2 : undefined) + print $ head . fst <$> unsnoc [1..] ===================================== testsuite/tests/lib/base/Unsnoc.stdout ===================================== @@ -0,0 +1,6 @@ +Nothing +Just ([],1) +Just ([1,2],3) +Just [] +Just 1 +Just 1 ===================================== testsuite/tests/lib/base/all.T ===================================== @@ -8,3 +8,4 @@ test('executablePath', [extra_run_opts(config.os), js_broken(22261), when(arch(' test('T17472', normal, compile_and_run, ['']) test('T19569b', normal, compile_and_run, ['']) test('Monoid_ByteArray', normal, compile_and_run, ['']) +test('Unsnoc', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36d5944d13866e8c0d6634c38bb7a2f32fe98512 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36d5944d13866e8c0d6634c38bb7a2f32fe98512 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 00:59:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 20:59:32 -0400 Subject: [Git][ghc/ghc][master] Fix crash in backpack signature merging with -ddump-rn-trace Message-ID: <646eb2f4afa13_64cfb3f40c102131bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 4 changed files: - compiler/GHC/Rename/Env.hs - testsuite/driver/testlib.py - + testsuite/tests/backpack/should_compile/T23424.bkp - testsuite/tests/backpack/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -1742,7 +1742,8 @@ addUsedGRE warn_if_deprec gre DisableDeprecationWarnings -> return () ; unless (isLocalGRE gre) $ do { env <- getGblEnv - ; traceRn "addUsedGRE" (ppr gre) + -- Do not report the GREInfo (#23424) + ; traceRn "addUsedGRE" (ppr $ greName gre) ; updMutVar (tcg_used_gres env) (gre :) } } addUsedGREs :: [GlobalRdrElt] -> RnM () @@ -1752,7 +1753,9 @@ addUsedGREs :: [GlobalRdrElt] -> RnM () addUsedGREs gres | null imp_gres = return () | otherwise = do { env <- getGblEnv - ; traceRn "addUsedGREs" (ppr imp_gres) + -- Do not report the GREInfo (#23424) + ; traceRn "addUsedGREs" + (ppr $ map greName imp_gres) ; updMutVar (tcg_used_gres env) (imp_gres ++) } where imp_gres = filterOut isLocalGRE gres ===================================== testsuite/driver/testlib.py ===================================== @@ -2201,6 +2201,11 @@ async def compare_outputs(way: WayName, normaliser: OutputNormalizer, expected_file, actual_file, diff_file=None, whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options + if kind == 'stderr' and getTestOpts().ignore_stderr: + return True + if kind == 'stdout' and getTestOpts().ignore_stdout: + return True expected_path = in_srcdir(expected_file) actual_path = in_testdir(actual_file) ===================================== testsuite/tests/backpack/should_compile/T23424.bkp ===================================== @@ -0,0 +1,23 @@ +unit p where + signature A where + data T + x :: Bool + signature B where + import A + y :: T + z :: Bool +unit q where + dependency signature p[A=,B=] + signature A (x) where + signature B (z) where + module M(y) where + import A + import B + y = x && z +unit pimpl where + module A where + x = True + module B where + z = False +unit r where + dependency q[A=pimpl:A,B=pimpl:B] ===================================== testsuite/tests/backpack/should_compile/all.T ===================================== @@ -60,3 +60,4 @@ test('T13214', normal, backpack_compile, ['']) test('T13250', normal, backpack_compile, ['']) test('T13323', normal, backpack_compile, ['']) test('T20396', normal, backpack_compile, ['']) +test('T23424', [ignore_stdout, ignore_stderr], backpack_compile, ['-ddump-rn-trace -ddump-if-trace -ddump-tc-trace']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0f2f9e37e625208a521fa5b7289b5fe37f94258 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0f2f9e37e625208a521fa5b7289b5fe37f94258 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 01:30:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 24 May 2023 21:30:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Add Data.List.unsnoc Message-ID: <646eba2b2b2ec_64cfb4108da4214896@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 1b31742d by Krzysztof Gogolewski at 2023-05-24T21:30:11-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 77ce80f9 by Krzysztof Gogolewski at 2023-05-24T21:30:11-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 21 changed files: - compiler/GHC/Rename/Env.hs - libraries/base/Data/List.hs - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - libraries/base/changelog.md - testsuite/driver/testlib.py - + testsuite/tests/backpack/should_compile/T23424.bkp - testsuite/tests/backpack/should_compile/all.T - + testsuite/tests/ghci/should_run/T22958c.hs - + testsuite/tests/ghci/should_run/T22958c.stdout - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/lib/base/Unsnoc.hs - + testsuite/tests/lib/base/Unsnoc.stdout - testsuite/tests/lib/base/all.T - + testsuite/tests/typecheck/should_fail/T13981A.hs - + testsuite/tests/typecheck/should_fail/T13981A.hs-boot - + testsuite/tests/typecheck/should_fail/T13981A.stderr - + testsuite/tests/typecheck/should_fail/T13981B.hs - + testsuite/tests/typecheck/should_fail/T13981C.hs - + testsuite/tests/typecheck/should_fail/T13981F.hs - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -1742,7 +1742,8 @@ addUsedGRE warn_if_deprec gre DisableDeprecationWarnings -> return () ; unless (isLocalGRE gre) $ do { env <- getGblEnv - ; traceRn "addUsedGRE" (ppr gre) + -- Do not report the GREInfo (#23424) + ; traceRn "addUsedGRE" (ppr $ greName gre) ; updMutVar (tcg_used_gres env) (gre :) } } addUsedGREs :: [GlobalRdrElt] -> RnM () @@ -1752,7 +1753,9 @@ addUsedGREs :: [GlobalRdrElt] -> RnM () addUsedGREs gres | null imp_gres = return () | otherwise = do { env <- getGblEnv - ; traceRn "addUsedGREs" (ppr imp_gres) + -- Do not report the GREInfo (#23424) + ; traceRn "addUsedGREs" + (ppr $ map greName imp_gres) ; updMutVar (tcg_used_gres env) (imp_gres ++) } where imp_gres = filterOut isLocalGRE gres ===================================== libraries/base/Data/List.hs ===================================== @@ -25,6 +25,7 @@ module Data.List , tail , init , uncons + , unsnoc , singleton , null , length ===================================== libraries/base/Data/OldList.hs ===================================== @@ -26,6 +26,7 @@ module Data.OldList , tail , init , uncons + , unsnoc , singleton , null , length ===================================== libraries/base/GHC/List.hs ===================================== @@ -31,7 +31,7 @@ module GHC.List ( -- Other functions foldl1', concat, concatMap, map, (++), filter, lookup, - head, last, tail, init, uncons, (!?), (!!), + head, last, tail, init, uncons, unsnoc, (!?), (!!), scanl, scanl1, scanl', scanr, scanr1, iterate, iterate', repeat, replicate, cycle, take, drop, splitAt, takeWhile, dropWhile, span, break, reverse, @@ -97,11 +97,11 @@ badHead = errorEmptyList "head" head (augment g xs) = g (\x _ -> x) (head xs) #-} --- | \(\mathcal{O}(1)\). Decompose a list into its head and tail. +-- | \(\mathcal{O}(1)\). Decompose a list into its 'head' and 'tail'. -- -- * If the list is empty, returns 'Nothing'. -- * If the list is non-empty, returns @'Just' (x, xs)@, --- where @x@ is the head of the list and @xs@ its tail. +-- where @x@ is the 'head' of the list and @xs@ its 'tail'. -- -- @since 4.8.0.0 -- @@ -115,6 +115,41 @@ uncons :: [a] -> Maybe (a, [a]) uncons [] = Nothing uncons (x:xs) = Just (x, xs) +-- | \(\mathcal{O}(n)\). Decompose a list into 'init' and 'last'. +-- +-- * If the list is empty, returns 'Nothing'. +-- * If the list is non-empty, returns @'Just' (xs, x)@, +-- where @xs@ is the 'init'ial part of the list and @x@ is its 'last' element. +-- +-- @since 4.19.0.0 +-- +-- >>> unsnoc [] +-- Nothing +-- >>> unsnoc [1] +-- Just ([],1) +-- >>> unsnoc [1, 2, 3] +-- Just ([1,2],3) +-- +-- Laziness: +-- +-- >>> fst <$> unsnoc [undefined] +-- Just [] +-- >>> head . fst <$> unsnoc (1 : undefined) +-- Just *** Exception: Prelude.undefined +-- >>> head . fst <$> unsnoc (1 : 2 : undefined) +-- Just 1 +-- +-- 'unsnoc' is dual to 'uncons': for a finite list @xs@ +-- +-- > unsnoc xs = (\(hd, tl) -> (reverse tl, hd)) <$> uncons (reverse xs) +-- +unsnoc :: [a] -> Maybe ([a], a) +-- The lazy pattern ~(a, b) is important to be productive on infinite lists +-- and not to be prone to stack overflows. +-- Expressing the recursion via 'foldr' provides for list fusion. +unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing +{-# INLINABLE unsnoc #-} + -- | \(\mathcal{O}(1)\). Extract the elements after the head of a list, which -- must be non-empty. -- @@ -143,8 +178,7 @@ tail [] = errorEmptyList "tail" -- >>> last [] -- *** Exception: Prelude.last: empty list -- --- WARNING: This function is partial. You can use 'reverse' with case-matching, --- 'uncons' or 'listToMaybe' instead. +-- WARNING: This function is partial. Consider using 'unsnoc' instead. last :: HasCallStack => [a] -> a #if defined(USE_REPORT_PRELUDE) last [x] = x @@ -172,8 +206,7 @@ lastError = errorEmptyList "last" -- >>> init [] -- *** Exception: Prelude.init: empty list -- --- WARNING: This function is partial. You can use 'reverse' with case-matching --- or 'uncons' instead. +-- WARNING: This function is partial. Consider using 'unsnoc' instead. init :: HasCallStack => [a] -> [a] #if defined(USE_REPORT_PRELUDE) init [x] = [] ===================================== libraries/base/changelog.md ===================================== @@ -16,6 +16,7 @@ * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) * Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) * Add `System.Mem.Weak.printToHandleFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to the given `Handle`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) + * Add `Data.List.unsnoc` ([CLC proposal #165](https://github.com/haskell/core-libraries-committee/issues/165)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. ===================================== testsuite/driver/testlib.py ===================================== @@ -2201,6 +2201,11 @@ async def compare_outputs(way: WayName, normaliser: OutputNormalizer, expected_file, actual_file, diff_file=None, whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options + if kind == 'stderr' and getTestOpts().ignore_stderr: + return True + if kind == 'stdout' and getTestOpts().ignore_stdout: + return True expected_path = in_srcdir(expected_file) actual_path = in_testdir(actual_file) ===================================== testsuite/tests/backpack/should_compile/T23424.bkp ===================================== @@ -0,0 +1,23 @@ +unit p where + signature A where + data T + x :: Bool + signature B where + import A + y :: T + z :: Bool +unit q where + dependency signature p[A=,B=] + signature A (x) where + signature B (z) where + module M(y) where + import A + import B + y = x && z +unit pimpl where + module A where + x = True + module B where + z = False +unit r where + dependency q[A=pimpl:A,B=pimpl:B] ===================================== testsuite/tests/backpack/should_compile/all.T ===================================== @@ -60,3 +60,4 @@ test('T13214', normal, backpack_compile, ['']) test('T13250', normal, backpack_compile, ['']) test('T13323', normal, backpack_compile, ['']) test('T20396', normal, backpack_compile, ['']) +test('T23424', [ignore_stdout, ignore_stderr], backpack_compile, ['-ddump-rn-trace -ddump-if-trace -ddump-tc-trace']) \ No newline at end of file ===================================== testsuite/tests/ghci/should_run/T22958c.hs ===================================== @@ -0,0 +1,15 @@ +-- Test extracted from text-builder-linear, ticket #23355 +{-# LANGUAGE UnliftedDatatypes #-} +module Main (main) where + +import GHC.Exts (UnliftedType) + +type Buffer :: UnliftedType +data Buffer = Buffer + +main :: IO () +main = case i Buffer of Buffer -> putStrLn "good" + +{-# NOINLINE i #-} +i :: forall (a :: UnliftedType). a -> a +i x = x ===================================== testsuite/tests/ghci/should_run/T22958c.stdout ===================================== @@ -0,0 +1 @@ +good ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -90,3 +90,4 @@ test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], co test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script']) test('T22958a', just_ghci, compile_and_run, ['']) test('T22958b', just_ghci, compile_and_run, ['']) +test('T22958c', just_ghci, compile_and_run, ['']) ===================================== testsuite/tests/lib/base/Unsnoc.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -Wno-x-partial #-} + +module Main (main) where + +import Data.List (unsnoc) + +main :: IO () +main = do + print $ unsnoc ([] :: [Int]) + print $ unsnoc [1] + print $ unsnoc [1, 2, 3] + print $ fst <$> unsnoc [undefined :: Int] + print $ head . fst <$> unsnoc (1 : 2 : undefined) + print $ head . fst <$> unsnoc [1..] ===================================== testsuite/tests/lib/base/Unsnoc.stdout ===================================== @@ -0,0 +1,6 @@ +Nothing +Just ([],1) +Just ([1,2],3) +Just [] +Just 1 +Just 1 ===================================== testsuite/tests/lib/base/all.T ===================================== @@ -8,3 +8,4 @@ test('executablePath', [extra_run_opts(config.os), js_broken(22261), when(arch(' test('T17472', normal, compile_and_run, ['']) test('T19569b', normal, compile_and_run, ['']) test('Monoid_ByteArray', normal, compile_and_run, ['']) +test('Unsnoc', normal, compile_and_run, ['']) ===================================== testsuite/tests/typecheck/should_fail/T13981A.hs ===================================== @@ -0,0 +1,5 @@ +module T13981A where +import T13981B +import T13981C + +data T = T ===================================== testsuite/tests/typecheck/should_fail/T13981A.hs-boot ===================================== @@ -0,0 +1,2 @@ +module T13981A where +data T ===================================== testsuite/tests/typecheck/should_fail/T13981A.stderr ===================================== @@ -0,0 +1,5 @@ + +T13981A.hs:1:1: error: [GHC-34447] + Conflicting family instance declarations: + T13981F.F T13981A.T = Int -- Defined in module T13981B + T13981F.F T13981A.T = Bool -- Defined in module T13981C ===================================== testsuite/tests/typecheck/should_fail/T13981B.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T13981B where +import {-# SOURCE #-} T13981A +import T13981F +type instance F T = Int ===================================== testsuite/tests/typecheck/should_fail/T13981C.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T13981C where +import {-# SOURCE #-} T13981A +import T13981F +type instance F T = Bool ===================================== testsuite/tests/typecheck/should_fail/T13981F.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} +module T13981F where +import Data.Kind +type family F a :: Type ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -684,3 +684,4 @@ test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) test('CommonFieldTypeMismatch', normal, compile_fail, ['']) test('T17284', normal, compile_fail, ['']) test('T23427', normal, compile_fail, ['']) +test('T13981A', [extra_files(['T13981A.hs-boot', 'T13981B.hs', 'T13981C.hs', 'T13981F.hs'])], multimod_compile_fail, ['T13981A', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a588b8013f733fe91e1285f63cdb36e56284084e...77ce80f9a376ba8be779a2711151f5bfd2d6f9bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a588b8013f733fe91e1285f63cdb36e56284084e...77ce80f9a376ba8be779a2711151f5bfd2d6f9bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 02:01:51 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 24 May 2023 22:01:51 -0400 Subject: [Git][ghc/ghc][wip/expand-do] use mkExpandStmt to store original stmts along with expanded expr for using... Message-ID: <646ec18fda6ca_64cfb4108db82241db@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 0a3e438d by Apoorv Ingle at 2023-05-24T21:01:39-05:00 use mkExpandStmt to store original stmts along with expanded expr for using the right context for error message printing - - - - - 5 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Module.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -752,8 +752,10 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr x instance Outputable XXExprGhcRn where - ppr (ExpansionExprRn (HsExpanded (Left o) e)) = ppr (HsExpanded o e) - ppr (ExpansionExprRn (HsExpanded (Right o) e)) = ppr (HsExpanded o e) + ppr (ExpansionExprRn ex@(HsExpanded (Left o) e)) = ifPprDebug (text "ExpansionExprRn" <+> ppr ex) + (ppr (HsExpanded o e)) + ppr (ExpansionExprRn ex@(HsExpanded (Right o) e)) = ifPprDebug (text "ExpansionExprRn" <+> ppr ex) + (ppr (HsExpanded o e)) ppr (PopSrcSpan e) = ifPprDebug (text "PopSrcSpan" <+> ppr e) (ppr e) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -867,7 +867,7 @@ warnUnusedBindValue fun arg@(L loc _) arg_ty ]) putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty where - -- retrieve the location info and the head of the application + -- Retrieve the location info and the head of the application -- It is important that we /do not/ look through HsApp to avoid -- generating duplicate warnings fish_var :: LHsExpr GhcTc -> Maybe (SrcSpan , Id) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -4,6 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -206,7 +207,7 @@ tcExpr e@(OpApp {}) res_ty = tcApp e res_ty tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty -tcExpr e@(XExpr (ExpansionExprRn (HsExpanded {}))) res_ty = tcApp e res_ty +tcExpr e@(XExpr (ExpansionExprRn (HsExpanded (Left _) _))) res_ty = tcApp e res_ty tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty @@ -408,6 +409,11 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } +tcExpr (XExpr (ExpansionExprRn (HsExpanded (Right stmt) expr))) res_ty + = do { addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ + tcExpr expr res_ty + } + tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1192,38 +1192,36 @@ expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) expand_do_stmts ListComp _ = pprPanic "expand_do_stmts: impossible happened. ListComp" empty expand_do_stmts _ [] = pprPanic "expand_do_stmts: impossible happened. Empty stmts" empty -expand_do_stmts _ [L loc (LastStmt _ body _ ret_expr)] +expand_do_stmts _ [stmt@(L _ (LastStmt _ body _ ret_expr))] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` - -- TODO: i don't think we need this if we never call from a ListComp - -- ListComp <- do_flavour - -- = return $ noLocA (genHsApp (genHsVar returnMName) body) | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return body + = return (noLocA (mkExpandedStmt stmt (unLoc body))) | SyntaxExprRn ret <- ret_expr -- -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ L loc (genHsApp ret body) + = return $ noLocA (mkExpandedStmt stmt (genHsApp ret body)) expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = --- the pattern binding x can fail +-- the pattern binding pat can fail -- instead of making an internal name, the fail block is just an anonymous match block --- stmts ~~> stmt' expr = let / pat = stmts'; --- _ = fail "Pattern match failure .." +-- stmts ~~> stmt' f = / -> pat = stmts'; +-- _ = fail "Pattern match failure .." -- ------------------------------------------------------- --- pat <- e ; stmts ~~> (>>=) expr f +-- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ e - , genPopSrcSpanExpr expr - ] + return $ noLocA (mkExpandedStmt stmt + (unLoc $ mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ e + , genPopSrcSpanExpr expr + ])) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) @@ -1235,15 +1233,16 @@ expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (genPopSrcSpanExpr expand_stmts)) -expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ (mkHsApps (wrapGenSpan f) -- (>>) - [ e -- e - , genPopSrcSpanExpr expand_stmts ]) -- stmts' + return $ noLocA (mkExpandedStmt stmt + (unLoc $ mkHsApps (wrapGenSpan f) -- (>>) + [ e -- e + , genPopSrcSpanExpr expand_stmts ])) -- stmts' expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -694,7 +694,7 @@ tcRnHsBootDecls boot_or_sig decls , hs_defds = def_decls , hs_ruleds = rule_decls , hs_annds = _ - , hs_valds = (XValBindsLR (NValBinds val_binds val_sigs) :: HsValBinds GhcRn ) }) + , hs_valds = XValBindsLR (NValBinds val_binds val_sigs) }) <- rnTopSrcDecls first_group -- The empty list is for extra dependencies coming from .hs-boot files @@ -1620,7 +1620,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, -- and import the supporting declarations traceTc "Tc3" empty ; (tcg_env, inst_infos, th_bndrs, - (XValBindsLR (NValBinds deriv_binds deriv_sigs) :: HsValBinds GhcRn)) + XValBindsLR (NValBinds deriv_binds deriv_sigs)) <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ; updLclEnv (\tcl_env -> tcl_env { tcl_th_bndrs = th_bndrs `plusNameEnv` tcl_th_bndrs tcl_env }) $ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a3e438d44110d27740647f1a6b56c1b64227508 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a3e438d44110d27740647f1a6b56c1b64227508 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 06:03:53 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 25 May 2023 02:03:53 -0400 Subject: [Git][ghc/ghc][wip/expand-do] do not leak generated expressions in the error context, need to fix push and... Message-ID: <646efa496c95b_64cfb4108da4241018@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 03969860 by Apoorv Ingle at 2023-05-25T01:03:42-05:00 do not leak generated expressions in the error context, need to fix push and pop error contexts for ExpandedStmts - - - - - 6 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -454,11 +454,11 @@ type instance XXExpr GhcTc = XXExprGhcTc * * ********************************************************************* -} -type HsExprOrStmt a = Either (HsExpr a) (ExprLStmt a) - data XXExprGhcRn - = ExpansionExprRn - {-# UNPACK #-} !(HsExpansion (HsExprOrStmt GhcRn) (HsExpr GhcRn)) + = ExpandedExpr + {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcRn)) + | ExpandedStmt + {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (LHsExpr GhcRn)) | PopSrcSpan {-# UNPACK #-} !(LHsExpr GhcRn) -- Placeholder for identifying generated source locations in GhcRn phase @@ -480,13 +480,13 @@ mkExpandedExpr :: HsExpr GhcRn -- ^ source expression -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedExpr a b = XExpr (ExpansionExprRn (HsExpanded (Left a) b)) +mkExpandedExpr a b = XExpr (ExpandedExpr (HsExpanded a b)) mkExpandedStmt :: ExprLStmt GhcRn -- ^ source statement - -> HsExpr GhcRn -- ^ expanded expression + -> LHsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedStmt a b = XExpr (ExpansionExprRn (HsExpanded (Right a) b)) +mkExpandedStmt a b = XExpr (ExpandedStmt (HsExpanded a b)) data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions @@ -752,11 +752,11 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr x instance Outputable XXExprGhcRn where - ppr (ExpansionExprRn ex@(HsExpanded (Left o) e)) = ifPprDebug (text "ExpansionExprRn" <+> ppr ex) - (ppr (HsExpanded o e)) - ppr (ExpansionExprRn ex@(HsExpanded (Right o) e)) = ifPprDebug (text "ExpansionExprRn" <+> ppr ex) - (ppr (HsExpanded o e)) - ppr (PopSrcSpan e) = ifPprDebug (text "PopSrcSpan" <+> ppr e) + ppr (ExpandedExpr ex@(HsExpanded o e)) = ifPprDebug (text "[ExpandedExpr]" <+> ppr ex) + (ppr (HsExpanded o e)) + ppr (ExpandedStmt ex@(HsExpanded stmt e)) = ifPprDebug (text "[ExpandedStmt]" <+> ppr ex) + (ppr (HsExpanded stmt e)) + ppr (PopSrcSpan e) = ifPprDebug (text "PopSrcSpan" <+> parens (ppr e)) (ppr e) @@ -799,8 +799,8 @@ ppr_infix_expr (XExpr x) = case ghcPass @p of ppr_infix_expr _ = Nothing ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc -ppr_infix_expr_rn (ExpansionExprRn (HsExpanded (Left a) _)) = ppr_infix_expr a -ppr_infix_expr_rn (ExpansionExprRn _) = Nothing +ppr_infix_expr_rn (ExpandedExpr (HsExpanded a _)) = ppr_infix_expr a +ppr_infix_expr_rn (ExpandedStmt _) = Nothing ppr_infix_expr_rn (PopSrcSpan (L _ a)) = ppr_infix_expr a ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc @@ -911,8 +911,8 @@ hsExprNeedsParens prec = go go_x_tc (HsBinTick _ _ (L _ e)) = hsExprNeedsParens prec e go_x_rn :: XXExprGhcRn -> Bool - go_x_rn (ExpansionExprRn (HsExpanded (Left a) _)) = hsExprNeedsParens prec a - go_x_rn (ExpansionExprRn _) = False + go_x_rn (ExpandedExpr (HsExpanded a _)) = hsExprNeedsParens prec a + go_x_rn (ExpandedStmt _) = False go_x_rn (PopSrcSpan (L _ a)) = hsExprNeedsParens prec a @@ -956,8 +956,8 @@ isAtomicHsExpr (XExpr x) go_x_tc (HsBinTick {}) = False go_x_rn :: XXExprGhcRn -> Bool - go_x_rn (ExpansionExprRn (HsExpanded (Left a) _)) = isAtomicHsExpr a - go_x_rn (ExpansionExprRn (HsExpanded _ _)) = False + go_x_rn (ExpandedExpr (HsExpanded a _)) = isAtomicHsExpr a + go_x_rn (ExpandedStmt _) = False go_x_rn (PopSrcSpan (L _ a)) = isAtomicHsExpr a isAtomicHsExpr _ = False ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1654,14 +1654,13 @@ repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ (FieldLabelString f))))) = do e1 <- repLE e repGetField e1 f repE (HsProjection _ xs) = repProjection (fmap (field_label . unLoc . dfoLabel . unLoc) xs) -repE (XExpr (ExpansionExprRn (HsExpanded orig_expr_or_stmt ds_expr))) +repE (XExpr (ExpandedExpr (HsExpanded orig_expr ds_expr))) = do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax ; if rebindable_on -- See Note [Quotation and rebindable syntax] then repE ds_expr - else case orig_expr_or_stmt of - Left e -> repE e - Right st -> pprPanic "repE: unexpected do stmt" (ppr st)} + else repE orig_expr } repE (XExpr (PopSrcSpan (L _ e))) = repE e +repE e@(XExpr (ExpandedStmt _)) = notHandled (ThExpressionForm e) repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e) repE e@(HsTypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsUntypedBracket{}) = notHandled (ThExpressionForm e) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -207,7 +207,7 @@ tcExpr e@(OpApp {}) res_ty = tcApp e res_ty tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty -tcExpr e@(XExpr (ExpansionExprRn (HsExpanded (Left _) _))) res_ty = tcApp e res_ty +tcExpr e@(XExpr (ExpandedExpr {})) res_ty = tcApp e res_ty tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty @@ -409,9 +409,12 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr (XExpr (ExpansionExprRn (HsExpanded (Right stmt) expr))) res_ty - = do { addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - tcExpr expr res_ty +tcExpr (XExpr (PopSrcSpan expr)) res_ty = popErrCtxt $ tcExpr (unLoc expr) res_ty + +tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty + = do { traceTc "tcDoStmts stmt" (ppr expr) + ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ + tcExpr (unLoc expr) res_ty } tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty @@ -421,7 +424,7 @@ tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty ; traceTc "tcDoStmts doExpr" (vcat [ text "original:" <+> ppr expanded_do_expr , text "expanded:" <+> ppr expand_expr ]) - ; tcExpr expanded_do_expr res_ty + ; addErrCtxt (text "In the" <+> matchDoContextErrString doFlav) $ popErrCtxt $ tcExpr expanded_do_expr res_ty } tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty @@ -431,14 +434,12 @@ tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty ; traceTc "tcDoStmts mDoExpr" (vcat [ text "original:" <+> ppr expanded_do_expr , text "expanded:" <+> ppr expand_expr ]) - ; tcExpr expanded_do_expr res_ty + ; addErrCtxt (text "In the" <+> matchDoContextErrString doFlav) $ popErrCtxt $ tcExpr expanded_do_expr res_ty } tcExpr (HsDo _ do_or_lc stmts) res_ty = tcDoStmts do_or_lc stmts res_ty -tcExpr (XExpr (PopSrcSpan (L _ expr))) res_ty = popErrCtxt $ tcExpr expr res_ty - tcExpr (HsProc x pat cmd) res_ty = do { (pat', cmd', coi) <- tcProc pat cmd res_ty ; return $ mkHsWrapCo coi (HsProc x pat' cmd') } ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DisambiguateRecordFields #-} @@ -292,7 +293,7 @@ splitHsApps e = go e (top_ctxt 0 e) [] top_ctxt n (HsPragE _ _ fun) = top_lctxt n fun top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun top_ctxt n (HsApp _ fun _) = top_lctxt (n+1) fun - top_ctxt n (XExpr (ExpansionExprRn (HsExpanded (Left orig) _))) = VACall orig n noSrcSpan + top_ctxt n (XExpr (ExpandedExpr (HsExpanded orig _))) = VACall orig n noSrcSpan top_ctxt n other_fun = VACall other_fun n noSrcSpan top_lctxt n (L _ fun) = top_ctxt n fun @@ -306,7 +307,7 @@ splitHsApps e = go e (top_ctxt 0 e) [] go (HsApp _ (L l fun) arg) ctxt args = go fun (dec l ctxt) (mkEValArg ctxt arg : args) -- See Note [Looking through HsExpanded] - go (XExpr (ExpansionExprRn (HsExpanded (Left orig) fun))) ctxt args + go (XExpr (ExpandedExpr (HsExpanded orig fun))) ctxt args = go fun (VAExpansion orig (appCtxtLoc ctxt)) (EWrap (EExpand orig) : args) @@ -1464,6 +1465,8 @@ addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt e thing_inside = case e of HsUnboundVar {} -> thing_inside + XExpr (ExpandedStmt (HsExpanded stmt _)) -> + addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) thing_inside _ -> addErrCtxt (exprCtxt e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1192,18 +1192,18 @@ expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) expand_do_stmts ListComp _ = pprPanic "expand_do_stmts: impossible happened. ListComp" empty expand_do_stmts _ [] = pprPanic "expand_do_stmts: impossible happened. Empty stmts" empty -expand_do_stmts _ [stmt@(L _ (LastStmt _ body _ ret_expr))] +expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return (noLocA (mkExpandedStmt stmt (unLoc body))) + = return (noLocA (mkExpandedStmt stmt (genPopSrcSpanExpr body))) | SyntaxExprRn ret <- ret_expr -- -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ noLocA (mkExpandedStmt stmt (genHsApp ret body)) + = return $ genPopSrcSpanExpr (noLocA (mkExpandedStmt stmt (genPopSrcSpanExpr (L loc $ genHsApp ret body)))) expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) @@ -1218,19 +1218,22 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op return $ noLocA (mkExpandedStmt stmt - (unLoc $ mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ e + (mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ genPopSrcSpanExpr e , genPopSrcSpanExpr expr ])) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) -expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bnds)) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ wrapGenSpan (HsLet noExtField noHsTok bnds noHsTok (genPopSrcSpanExpr expand_stmts)) + return $ noLocA (mkExpandedStmt stmt + (wrapGenSpan (HsLet noExtField + noHsTok bnds + noHsTok (genPopSrcSpanExpr expand_stmts)))) expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = @@ -1240,8 +1243,8 @@ expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ noLocA (mkExpandedStmt stmt - (unLoc $ mkHsApps (wrapGenSpan f) -- (>>) - [ e -- e + (mkHsApps (wrapGenSpan f) -- (>>) + [ genPopSrcSpanExpr e -- e , genPopSrcSpanExpr expand_stmts ])) -- stmts' expand_do_stmts do_or_lc ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -726,8 +726,8 @@ exprCtOrigin (HsTypedSplice {}) = Shouldn'tHappenOrigin "TH typed splice" exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice" exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" -exprCtOrigin (XExpr (ExpansionExprRn (HsExpanded (Left a) _))) = exprCtOrigin a -exprCtOrigin (XExpr (ExpansionExprRn _)) = DoOrigin +exprCtOrigin (XExpr (ExpandedExpr (HsExpanded a _))) = exprCtOrigin a +exprCtOrigin (XExpr (ExpandedStmt _)) = DoOrigin exprCtOrigin (XExpr (PopSrcSpan (L _ a))) = exprCtOrigin a -- | Extract a suitable CtOrigin from a MatchGroup View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/039698605384eac48bf2a97c50509121d4bdc0e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/039698605384eac48bf2a97c50509121d4bdc0e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 07:30:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 May 2023 03:30:49 -0400 Subject: [Git][ghc/ghc][master] Add a regression test for #13981 Message-ID: <646f0ea9a9cc0_64cfb4108da42496e4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 7 changed files: - + testsuite/tests/typecheck/should_fail/T13981A.hs - + testsuite/tests/typecheck/should_fail/T13981A.hs-boot - + testsuite/tests/typecheck/should_fail/T13981A.stderr - + testsuite/tests/typecheck/should_fail/T13981B.hs - + testsuite/tests/typecheck/should_fail/T13981C.hs - + testsuite/tests/typecheck/should_fail/T13981F.hs - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== testsuite/tests/typecheck/should_fail/T13981A.hs ===================================== @@ -0,0 +1,5 @@ +module T13981A where +import T13981B +import T13981C + +data T = T ===================================== testsuite/tests/typecheck/should_fail/T13981A.hs-boot ===================================== @@ -0,0 +1,2 @@ +module T13981A where +data T ===================================== testsuite/tests/typecheck/should_fail/T13981A.stderr ===================================== @@ -0,0 +1,5 @@ + +T13981A.hs:1:1: error: [GHC-34447] + Conflicting family instance declarations: + T13981F.F T13981A.T = Int -- Defined in module T13981B + T13981F.F T13981A.T = Bool -- Defined in module T13981C ===================================== testsuite/tests/typecheck/should_fail/T13981B.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T13981B where +import {-# SOURCE #-} T13981A +import T13981F +type instance F T = Int ===================================== testsuite/tests/typecheck/should_fail/T13981C.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T13981C where +import {-# SOURCE #-} T13981A +import T13981F +type instance F T = Bool ===================================== testsuite/tests/typecheck/should_fail/T13981F.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} +module T13981F where +import Data.Kind +type family F a :: Type ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -684,3 +684,4 @@ test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) test('CommonFieldTypeMismatch', normal, compile_fail, ['']) test('T17284', normal, compile_fail, ['']) test('T23427', normal, compile_fail, ['']) +test('T13981A', [extra_files(['T13981A.hs-boot', 'T13981B.hs', 'T13981C.hs', 'T13981F.hs'])], multimod_compile_fail, ['T13981A', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a07d94a037876f61eb17dbf4401074a50509f3b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a07d94a037876f61eb17dbf4401074a50509f3b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 07:31:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 May 2023 03:31:20 -0400 Subject: [Git][ghc/ghc][master] Add a test for #23355 Message-ID: <646f0ec8b237c_64cfb102c6c5c25334a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 3 changed files: - + testsuite/tests/ghci/should_run/T22958c.hs - + testsuite/tests/ghci/should_run/T22958c.stdout - testsuite/tests/ghci/should_run/all.T Changes: ===================================== testsuite/tests/ghci/should_run/T22958c.hs ===================================== @@ -0,0 +1,15 @@ +-- Test extracted from text-builder-linear, ticket #23355 +{-# LANGUAGE UnliftedDatatypes #-} +module Main (main) where + +import GHC.Exts (UnliftedType) + +type Buffer :: UnliftedType +data Buffer = Buffer + +main :: IO () +main = case i Buffer of Buffer -> putStrLn "good" + +{-# NOINLINE i #-} +i :: forall (a :: UnliftedType). a -> a +i x = x ===================================== testsuite/tests/ghci/should_run/T22958c.stdout ===================================== @@ -0,0 +1 @@ +good ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -90,3 +90,4 @@ test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], co test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script']) test('T22958a', just_ghci, compile_and_run, ['']) test('T22958b', just_ghci, compile_and_run, ['']) +test('T22958c', just_ghci, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/182df90e4d1f652c3d078294921805b9b982671b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/182df90e4d1f652c3d078294921805b9b982671b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 07:50:59 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 25 May 2023 03:50:59 -0400 Subject: [Git][ghc/ghc][wip/unitidset] 14 commits: Migrate errors in GHC.Tc.Validity Message-ID: <646f136321c84_64cfbe0d46942535fd@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 34b0ff3a by Josh Meredith at 2023-05-25T07:49:54+00:00 Refactor `Set UnitId` to `UniqDSet UnitId` (#23335) - - - - - 5f28ca32 by Josh Meredith at 2023-05-25T07:49:54+00:00 Use UniqSet instead of UniqDSet in UnitIdSet - - - - - 30 changed files: - .gitignore - compiler/GHC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Types/Unique/Set.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2fb3231412552cca7a713a996f4a5076f18ed948...5f28ca327efb027666ee19b378aabac63e33ee43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2fb3231412552cca7a713a996f4a5076f18ed948...5f28ca327efb027666ee19b378aabac63e33ee43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 08:03:16 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 25 May 2023 04:03:16 -0400 Subject: [Git][ghc/ghc][wip/unitidset] Use UniqSet instead of UniqDSet in UnitIdSet Message-ID: <646f1644bfec4_64cfb15f7bee82576a@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: 51c916e8 by Josh Meredith at 2023-05-25T08:03:01+00:00 Use UniqSet instead of UniqDSet in UnitIdSet - - - - - 13 changed files: - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs Changes: ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre import GHC.Types.ForeignStubs import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import System.Directory import System.FilePath @@ -164,7 +164,7 @@ outputC :: Logger -> IO a outputC logger dflags filenm cmm_stream unit_deps = withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do - let pkg_names = map unitIdString (uniqDSetToAscList unit_deps) + let pkg_names = map unitIdString (uniqSetToAscList unit_deps) doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h "#include \"Stg.h\"\n" ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set -import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -256,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names -- (need to recompile if its export list changes: export_fprint) mkUsage :: Module -> ModIface -> Maybe Usage mkUsage mod iface - | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids + | not $ toUnitId (moduleUnit mod) `elementOfUniqSet` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Types.SourceFile import GHC.Types.SafeHaskell import GHC.Types.TypeEnv import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.SrcLoc import GHC.Types.TyThing import GHC.Types.PkgQual @@ -504,7 +505,7 @@ loadInterface doc_str mod from -- overlapping instances. ; massertPpr ((isOneShot (ghcMode (hsc_dflags hsc_env))) - || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env) + || not (moduleUnitId mod `elementOfUniqSet` hsc_all_home_unit_ids hsc_env) || mod == gHC_PRIM) (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -59,7 +59,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique.Set import GHC.Types.Fixity.Env import GHC.Types.Unique.Map -import GHC.Types.Unique.DSet import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.State @@ -618,8 +617,8 @@ checkDependencies hsc_env summary iface all_home_units = hsc_all_home_unit_ids hsc_env units = hsc_units hsc_env prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) + prev_dep_pkgs = uniqSetToAscList (unionUniqSets (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) @@ -634,7 +633,7 @@ checkDependencies hsc_env summary iface classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) + | (toUnitId $ moduleUnit mod) `elementOfUniqSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Unique.DFM import GHC.Utils.Outputable @@ -156,7 +157,7 @@ emptyLoaderState = LoaderState -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqDSet) + where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqSet) extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO () extendLoadedEnv interp new_bindings = @@ -222,12 +223,12 @@ loadDependencies interp hsc_env pls span needed_mods = do -- Link the packages and modules required pls1 <- loadPackages' interp hsc_env pkgs pls (pls2, succ) <- loadModuleLinkables interp hsc_env pls1 lnks - let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed + let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet $ mkUniqDSet $ nonDetEltsUniqSet trans_pkgs_needed all_pkgs_loaded = pkgs_loaded pls2 - trans_pkgs_needed = unionManyUniqDSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg - | pkg_id <- uniqDSetToList this_pkgs_needed - , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id] - ]) + trans_pkgs_needed = unionManyUniqSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg + | pkg_id <- uniqSetToAscList this_pkgs_needed + , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id] + ]) return (pls2, succ, all_lnks, this_pkgs_loaded) @@ -325,19 +326,19 @@ loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState loadCmdLineLibs' interp hsc_env pls = snd <$> foldM (\(done', pls') cur_uid -> load done' cur_uid pls') - (emptyUniqDSet, pls) - (uniqDSetToList $ hsc_all_home_unit_ids hsc_env) + (emptyUniqSet, pls) + (uniqSetToAscList $ hsc_all_home_unit_ids hsc_env) where load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState) - load done uid pls | uid `elementOfUniqDSet` done = return (done, pls) + load done uid pls | uid `elementOfUniqSet` done = return (done, pls) load done uid pls = do let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) (homeUnitDepends (hsc_units hsc')) pls'' <- loadCmdLineLibs'' interp hsc' pls' - return $ (addOneToUniqDSet done' uid, pls'') + return $ (addOneToUniqSet done' uid, pls'') loadCmdLineLibs'' :: Interp @@ -701,16 +702,16 @@ getLinkDeps hsc_env pls replace_osuf span mods -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests) if isOneShot (ghcMode dflags) then follow_deps (filterOut isInteractiveModule mods) - emptyUniqDSet emptyUniqDSet; + emptyUniqDSet emptyUniqSet; else do (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods - return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs)) + return (catMaybes mmods, unionManyUniqSets (init_pkg_set : pkgs)) ; let -- 2. Exclude ones already linked -- Main reason: avoid findModule calls in get_linkable (mods_needed, links_got) = partitionEithers (map split_mods mods_s) - pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls + pkgs_needed = eltsUDFM $ getUniqDSet (mkUniqDSet $ uniqSetToAscList pkgs_s) `minusUDFM` pkgs_loaded pls split_mods mod = let is_linked = findModuleLinkable_maybe (objs_loaded pls) mod <|> findModuleLinkable_maybe (bcos_loaded pls) mod @@ -751,10 +752,10 @@ getLinkDeps hsc_env pls replace_osuf span mods in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts) Nothing -> let (ModNodeKeyWithUid _ uid) = nk - in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts + in make_deps_loop (addOneToUniqSet found_units uid, found_mods) nexts mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) - (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) + (init_pkg_set, all_deps) = make_deps_loop (emptyUniqSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps] @@ -814,12 +815,12 @@ getLinkDeps hsc_env pls replace_osuf span mods acc_mods' = case hsc_home_unit_maybe hsc_env of Nothing -> acc_mods Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps) + acc_pkgs' = addListToUniqSet acc_pkgs (uniqSetToAscList pkg_deps) case hsc_home_unit_maybe hsc_env of Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) acc_mods' acc_pkgs' - _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg)) + _ -> follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' (toUnitId pkg)) where msg = text "need to link module" <+> ppr mod <+> text "due to use of Template Haskell" @@ -1372,10 +1373,10 @@ loadPackages' interp hsc_env new_pks pls = do ; pkgs' <- link pkgs deps -- Now link the package itself ; (hs_cls, extra_cls) <- loadPackage interp hsc_env pkg_cfg - ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg - | dep_pkg <- deps - , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) - ] + ; let trans_deps = unionManyUniqSets [ addOneToUniqSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg + | dep_pkg <- deps + , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) + ] ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls trans_deps)) } | otherwise ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -72,7 +72,7 @@ import GHC.Types.Id import GHC.Types.HpcInfo import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit import GHC.Unit.Module.Warnings @@ -211,8 +211,8 @@ rnImports imports = do let merged_import_avail = clobberSourceImports imp_avails dflags <- getDynFlags let final_import_avail = - merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags) - `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail} + merged_import_avail { imp_dep_direct_pkgs = mkUniqSet (implicitPackageDeps dflags) + `unionUniqSets` imp_dep_direct_pkgs merged_import_avail} return (decls, rdr_env, final_import_avail, hpc_usage) where @@ -534,7 +534,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by -- Trusted packages are a lot like orphans. trusted_pkgs | mod_safe' = dep_trusted_pkgs deps - | otherwise = emptyUniqDSet + | otherwise = emptyUniqSet pkg = moduleUnit (mi_module iface) @@ -547,11 +547,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by | isHomeUnit home_unit pkg = ptrust | otherwise = False - dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units - then emptyUniqDSet - else unitUniqDSet ipkg + dependent_pkgs = if toUnitId pkg `elementOfUniqSet` other_home_units + then emptyUniqSet + else unitUniqSet ipkg - direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units + direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqSet` other_home_units then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) else S.empty ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -143,7 +143,7 @@ import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv import GHC.Types.Unique.FM -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -2933,7 +2933,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports) , text "Dependent packages:" <+> - ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)] + ppr (uniqSetToAscList $ imp_dep_direct_pkgs imports)] -- The use of sort is just to reduce unnecessary -- wobbling in testsuite output ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -142,7 +142,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Types.Unique.FM -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Basic import GHC.Types.CostCentre.State import GHC.Types.HpcInfo @@ -1368,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_direct_dep_mods = emptyInstalledModuleEnv, - imp_dep_direct_pkgs = emptyUniqDSet, + imp_dep_direct_pkgs = emptyUniqSet, imp_sig_mods = [], - imp_trust_pkgs = emptyUniqDSet, + imp_trust_pkgs = emptyUniqSet, imp_trust_own_pkg = False, imp_boot_mods = emptyInstalledModuleEnv, imp_orphs = [], @@ -1399,8 +1399,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, - imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2, - imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2, + imp_dep_direct_pkgs = ddpkgs1 `unionUniqSets` ddpkgs2, + imp_trust_pkgs = tpkgs1 `unionUniqSets` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -44,6 +44,7 @@ module GHC.Types.Unique.Set ( nonDetEltsUniqSet, nonDetKeysUniqSet, nonDetStrictFoldUniqSet, + uniqSetToAscList, ) where import GHC.Prelude @@ -55,6 +56,8 @@ import Data.Coerce import GHC.Utils.Outputable import Data.Data import qualified Data.Semigroup as Semi +import Data.List (sort) +import GHC.Utils.Binary -- Note [UniqSet invariant] -- ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -159,6 +162,9 @@ lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k nonDetEltsUniqSet :: UniqSet elt -> [elt] nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet' +uniqSetToAscList :: Ord elt => UniqSet elt -> [elt] +uniqSetToAscList = sort . nonDetEltsUniqSet + -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. @@ -180,6 +186,10 @@ mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet instance Eq (UniqSet a) where UniqSet a == UniqSet b = equalKeysUFM a b +instance (Uniquable a, Ord a, Binary a) => Binary (UniqSet a) where + put_ bh = put_ bh . uniqSetToAscList + get bh = mkUniqSet <$> get bh + getUniqSet :: UniqSet a -> UniqFM a a getUniqSet = getUniqSet' ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -81,7 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -341,7 +341,7 @@ unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env unitEnv_keys :: UnitEnvGraph v -> UnitIdSet -unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) +unitEnv_keys env = mkUniqSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -30,7 +30,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -113,7 +113,7 @@ data Dependencies = Deps mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods - plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -201,11 +201,11 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps { dep_direct_mods = mempty - , dep_direct_pkgs = emptyUniqDSet - , dep_plugin_pkgs = emptyUniqDSet + , dep_direct_pkgs = emptyUniqSet + , dep_plugin_pkgs = emptyUniqSet , dep_sig_mods = [] , dep_boot_mods = mempty - , dep_trusted_pkgs = emptyUniqDSet + , dep_trusted_pkgs = emptyUniqSet , dep_orphs = [] , dep_finsts = [] } @@ -225,7 +225,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods text "boot module dependencies:" <+> ppr_set ppr bmods, text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, - if isEmptyUniqDSet tps + if isEmptyUniqSet tps then empty else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), @@ -239,7 +239,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set w = fsep . fmap w . Set.toAscList ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc - ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + ppr_unitIdSet w = fsep . fmap w . sort . uniqSetToAscList -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (uniqDSetToList override_set) $ \pkg -> + forM_ (uniqSetToAscList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1375,7 +1375,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 override_set :: UnitIdSet - override_set = mkUniqDSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map + override_set = mkUniqSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1687,7 +1687,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = uniqDSetToList home_unit_deps + , homeUnitDepends = uniqSetToAscList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,14 +1701,14 @@ mkUnitState logger cfg = do return (state, raw_dbs) selectHptFlag :: UnitIdSet -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = True selectHptFlag _ _ = False selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet -selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags +selectHomeUnits home_units flags = foldl' go emptyUniqSet flags where go :: UnitIdSet -> PackageFlag -> UnitIdSet - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = addOneToUniqSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Prelude import GHC.Types.Unique import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Utils.Binary import GHC.Utils.Outputable import GHC.Data.FastString @@ -540,7 +541,7 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId -type UnitIdSet = UniqDSet UnitId +type UnitIdSet = UniqSet UnitId unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51c916e8f96cd7b56c26be4d0064e5c06a8ae543 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51c916e8f96cd7b56c26be4d0064e5c06a8ae543 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 08:33:01 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 25 May 2023 04:33:01 -0400 Subject: [Git][ghc/ghc][wip/unitidset] Use UniqSet instead of UniqDSet in UnitIdSet Message-ID: <646f1d3d70b79_64cfb15ce3884259596@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: 0e59433f by Josh Meredith at 2023-05-25T08:32:45+00:00 Use UniqSet instead of UniqDSet in UnitIdSet - - - - - 17 changed files: - compiler/GHC.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -395,7 +395,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit import GHC.Unit.Env @@ -603,7 +603,7 @@ setSessionDynFlags dflags0 = do logger <- getLogger dflags <- checkNewDynFlags logger dflags0 let all_uids = hsc_all_home_unit_ids hsc_env - case uniqDSetToList all_uids of + case uniqSetToAscList all_uids of [uid] -> do setUnitDynFlagsNoCheck uid dflags modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags)) @@ -1379,7 +1379,7 @@ data ModuleInfo = ModuleInfo { -- | Request information about a loaded 'Module' getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X getModuleInfo mdl = withSession $ \hsc_env -> do - if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env + if moduleUnitId mdl `elementOfUniqSet` hsc_all_home_unit_ids hsc_env then liftIO $ getHomeModuleInfo hsc_env mdl else liftIO $ getPackageModuleInfo hsc_env mdl ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre import GHC.Types.ForeignStubs import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import System.Directory import System.FilePath @@ -164,7 +164,7 @@ outputC :: Logger -> IO a outputC logger dflags filenm cmm_stream unit_deps = withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do - let pkg_names = map unitIdString (uniqDSetToAscList unit_deps) + let pkg_names = map unitIdString (uniqSetToAscList unit_deps) doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h "#include \"Stg.h\"\n" ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -245,7 +245,7 @@ import GHC.Types.Name.Ppr import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.TyThing import GHC.Types.HpcInfo -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Utils.Fingerprint ( Fingerprint ) import GHC.Utils.Panic @@ -1457,15 +1457,15 @@ checkSafeImports tcg_env clearDiagnostics -- Check safe imports are correct - safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps + safePkgs <- mkUniqSet <$> mapMaybeM checkSafe safeImps safeErrs <- getDiagnostics clearDiagnostics -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] (infErrs, infPkgs) <- case (safeInferOn dflags) of - False -> return (emptyMessages, emptyUniqDSet) - True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps + False -> return (emptyMessages, emptyUniqSet) + True -> do infPkgs <- mkUniqSet <$> mapMaybeM checkSafe regImps infErrs <- getDiagnostics clearDiagnostics return (infErrs, infPkgs) @@ -1521,7 +1521,7 @@ checkSafeImports tcg_env pkgTrustReqs dflags req inf infPassed | safeInferOn dflags && not (safeHaskellModeEnabled dflags) && infPassed = emptyImportAvails { - imp_trust_pkgs = req `unionUniqDSets` inf + imp_trust_pkgs = req `unionUniqSets` inf } pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe = emptyImportAvails @@ -1545,7 +1545,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do (self, pkgs) <- hscCheckSafe' m l good <- isEmptyMessages `fmap` getDiagnostics clearDiagnostics -- don't want them printed... - let pkgs' | Just p <- self = addOneToUniqDSet pkgs p + let pkgs' | Just p <- self = addOneToUniqSet pkgs p | otherwise = pkgs return (good, pkgs') @@ -1651,7 +1651,7 @@ hscCheckSafe' m l = do checkPkgTrust :: UnitIdSet -> Hsc () checkPkgTrust pkgs = do hsc_env <- getHscEnv - let errors = foldr go emptyBag $ uniqDSetToList pkgs + let errors = foldr go emptyBag $ uniqSetToAscList pkgs state = hsc_units hsc_env go pkg acc | unitIsTrusted $ unsafeLookupUnitId state pkg @@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do False -> return tcg_env where - wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet } + wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqSet } pprMod = ppr $ moduleName $ tcg_mod tcg_env whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" @@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs in NoStubs `appendStubC` ip_init | otherwise = NoStubs (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) - <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet + <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqSet rawCmms return stub_c_exists where ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -107,7 +107,7 @@ import GHC.Types.SourceFile import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.Unique.Map -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.PkgQual import GHC.Unit @@ -491,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much mkBatchMsg :: HscEnv -> Messager mkBatchMsg hsc_env = - if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 + if sizeUniqSet (hsc_all_home_unit_ids hsc_env) > 1 -- This also displays what unit each module is from. then batchMultiMsg else batchMsg @@ -1745,16 +1745,16 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages] -- Fast path, trivially closed. checkHomeUnitsClosed ue home_id_set home_imp_ids - | sizeUniqDSet home_id_set == 1 = [] + | sizeUniqSet home_id_set == 1 = [] | otherwise = - let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids + let res = foldr (\ids acc -> unionUniqSets acc $ loop ids) emptyUniqSet home_imp_ids -- Now check whether everything which transitively depends on a home_unit is actually a home_unit -- These units are the ones which we need to load as home packages but failed to do for some reason, -- it's a bug in the tool invoking GHC. - bad_unit_ids = res `minusUniqDSet` home_id_set - in if isEmptyUniqDSet bad_unit_ids + bad_unit_ids = res `minusUniqSet` home_id_set + in if isEmptyUniqSet bad_unit_ids then [] - else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)] + else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqSetToAscList bad_unit_ids)] where rootLoc = mkGeneralSrcSpan (fsLit "") @@ -1768,21 +1768,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids Nothing -> pprPanic "uid not found" (ppr uid) Just ui -> let depends = unitDepends ui - home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set - other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set + home_depends = mkUniqSet depends `intersectUniqSets` home_id_set + other_depends = mkUniqSet depends `minusUniqSet` home_id_set in -- Case 1: The unit directly depends on a home_id - if not (isEmptyUniqDSet home_depends) + if not (isEmptyUniqSet home_depends) then let res :: UnitIdSet - res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends - in addOneToUniqDSet res uid + res = foldr (\ide acc -> acc `unionUniqSets` loop (from_uid, ide)) emptyUniqSet $ uniqSetToAscList other_depends + in addOneToUniqSet res uid -- Case 2: Check the rest of the dependencies, and then see if any of them depended on else - let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends + let res = foldr (\ide acc -> acc `unionUniqSets` loop (from_uid, ide)) emptyUniqSet $ uniqSetToAscList other_depends in - if not (isEmptyUniqDSet res) - then addOneToUniqDSet res uid + if not (isEmptyUniqSet res) + then addOneToUniqSet res uid else res -- | Update the every ModSummary that is depended on ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -108,7 +108,7 @@ import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceError -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit import GHC.Unit.Env @@ -410,8 +410,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt home_mod_infos = eltsHpt hpt -- the packages we depend on - pkg_deps = uniqDSetToList - $ unionManyUniqDSets + pkg_deps = uniqSetToAscList + $ unionManyUniqSets $ fmap (dep_direct_pkgs . mi_deps . hm_iface) $ home_mod_infos ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set -import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -256,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names -- (need to recompile if its export list changes: export_fprint) mkUsage :: Module -> ModIface -> Maybe Usage mkUsage mod iface - | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids + | not $ toUnitId (moduleUnit mod) `elementOfUniqSet` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Types.SourceFile import GHC.Types.SafeHaskell import GHC.Types.TypeEnv import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.SrcLoc import GHC.Types.TyThing import GHC.Types.PkgQual @@ -504,7 +505,7 @@ loadInterface doc_str mod from -- overlapping instances. ; massertPpr ((isOneShot (ghcMode (hsc_dflags hsc_env))) - || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env) + || not (moduleUnitId mod `elementOfUniqSet` hsc_all_home_unit_ids hsc_env) || mod == gHC_PRIM) (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -59,7 +59,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique.Set import GHC.Types.Fixity.Env import GHC.Types.Unique.Map -import GHC.Types.Unique.DSet import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.State @@ -618,8 +617,8 @@ checkDependencies hsc_env summary iface all_home_units = hsc_all_home_unit_ids hsc_env units = hsc_units hsc_env prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) + prev_dep_pkgs = uniqSetToAscList (unionUniqSets (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) @@ -634,7 +633,7 @@ checkDependencies hsc_env summary iface classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) + | (toUnitId $ moduleUnit mod) `elementOfUniqSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Unique.DFM import GHC.Utils.Outputable @@ -156,7 +157,7 @@ emptyLoaderState = LoaderState -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqDSet) + where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqSet) extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO () extendLoadedEnv interp new_bindings = @@ -222,12 +223,12 @@ loadDependencies interp hsc_env pls span needed_mods = do -- Link the packages and modules required pls1 <- loadPackages' interp hsc_env pkgs pls (pls2, succ) <- loadModuleLinkables interp hsc_env pls1 lnks - let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed + let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet $ mkUniqDSet $ nonDetEltsUniqSet trans_pkgs_needed all_pkgs_loaded = pkgs_loaded pls2 - trans_pkgs_needed = unionManyUniqDSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg - | pkg_id <- uniqDSetToList this_pkgs_needed - , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id] - ]) + trans_pkgs_needed = unionManyUniqSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg + | pkg_id <- uniqSetToAscList this_pkgs_needed + , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id] + ]) return (pls2, succ, all_lnks, this_pkgs_loaded) @@ -325,19 +326,19 @@ loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState loadCmdLineLibs' interp hsc_env pls = snd <$> foldM (\(done', pls') cur_uid -> load done' cur_uid pls') - (emptyUniqDSet, pls) - (uniqDSetToList $ hsc_all_home_unit_ids hsc_env) + (emptyUniqSet, pls) + (uniqSetToAscList $ hsc_all_home_unit_ids hsc_env) where load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState) - load done uid pls | uid `elementOfUniqDSet` done = return (done, pls) + load done uid pls | uid `elementOfUniqSet` done = return (done, pls) load done uid pls = do let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) (homeUnitDepends (hsc_units hsc')) pls'' <- loadCmdLineLibs'' interp hsc' pls' - return $ (addOneToUniqDSet done' uid, pls'') + return $ (addOneToUniqSet done' uid, pls'') loadCmdLineLibs'' :: Interp @@ -701,16 +702,16 @@ getLinkDeps hsc_env pls replace_osuf span mods -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests) if isOneShot (ghcMode dflags) then follow_deps (filterOut isInteractiveModule mods) - emptyUniqDSet emptyUniqDSet; + emptyUniqDSet emptyUniqSet; else do (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods - return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs)) + return (catMaybes mmods, unionManyUniqSets (init_pkg_set : pkgs)) ; let -- 2. Exclude ones already linked -- Main reason: avoid findModule calls in get_linkable (mods_needed, links_got) = partitionEithers (map split_mods mods_s) - pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls + pkgs_needed = eltsUDFM $ getUniqDSet (mkUniqDSet $ uniqSetToAscList pkgs_s) `minusUDFM` pkgs_loaded pls split_mods mod = let is_linked = findModuleLinkable_maybe (objs_loaded pls) mod <|> findModuleLinkable_maybe (bcos_loaded pls) mod @@ -751,10 +752,10 @@ getLinkDeps hsc_env pls replace_osuf span mods in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts) Nothing -> let (ModNodeKeyWithUid _ uid) = nk - in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts + in make_deps_loop (addOneToUniqSet found_units uid, found_mods) nexts mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) - (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) + (init_pkg_set, all_deps) = make_deps_loop (emptyUniqSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps] @@ -814,12 +815,12 @@ getLinkDeps hsc_env pls replace_osuf span mods acc_mods' = case hsc_home_unit_maybe hsc_env of Nothing -> acc_mods Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps) + acc_pkgs' = addListToUniqSet acc_pkgs (uniqSetToAscList pkg_deps) case hsc_home_unit_maybe hsc_env of Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) acc_mods' acc_pkgs' - _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg)) + _ -> follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' (toUnitId pkg)) where msg = text "need to link module" <+> ppr mod <+> text "due to use of Template Haskell" @@ -1372,10 +1373,10 @@ loadPackages' interp hsc_env new_pks pls = do ; pkgs' <- link pkgs deps -- Now link the package itself ; (hs_cls, extra_cls) <- loadPackage interp hsc_env pkg_cfg - ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg - | dep_pkg <- deps - , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) - ] + ; let trans_deps = unionManyUniqSets [ addOneToUniqSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg + | dep_pkg <- deps + , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) + ] ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls trans_deps)) } | otherwise ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -72,7 +72,7 @@ import GHC.Types.Id import GHC.Types.HpcInfo import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit import GHC.Unit.Module.Warnings @@ -211,8 +211,8 @@ rnImports imports = do let merged_import_avail = clobberSourceImports imp_avails dflags <- getDynFlags let final_import_avail = - merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags) - `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail} + merged_import_avail { imp_dep_direct_pkgs = mkUniqSet (implicitPackageDeps dflags) + `unionUniqSets` imp_dep_direct_pkgs merged_import_avail} return (decls, rdr_env, final_import_avail, hpc_usage) where @@ -534,7 +534,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by -- Trusted packages are a lot like orphans. trusted_pkgs | mod_safe' = dep_trusted_pkgs deps - | otherwise = emptyUniqDSet + | otherwise = emptyUniqSet pkg = moduleUnit (mi_module iface) @@ -547,11 +547,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by | isHomeUnit home_unit pkg = ptrust | otherwise = False - dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units - then emptyUniqDSet - else unitUniqDSet ipkg + dependent_pkgs = if toUnitId pkg `elementOfUniqSet` other_home_units + then emptyUniqSet + else unitUniqSet ipkg - direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units + direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqSet` other_home_units then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) else S.empty ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -143,7 +143,7 @@ import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv import GHC.Types.Unique.FM -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -2933,7 +2933,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports) , text "Dependent packages:" <+> - ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)] + ppr (uniqSetToAscList $ imp_dep_direct_pkgs imports)] -- The use of sort is just to reduce unnecessary -- wobbling in testsuite output ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -142,7 +142,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Types.Unique.FM -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Basic import GHC.Types.CostCentre.State import GHC.Types.HpcInfo @@ -1368,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_direct_dep_mods = emptyInstalledModuleEnv, - imp_dep_direct_pkgs = emptyUniqDSet, + imp_dep_direct_pkgs = emptyUniqSet, imp_sig_mods = [], - imp_trust_pkgs = emptyUniqDSet, + imp_trust_pkgs = emptyUniqSet, imp_trust_own_pkg = False, imp_boot_mods = emptyInstalledModuleEnv, imp_orphs = [], @@ -1399,8 +1399,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, - imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2, - imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2, + imp_dep_direct_pkgs = ddpkgs1 `unionUniqSets` ddpkgs2, + imp_trust_pkgs = tpkgs1 `unionUniqSets` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -44,6 +44,7 @@ module GHC.Types.Unique.Set ( nonDetEltsUniqSet, nonDetKeysUniqSet, nonDetStrictFoldUniqSet, + uniqSetToAscList, ) where import GHC.Prelude @@ -55,6 +56,8 @@ import Data.Coerce import GHC.Utils.Outputable import Data.Data import qualified Data.Semigroup as Semi +import Data.List (sort) +import GHC.Utils.Binary -- Note [UniqSet invariant] -- ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -159,6 +162,9 @@ lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k nonDetEltsUniqSet :: UniqSet elt -> [elt] nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet' +uniqSetToAscList :: Ord elt => UniqSet elt -> [elt] +uniqSetToAscList = sort . nonDetEltsUniqSet + -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. @@ -180,6 +186,10 @@ mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet instance Eq (UniqSet a) where UniqSet a == UniqSet b = equalKeysUFM a b +instance (Uniquable a, Ord a, Binary a) => Binary (UniqSet a) where + put_ bh = put_ bh . uniqSetToAscList + get bh = mkUniqSet <$> get bh + getUniqSet :: UniqSet a -> UniqFM a a getUniqSet = getUniqSet' ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -81,7 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -341,7 +341,7 @@ unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env unitEnv_keys :: UnitEnvGraph v -> UnitIdSet -unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) +unitEnv_keys env = mkUniqSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -30,7 +30,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -113,7 +113,7 @@ data Dependencies = Deps mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods - plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -201,11 +201,11 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps { dep_direct_mods = mempty - , dep_direct_pkgs = emptyUniqDSet - , dep_plugin_pkgs = emptyUniqDSet + , dep_direct_pkgs = emptyUniqSet + , dep_plugin_pkgs = emptyUniqSet , dep_sig_mods = [] , dep_boot_mods = mempty - , dep_trusted_pkgs = emptyUniqDSet + , dep_trusted_pkgs = emptyUniqSet , dep_orphs = [] , dep_finsts = [] } @@ -225,7 +225,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods text "boot module dependencies:" <+> ppr_set ppr bmods, text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, - if isEmptyUniqDSet tps + if isEmptyUniqSet tps then empty else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), @@ -239,7 +239,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set w = fsep . fmap w . Set.toAscList ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc - ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + ppr_unitIdSet w = fsep . fmap w . sort . uniqSetToAscList -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (uniqDSetToList override_set) $ \pkg -> + forM_ (uniqSetToAscList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1375,7 +1375,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 override_set :: UnitIdSet - override_set = mkUniqDSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map + override_set = mkUniqSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1687,7 +1687,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = uniqDSetToList home_unit_deps + , homeUnitDepends = uniqSetToAscList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,14 +1701,14 @@ mkUnitState logger cfg = do return (state, raw_dbs) selectHptFlag :: UnitIdSet -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = True selectHptFlag _ _ = False selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet -selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags +selectHomeUnits home_units flags = foldl' go emptyUniqSet flags where go :: UnitIdSet -> PackageFlag -> UnitIdSet - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = addOneToUniqSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Prelude import GHC.Types.Unique import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Utils.Binary import GHC.Utils.Outputable import GHC.Data.FastString @@ -540,7 +541,7 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId -type UnitIdSet = UniqDSet UnitId +type UnitIdSet = UniqSet UnitId unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e59433f8275177f4f6f795b67e1028fbd282055 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e59433f8275177f4f6f795b67e1028fbd282055 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 09:28:07 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 25 May 2023 05:28:07 -0400 Subject: [Git][ghc/ghc][wip/unitidset] Use UniqSet instead of UniqDSet in UnitIdSet Message-ID: <646f2a272f904_64cfb15ce38842627d4@gitlab.mail> Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC Commits: 61aa6421 by Josh Meredith at 2023-05-25T09:27:45+00:00 Use UniqSet instead of UniqDSet in UnitIdSet - - - - - 18 changed files: - compiler/GHC.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -395,7 +395,7 @@ import GHC.Types.Name.Ppr import GHC.Types.TypeEnv import GHC.Types.BreakInfo import GHC.Types.PkgQual -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit import GHC.Unit.Env @@ -603,7 +603,7 @@ setSessionDynFlags dflags0 = do logger <- getLogger dflags <- checkNewDynFlags logger dflags0 let all_uids = hsc_all_home_unit_ids hsc_env - case uniqDSetToList all_uids of + case uniqSetToAscList all_uids of [uid] -> do setUnitDynFlagsNoCheck uid dflags modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags)) @@ -1379,7 +1379,7 @@ data ModuleInfo = ModuleInfo { -- | Request information about a loaded 'Module' getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X getModuleInfo mdl = withSession $ \hsc_env -> do - if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env + if moduleUnitId mdl `elementOfUniqSet` hsc_all_home_unit_ids hsc_env then liftIO $ getHomeModuleInfo hsc_env mdl else liftIO $ getPackageModuleInfo hsc_env mdl ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre import GHC.Types.ForeignStubs import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import System.Directory import System.FilePath @@ -164,7 +164,7 @@ outputC :: Logger -> IO a outputC logger dflags filenm cmm_stream unit_deps = withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do - let pkg_names = map unitIdString (uniqDSetToAscList unit_deps) + let pkg_names = map unitIdString (uniqSetToAscList unit_deps) doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h "#include \"Stg.h\"\n" ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -245,7 +245,7 @@ import GHC.Types.Name.Ppr import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.TyThing import GHC.Types.HpcInfo -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Utils.Fingerprint ( Fingerprint ) import GHC.Utils.Panic @@ -1457,15 +1457,15 @@ checkSafeImports tcg_env clearDiagnostics -- Check safe imports are correct - safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps + safePkgs <- mkUniqSet <$> mapMaybeM checkSafe safeImps safeErrs <- getDiagnostics clearDiagnostics -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] (infErrs, infPkgs) <- case (safeInferOn dflags) of - False -> return (emptyMessages, emptyUniqDSet) - True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps + False -> return (emptyMessages, emptyUniqSet) + True -> do infPkgs <- mkUniqSet <$> mapMaybeM checkSafe regImps infErrs <- getDiagnostics clearDiagnostics return (infErrs, infPkgs) @@ -1521,7 +1521,7 @@ checkSafeImports tcg_env pkgTrustReqs dflags req inf infPassed | safeInferOn dflags && not (safeHaskellModeEnabled dflags) && infPassed = emptyImportAvails { - imp_trust_pkgs = req `unionUniqDSets` inf + imp_trust_pkgs = req `unionUniqSets` inf } pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe = emptyImportAvails @@ -1545,7 +1545,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do (self, pkgs) <- hscCheckSafe' m l good <- isEmptyMessages `fmap` getDiagnostics clearDiagnostics -- don't want them printed... - let pkgs' | Just p <- self = addOneToUniqDSet pkgs p + let pkgs' | Just p <- self = addOneToUniqSet pkgs p | otherwise = pkgs return (good, pkgs') @@ -1651,7 +1651,7 @@ hscCheckSafe' m l = do checkPkgTrust :: UnitIdSet -> Hsc () checkPkgTrust pkgs = do hsc_env <- getHscEnv - let errors = foldr go emptyBag $ uniqDSetToList pkgs + let errors = foldr go emptyBag $ uniqSetToAscList pkgs state = hsc_units hsc_env go pkg acc | unitIsTrusted $ unsafeLookupUnitId state pkg @@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do False -> return tcg_env where - wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet } + wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqSet } pprMod = ppr $ moduleName $ tcg_mod tcg_env whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" @@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs in NoStubs `appendStubC` ip_init | otherwise = NoStubs (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos) - <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet + <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqSet rawCmms return stub_c_exists where ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -107,7 +107,7 @@ import GHC.Types.SourceFile import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.Unique.Map -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.PkgQual import GHC.Unit @@ -491,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much mkBatchMsg :: HscEnv -> Messager mkBatchMsg hsc_env = - if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 + if sizeUniqSet (hsc_all_home_unit_ids hsc_env) > 1 -- This also displays what unit each module is from. then batchMultiMsg else batchMsg @@ -1745,16 +1745,16 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages] -- Fast path, trivially closed. checkHomeUnitsClosed ue home_id_set home_imp_ids - | sizeUniqDSet home_id_set == 1 = [] + | sizeUniqSet home_id_set == 1 = [] | otherwise = - let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids + let res = foldr (\ids acc -> unionUniqSets acc $ loop ids) emptyUniqSet home_imp_ids -- Now check whether everything which transitively depends on a home_unit is actually a home_unit -- These units are the ones which we need to load as home packages but failed to do for some reason, -- it's a bug in the tool invoking GHC. - bad_unit_ids = res `minusUniqDSet` home_id_set - in if isEmptyUniqDSet bad_unit_ids + bad_unit_ids = res `minusUniqSet` home_id_set + in if isEmptyUniqSet bad_unit_ids then [] - else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)] + else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqSetToAscList bad_unit_ids)] where rootLoc = mkGeneralSrcSpan (fsLit "") @@ -1768,21 +1768,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids Nothing -> pprPanic "uid not found" (ppr uid) Just ui -> let depends = unitDepends ui - home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set - other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set + home_depends = mkUniqSet depends `intersectUniqSets` home_id_set + other_depends = mkUniqSet depends `minusUniqSet` home_id_set in -- Case 1: The unit directly depends on a home_id - if not (isEmptyUniqDSet home_depends) + if not (isEmptyUniqSet home_depends) then let res :: UnitIdSet - res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends - in addOneToUniqDSet res uid + res = foldr (\ide acc -> acc `unionUniqSets` loop (from_uid, ide)) emptyUniqSet $ uniqSetToAscList other_depends + in addOneToUniqSet res uid -- Case 2: Check the rest of the dependencies, and then see if any of them depended on else - let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends + let res = foldr (\ide acc -> acc `unionUniqSets` loop (from_uid, ide)) emptyUniqSet $ uniqSetToAscList other_depends in - if not (isEmptyUniqDSet res) - then addOneToUniqDSet res uid + if not (isEmptyUniqSet res) + then addOneToUniqSet res uid else res -- | Update the every ModSummary that is depended on ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -108,7 +108,7 @@ import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile import GHC.Types.SourceError -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit import GHC.Unit.Env @@ -410,8 +410,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt home_mod_infos = eltsHpt hpt -- the packages we depend on - pkg_deps = uniqDSetToList - $ unionManyUniqDSets + pkg_deps = uniqSetToAscList + $ unionManyUniqSets $ fmap (dep_direct_pkgs . mi_deps . hm_iface) $ home_mod_infos ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set -import GHC.Types.Unique.DSet import GHC.Unit import GHC.Unit.Env @@ -256,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names -- (need to recompile if its export list changes: export_fprint) mkUsage :: Module -> ModIface -> Maybe Usage mkUsage mod iface - | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids + | not $ toUnitId (moduleUnit mod) `elementOfUniqSet` home_unit_ids = Just $ UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Types.SourceFile import GHC.Types.SafeHaskell import GHC.Types.TypeEnv import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.SrcLoc import GHC.Types.TyThing import GHC.Types.PkgQual @@ -504,7 +505,7 @@ loadInterface doc_str mod from -- overlapping instances. ; massertPpr ((isOneShot (ghcMode (hsc_dflags hsc_env))) - || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env) + || not (moduleUnitId mod `elementOfUniqSet` hsc_all_home_unit_ids hsc_env) || mod == gHC_PRIM) (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -59,7 +59,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique.Set import GHC.Types.Fixity.Env import GHC.Types.Unique.Map -import GHC.Types.Unique.DSet import GHC.Unit.External import GHC.Unit.Finder import GHC.Unit.State @@ -618,8 +617,8 @@ checkDependencies hsc_env summary iface all_home_units = hsc_all_home_unit_ids hsc_env units = hsc_units hsc_env prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) + prev_dep_pkgs = uniqSetToAscList (unionUniqSets (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) @@ -634,7 +633,7 @@ checkDependencies hsc_env summary iface classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) + | (toUnitId $ moduleUnit mod) `elementOfUniqSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Unique.DFM import GHC.Utils.Outputable @@ -156,7 +157,7 @@ emptyLoaderState = LoaderState -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqDSet) + where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqSet) extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO () extendLoadedEnv interp new_bindings = @@ -222,12 +223,12 @@ loadDependencies interp hsc_env pls span needed_mods = do -- Link the packages and modules required pls1 <- loadPackages' interp hsc_env pkgs pls (pls2, succ) <- loadModuleLinkables interp hsc_env pls1 lnks - let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed + let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet $ mkUniqDSet $ nonDetEltsUniqSet trans_pkgs_needed all_pkgs_loaded = pkgs_loaded pls2 - trans_pkgs_needed = unionManyUniqDSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg - | pkg_id <- uniqDSetToList this_pkgs_needed - , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id] - ]) + trans_pkgs_needed = unionManyUniqSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg + | pkg_id <- uniqSetToAscList this_pkgs_needed + , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id] + ]) return (pls2, succ, all_lnks, this_pkgs_loaded) @@ -325,19 +326,19 @@ loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState loadCmdLineLibs' interp hsc_env pls = snd <$> foldM (\(done', pls') cur_uid -> load done' cur_uid pls') - (emptyUniqDSet, pls) - (uniqDSetToList $ hsc_all_home_unit_ids hsc_env) + (emptyUniqSet, pls) + (uniqSetToAscList $ hsc_all_home_unit_ids hsc_env) where load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState) - load done uid pls | uid `elementOfUniqDSet` done = return (done, pls) + load done uid pls | uid `elementOfUniqSet` done = return (done, pls) load done uid pls = do let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) (homeUnitDepends (hsc_units hsc')) pls'' <- loadCmdLineLibs'' interp hsc' pls' - return $ (addOneToUniqDSet done' uid, pls'') + return $ (addOneToUniqSet done' uid, pls'') loadCmdLineLibs'' :: Interp @@ -701,16 +702,16 @@ getLinkDeps hsc_env pls replace_osuf span mods -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests) if isOneShot (ghcMode dflags) then follow_deps (filterOut isInteractiveModule mods) - emptyUniqDSet emptyUniqDSet; + emptyUniqDSet emptyUniqSet; else do (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods - return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs)) + return (catMaybes mmods, unionManyUniqSets (init_pkg_set : pkgs)) ; let -- 2. Exclude ones already linked -- Main reason: avoid findModule calls in get_linkable (mods_needed, links_got) = partitionEithers (map split_mods mods_s) - pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls + pkgs_needed = eltsUDFM $ getUniqDSet (mkUniqDSet $ uniqSetToAscList pkgs_s) `minusUDFM` pkgs_loaded pls split_mods mod = let is_linked = findModuleLinkable_maybe (objs_loaded pls) mod <|> findModuleLinkable_maybe (bcos_loaded pls) mod @@ -751,10 +752,10 @@ getLinkDeps hsc_env pls replace_osuf span mods in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts) Nothing -> let (ModNodeKeyWithUid _ uid) = nk - in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts + in make_deps_loop (addOneToUniqSet found_units uid, found_mods) nexts mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) - (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) + (init_pkg_set, all_deps) = make_deps_loop (emptyUniqSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps] @@ -814,12 +815,12 @@ getLinkDeps hsc_env pls replace_osuf span mods acc_mods' = case hsc_home_unit_maybe hsc_env of Nothing -> acc_mods Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps) + acc_pkgs' = addListToUniqSet acc_pkgs (uniqSetToAscList pkg_deps) case hsc_home_unit_maybe hsc_env of Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) acc_mods' acc_pkgs' - _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg)) + _ -> follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' (toUnitId pkg)) where msg = text "need to link module" <+> ppr mod <+> text "due to use of Template Haskell" @@ -1372,10 +1373,10 @@ loadPackages' interp hsc_env new_pks pls = do ; pkgs' <- link pkgs deps -- Now link the package itself ; (hs_cls, extra_cls) <- loadPackage interp hsc_env pkg_cfg - ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg - | dep_pkg <- deps - , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) - ] + ; let trans_deps = unionManyUniqSets [ addOneToUniqSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg + | dep_pkg <- deps + , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) + ] ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls trans_deps)) } | otherwise ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -72,7 +72,7 @@ import GHC.Types.Id import GHC.Types.HpcInfo import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..)) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit import GHC.Unit.Module.Warnings @@ -211,8 +211,8 @@ rnImports imports = do let merged_import_avail = clobberSourceImports imp_avails dflags <- getDynFlags let final_import_avail = - merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags) - `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail} + merged_import_avail { imp_dep_direct_pkgs = mkUniqSet (implicitPackageDeps dflags) + `unionUniqSets` imp_dep_direct_pkgs merged_import_avail} return (decls, rdr_env, final_import_avail, hpc_usage) where @@ -534,7 +534,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by -- Trusted packages are a lot like orphans. trusted_pkgs | mod_safe' = dep_trusted_pkgs deps - | otherwise = emptyUniqDSet + | otherwise = emptyUniqSet pkg = moduleUnit (mi_module iface) @@ -547,11 +547,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by | isHomeUnit home_unit pkg = ptrust | otherwise = False - dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units - then emptyUniqDSet - else unitUniqDSet ipkg + dependent_pkgs = if toUnitId pkg `elementOfUniqSet` other_home_units + then emptyUniqSet + else unitUniqSet ipkg - direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units + direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqSet` other_home_units then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) else S.empty ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -143,7 +143,7 @@ import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv import GHC.Types.Unique.FM -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -2933,7 +2933,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> (ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports) , text "Dependent packages:" <+> - ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)] + ppr (uniqSetToAscList $ imp_dep_direct_pkgs imports)] -- The use of sort is just to reduce unnecessary -- wobbling in testsuite output ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -142,7 +142,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Types.Unique.FM -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Types.Basic import GHC.Types.CostCentre.State import GHC.Types.HpcInfo @@ -1368,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_direct_dep_mods = emptyInstalledModuleEnv, - imp_dep_direct_pkgs = emptyUniqDSet, + imp_dep_direct_pkgs = emptyUniqSet, imp_sig_mods = [], - imp_trust_pkgs = emptyUniqDSet, + imp_trust_pkgs = emptyUniqSet, imp_trust_own_pkg = False, imp_boot_mods = emptyInstalledModuleEnv, imp_orphs = [], @@ -1399,8 +1399,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, - imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2, - imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2, + imp_dep_direct_pkgs = ddpkgs1 `unionUniqSets` ddpkgs2, + imp_trust_pkgs = tpkgs1 `unionUniqSets` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_boot_mods = srs1 `plusModDeps` srcs2, imp_sig_mods = unionListsOrd sig_mods1 sig_mods2, ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -44,6 +44,7 @@ module GHC.Types.Unique.Set ( nonDetEltsUniqSet, nonDetKeysUniqSet, nonDetStrictFoldUniqSet, + uniqSetToAscList, ) where import GHC.Prelude @@ -55,6 +56,8 @@ import Data.Coerce import GHC.Utils.Outputable import Data.Data import qualified Data.Semigroup as Semi +import Data.List (sort) +import GHC.Utils.Binary -- Note [UniqSet invariant] -- ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -159,6 +162,9 @@ lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k nonDetEltsUniqSet :: UniqSet elt -> [elt] nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet' +uniqSetToAscList :: Ord elt => UniqSet elt -> [elt] +uniqSetToAscList = sort . nonDetEltsUniqSet + -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. @@ -180,6 +186,10 @@ mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet instance Eq (UniqSet a) where UniqSet a == UniqSet b = equalKeysUFM a b +instance (Uniquable a, Ord a, Binary a) => Binary (UniqSet a) where + put_ bh = put_ bh . uniqSetToAscList + get bh = mkUniqSet <$> get bh + getUniqSet :: UniqSet a -> UniqFM a a getUniqSet = getUniqSet' ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -81,7 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -341,7 +341,7 @@ unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env unitEnv_keys :: UnitEnvGraph v -> UnitIdSet -unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) +unitEnv_keys env = mkUniqSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -30,7 +30,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -113,7 +113,7 @@ data Dependencies = Deps mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods - plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -201,11 +201,11 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps { dep_direct_mods = mempty - , dep_direct_pkgs = emptyUniqDSet - , dep_plugin_pkgs = emptyUniqDSet + , dep_direct_pkgs = emptyUniqSet + , dep_plugin_pkgs = emptyUniqSet , dep_sig_mods = [] , dep_boot_mods = mempty - , dep_trusted_pkgs = emptyUniqDSet + , dep_trusted_pkgs = emptyUniqSet , dep_orphs = [] , dep_finsts = [] } @@ -225,7 +225,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods text "boot module dependencies:" <+> ppr_set ppr bmods, text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, - if isEmptyUniqDSet tps + if isEmptyUniqSet tps then empty else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), @@ -239,7 +239,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set w = fsep . fmap w . Set.toAscList ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc - ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + ppr_unitIdSet w = fsep . fmap w . sort . uniqSetToAscList -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (uniqDSetToList override_set) $ \pkg -> + forM_ (uniqSetToAscList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1375,7 +1375,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 override_set :: UnitIdSet - override_set = mkUniqDSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map + override_set = mkUniqSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1687,7 +1687,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = uniqDSetToList home_unit_deps + , homeUnitDepends = uniqSetToAscList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,14 +1701,14 @@ mkUnitState logger cfg = do return (state, raw_dbs) selectHptFlag :: UnitIdSet -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = True selectHptFlag _ _ = False selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet -selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags +selectHomeUnits home_units flags = foldl' go emptyUniqSet flags where go :: UnitIdSet -> PackageFlag -> UnitIdSet - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = addOneToUniqSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Prelude import GHC.Types.Unique import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set import GHC.Utils.Binary import GHC.Utils.Outputable import GHC.Data.FastString @@ -540,7 +541,7 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId -type UnitIdSet = UniqDSet UnitId +type UnitIdSet = UniqSet UnitId unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS ===================================== ghc/GHCi/UI.hs ===================================== @@ -106,7 +106,7 @@ import GHC.Utils.Misc import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Bag (unitBag) import qualified GHC.Data.Strict as Strict -import GHC.Types.Unique.DSet +import GHC.Types.Unique.Set -- Haskell Libraries import System.Console.Haskeline as Haskeline @@ -562,7 +562,7 @@ interactiveUI config srcs maybe_exprs = do -- Set to True because Prelude is implicitly imported. impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}} hsc_env <- GHC.getSession - let in_multi = sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1 + let in_multi = sizeUniqSet (hsc_all_home_unit_ids hsc_env) > 1 empty_cache <- liftIO newIfaceCache startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, @@ -2569,15 +2569,15 @@ isSafeModule m = do -- print info to user... liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")" liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off") - when (not $ isEmptyUniqDSet good) + when (not $ isEmptyUniqSet good) (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++ - (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good))) - case msafe && isEmptyUniqDSet bad of + (intercalate ", " $ map (showPpr dflags) (uniqSetToAscList good))) + case msafe && isEmptyUniqSet bad of True -> liftIO $ putStrLn $ mname ++ " is trusted!" False -> do - when (not $ isEmptyUniqDSet bad) + when (not $ isEmptyUniqSet bad) (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): " - ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad))) + ++ (intercalate ", " $ map (showPpr dflags) (uniqSetToAscList bad))) liftIO $ putStrLn $ mname ++ " is NOT trusted!" where @@ -2587,8 +2587,8 @@ isSafeModule m = do | isHomeModule (hsc_home_unit hsc_env) md = True | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) - tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet) - | otherwise = partitionUniqDSet part deps + tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqSet, emptyUniqSet) + | otherwise = partitionUniqSet part deps where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61aa6421222c1d7212b3106bd9594df742b8d697 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61aa6421222c1d7212b3106bd9594df742b8d697 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 09:37:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 25 May 2023 05:37:53 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] The IdBinding of an Id and keeping it up to date Message-ID: <646f2c718a731_64cfb161563f826334c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: c0f8456e by Rodrigo Mesquita at 2023-05-25T10:37:04+01:00 The IdBinding of an Id and keeping it up to date Introduces two notes explaining the design of IdBindings and how they're kept up to date. See: - Note [The IdBinding of an Id] - Note [Keeping the IdBinding up to date] - - - - - 1 changed file: - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -287,6 +287,73 @@ data IdBinding where -- Removed globalbinding in exchange for LetBound with zero Ue (closed top-level let bound) -- Might no longer make sense to merge with IdScope at all +{- +Note [The IdBinding of an Id] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The IdBinding of an Id indicates the binding site of the Id (is it lambda, let, +or case bound?) together with the linearity information associated to the binder. + +For example, in + + module A where + + f :: a ⊸ b -> c + f x y = let z = (x,y) in + +- `f` is a (top-level) let bound Id, with a closed (empty) usage environment +(there are no linear free variables in the body of `f`) +- `x` is a lambda-bound Id with multiplicity `One` +- `y` is a lambda-bound Id with multiplicity `Many` +- `z` is a let-bound Id with usage environment `{x}`, since `x` is the only +linear variable free in the body of the let binder. + +As another example, in (TODO) + + module B where + + f :: Maybe a ⊸ Maybe b -> (a, b) + f x y = case x of z + Nothing -> ... + Just x' -> -- x' is as if it were lambda bound, I'm not sure if we ought to call it something else. + +In the first iteration of IdBindings, let binders will always have an empty +usage environment, for in this first pass we don't do anything regarding +linearity, but simply add a provenence (let-bound vs lambda-bound) to all Ids. + +Ids can only be case-bound in the Core representation, since there are no case +binders before it. + +See Note [Keeping the IdBinding up to date] for details on how it is kept in +face of the transformations a Haskell program undergoes. + +Note [Keeping the IdBinding up to date] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +How is the IdBinding of an Id kept up to in face of desugaring and the multiple +transformations a Core program undergoes? + +Indeed, multiple transformations will move a lambda-bound Id into a let-bound +position, or vice-versa. In these situations we must update its IdBinding, or +otherwise risk it becoming incorrect very fast. + +It is likely that most of these occurrences will have a pointer to this note. +Nonetheless, consider as an example tidying a variable pattern (in 'tidy1'): + + case v of { x -> mr[] } + ==> + case v of { _ -> let x=v in mr[] } + +When tidying a variable binder, we turn it into a wildcard pattern and let-bind +the variable in the alternative body. In this situation, we have moved an +lambda-bound Id into a let-bound position, so we must update the IdBinding. + +But how do we make sure the IdBindings are correct? + +Luckily, as with most important things in Core, in the Core Linter we can +continuously validate the IdBinding is correct wrt to the place where it is +currently bound. Specifically, in `lintIdBndr` we lint that the `IdBinding` +matches with the current `BindingSite`! +-} + pprIdWithBinding :: Id -> SDoc pprIdWithBinding x | isId x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0f8456ebc7e7582d6a79e3d242dd41d64be06c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0f8456ebc7e7582d6a79e3d242dd41d64be06c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 11:16:25 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 25 May 2023 07:16:25 -0400 Subject: [Git][ghc/ghc][ghc-9.2] 14 commits: rts/m32: Fix bounds check Message-ID: <646f43892d19e_64cfb1647ce742921d1@gitlab.mail> Zubin pushed to branch ghc-9.2 at Glasgow Haskell Compiler / GHC Commits: 22714407 by Ben Gamari at 2023-05-15T17:43:26+02:00 rts/m32: Fix bounds check Previously we would check only that the *start* of the mapping was in the bottom 32-bits of address space. However, we need the *entire* mapping to be in low memory. Fix this. Noticed by @Phyx. (cherry picked from commit 72c1812feecd2aff2a96b629063ba90a2f4cdb7b) - - - - - 12989f38 by Ben Gamari at 2023-05-15T17:43:27+02:00 rts/m32: Accept any address within 4GB of program text Previously m32 would assume that the program image was located near the start of the address space and therefore assume that it wanted pages in the bottom 4GB of address space. Instead we now check whether they are within 4GB of whereever the program is loaded. This is necessary on Windows, which now tends to place the image in high memory. The eventual goal is to use m32 to allocate memory for linker sections on Windows. (cherry picked from commit 2e9248b7f7f645851ceb49931d10b9c5e58d2bbb) - - - - - b15da5a9 by GHC GitLab CI at 2023-05-15T17:43:27+02:00 rts: Generalize mmapForLinkerMarkExecutable Renamed to mprotectForLinker and allowed setting of arbitrary protection modes. (cherry picked from commit 86589b893c092ae900723e76848525f20f6cafbf) - - - - - aa3e6822 by GHC GitLab CI at 2023-05-15T17:43:27+02:00 rts/m32: Add consistency-checking infrastructure This adds logic, enabled in the `-debug` RTS for checking the internal consistency of the m32 allocator. This area has always made me a bit nervous so this should help me sleep better at night in exchange for very little overhead. (cherry picked from commit 88ef270aa0cecf2463396f93a273656de9df9433) - - - - - 4671c818 by Ben Gamari at 2023-05-15T17:43:27+02:00 rts/m32: Free large objects back to the free page pool Not entirely convinced that this is worth doing. (cherry picked from commit 2d6f0b17e3ce9326abd43e187910db0a5e519efa) - - - - - 13e7ebd8 by GHC GitLab CI at 2023-05-15T17:43:27+02:00 rts/m32: Increase size of free page pool to 256 pages (cherry picked from commit e96f50beec172f5ff95769842cb9be724363311c) - - - - - 5c31cd4c by Ben Gamari at 2023-05-15T18:08:50+02:00 rts: Dump memory map on memory mapping failures Fixes #20992. (cherry picked from commit fc083b480adedf26d47f880402f111680ec34183) - - - - - 268fbed3 by Ben Gamari at 2023-05-15T18:08:50+02:00 rts/m32: Fix assertion failure This fixes an assertion failure in the m32 allocator due to the imprecisely specified preconditions of `m32_allocator_push_filled_list`. Specifically, the caller must ensure that the page type is set to filled prior to calling `m32_allocator_push_filled_list`. While this issue did result in an assertion failure in the debug RTS, the issue is in fact benign. (cherry picked from commit 37825ce283b6dbcb532f51fade090a69afc2d078) - - - - - c8733945 by Ben Gamari at 2023-05-16T11:02:29+02:00 rts: Rename MemoryMap.[ch] -> ReportMemoryMap.[ch] (cherry picked from commit 3df06922f03191310ebee0547de1782eeb6bda67) - - - - - 49e546b7 by Ben Gamari at 2023-05-16T11:10:23+02:00 rts: Move mmapForLinker and friends to linker/MMap.c They are not particularly related to linking. (cherry picked from commit e219ac826b05db833531028e0663f62f12eff010) - - - - - 6deb4d0d by Ben Gamari at 2023-05-16T11:10:38+02:00 rts/linker/MMap: Use MemoryAccess in mmapForLinker (cherry picked from commit 4d3a306dce59649b303ac7aba56758aff3dee077) - - - - - 7bdb5766 by Ben Gamari at 2023-05-16T11:11:08+02:00 rts/linker: Catch archives masquerading as object files Check the file's header to catch static archive bearing the `.o` extension, as may happen on Windows after the Clang refactoring. See #21068 - - - - - 69c02cbf by Ben Gamari at 2023-05-16T11:12:43+02:00 linker: Don't use MAP_FIXED As noted in #21057, we really shouldn't be using MAP_FIXED. I would much rather have the process crash with a "failed to map" error than randomly overwrite existing mappings. Closes #21057. (cherry picked from commit 1db4f1fe7603c338ead0ac7e1ecfd0d8354d37bf) - - - - - b361bcb0 by Zubin Duggal at 2023-05-24T19:31:59+05:30 Prepare release 9.2.8 Allow metric changes for 9.2.8 as baseline is from a release pipeline Metric Decrease: haddock.base haddock.Cabal haddock.compiler Metric Increase: ManyAlternatives ManyConstructors T10421 T10858 T12227 T12425 T12707 T13035 T13253 T13719 T15164 T16577 T18304 T18698a T18698b T3294 T5321FD T5642 T9203 T9233 T9630 T9872a T9872b T9872c T9872d T14697 T12545 T1969 parsing001 - - - - - 17 changed files: - configure.ac - + docs/users_guide/9.2.8-notes.rst - docs/users_guide/release-notes.rst - rts/ExecPage.c - rts/Linker.c - rts/LinkerInternals.h - + rts/ReportMemoryMap.c - + rts/ReportMemoryMap.h - rts/linker/Elf.c - rts/linker/LoadArchive.c - rts/linker/M32Alloc.c - + rts/linker/MMap.c - + rts/linker/MMap.h - rts/linker/MachO.c - rts/linker/SymbolExtras.c - rts/linker/elf_got.c - rts/rts.cabal.in Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.7], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.8], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058) ===================================== docs/users_guide/9.2.8-notes.rst ===================================== @@ -0,0 +1,62 @@ +.. _release-9-2-8: + +Version 9.2.8 +============== + +The significant changes to the various parts of the compiler are listed in the +following sections. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +9, 10, 11, or 12. + +Runtime system +-------------- + +- Fix a bug with RTS linker failing with 'internal error: m32_allocator_init: + Failed to map' on newer Linux kernels (:ghc-ticket:`19421`). + +Included libraries +------------------ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/libiserv/libiserv.cabal: Internal compiler library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable + + ===================================== docs/users_guide/release-notes.rst ===================================== @@ -11,3 +11,4 @@ Release notes 9.2.5-notes 9.2.6-notes 9.2.7-notes + 9.2.8-notes ===================================== rts/ExecPage.c ===================================== @@ -6,8 +6,8 @@ */ #include "Rts.h" -#include "LinkerInternals.h" #include "sm/OSMem.h" +#include "linker/MMap.h" ExecPage *allocateExecPage() { ExecPage *page = (ExecPage *) mmapAnonForLinker(getPageSize()); @@ -15,7 +15,7 @@ ExecPage *allocateExecPage() { } void freezeExecPage(ExecPage *page) { - mmapForLinkerMarkExecutable(page, getPageSize()); + mprotectForLinker(page, getPageSize(), MEM_READ_EXECUTE); flushExec(getPageSize(), page); } ===================================== rts/Linker.c ===================================== @@ -31,8 +31,10 @@ #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" #include "linker/SymbolExtras.h" +#include "linker/MMap.h" #include "PathUtils.h" #include "CheckUnload.h" // createOCSectionIndices +#include "ReportMemoryMap.h" #if !defined(mingw32_HOST_OS) #include "posix/Signals.h" @@ -198,63 +200,6 @@ Mutex linker_mutex; /* Generic wrapper function to try and Resolve and RunInit oc files */ int ocTryLoad( ObjectCode* oc ); -/* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the - * small memory model on this architecture (see gcc docs, - * -mcmodel=small). - * - * MAP_32BIT not available on OpenBSD/amd64 - */ -#if defined(MAP_32BIT) && (defined(x86_64_HOST_ARCH) || (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))) -#define MAP_LOW_MEM -#define TRY_MAP_32BIT MAP_32BIT -#else -#define TRY_MAP_32BIT 0 -#endif - -#if defined(aarch64_HOST_ARCH) -// On AArch64 MAP_32BIT is not available but we are still bound by the small -// memory model. Consequently we still try using the MAP_LOW_MEM allocation -// strategy. -#define MAP_LOW_MEM -#endif - -/* - * Note [MAP_LOW_MEM] - * ~~~~~~~~~~~~~~~~~~ - * Due to the small memory model (see above), on x86_64 and AArch64 we have to - * map all our non-PIC object files into the low 2Gb of the address space (why - * 2Gb and not 4Gb? Because all addresses must be reachable using a 32-bit - * signed PC-relative offset). On x86_64 Linux we can do this using the - * MAP_32BIT flag to mmap(), however on other OSs (e.g. *BSD, see #2063, and - * also on Linux inside Xen, see #2512), we can't do this. So on these - * systems, we have to pick a base address in the low 2Gb of the address space - * and try to allocate memory from there. - * - * The same holds for aarch64, where the default, even with PIC, model - * is 4GB. The linker is free to emit AARCH64_ADR_PREL_PG_HI21 - * relocations. - * - * We pick a default address based on the OS, but also make this - * configurable via an RTS flag (+RTS -xm) - */ - -#if (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)) -// Try to use stg_upd_frame_info as the base. We need to be within +-4GB of that -// address, otherwise we violate the aarch64 memory model. Any object we load -// can potentially reference any of the ones we bake into the binary (and list) -// in RtsSymbols. Thus we'll need to be within +-4GB of those, -// stg_upd_frame_info is a good candidate as it's referenced often. -#define MMAP_32BIT_BASE_DEFAULT (void*)&stg_upd_frame_info; -#elif defined(MAP_32BIT) || DEFAULT_LINKER_ALWAYS_PIC -// Try to use MAP_32BIT -#define MMAP_32BIT_BASE_DEFAULT 0 -#else -// A guess: 1Gb. -#define MMAP_32BIT_BASE_DEFAULT 0x40000000 -#endif - -static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT; - static void ghciRemoveSymbolTable(StrHashTable *table, const SymbolName* key, ObjectCode *owner) { @@ -1103,217 +1048,6 @@ resolveSymbolAddr (pathchar* buffer, int size, #endif /* OBJFORMAT_PEi386 */ } -#if defined(mingw32_HOST_OS) - -// -// Returns NULL on failure. -// -void * -mmapAnonForLinker (size_t bytes) -{ - return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE); -} - -void -munmapForLinker (void *addr, size_t bytes, const char *caller) -{ - if (VirtualFree(addr, 0, MEM_RELEASE) == 0) { - sysErrorBelch("munmapForLinker: %s: Failed to unmap %zd bytes at %p", - caller, bytes, addr); - } -} - -void -mmapForLinkerMarkExecutable(void *start, size_t len) -{ - DWORD old; - if (len == 0) { - return; - } - if (VirtualProtect(start, len, PAGE_EXECUTE_READ, &old) == 0) { - sysErrorBelch("mmapForLinkerMarkExecutable: failed to protect %zd bytes at %p", - len, start); - ASSERT(false); - } -} - -#elif RTS_LINKER_USE_MMAP -// -// Returns NULL on failure. -// -void * -mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset) -{ - void *map_addr = NULL; - void *result; - size_t size; - uint32_t tryMap32Bit = RtsFlags.MiscFlags.linkerAlwaysPic - ? 0 - : TRY_MAP_32BIT; - static uint32_t fixed = 0; - - IF_DEBUG(linker, debugBelch("mmapForLinker: start\n")); - size = roundUpToPage(bytes); - -#if defined(MAP_LOW_MEM) -mmap_again: -#endif - - if (mmap_32bit_base != NULL) { - map_addr = mmap_32bit_base; - } - - IF_DEBUG(linker, - debugBelch("mmapForLinker: \tprotection %#0x\n", prot)); - IF_DEBUG(linker, - debugBelch("mmapForLinker: \tflags %#0x\n", - MAP_PRIVATE | tryMap32Bit | fixed | flags)); - IF_DEBUG(linker, - debugBelch("mmapForLinker: \tsize %#0zx\n", bytes)); - IF_DEBUG(linker, - debugBelch("mmapForLinker: \tmap_addr %p\n", map_addr)); - - result = mmap(map_addr, size, prot, - MAP_PRIVATE|tryMap32Bit|fixed|flags, fd, offset); - - if (result == MAP_FAILED) { - sysErrorBelch("mmap %" FMT_Word " bytes at %p",(W_)size,map_addr); - errorBelch("Try specifying an address with +RTS -xm -RTS"); - return NULL; - } - -#if defined(MAP_LOW_MEM) - if (RtsFlags.MiscFlags.linkerAlwaysPic) { - /* make no attempt at mapping low memory if we are assuming PIC */ - } else if (mmap_32bit_base != NULL) { - if (result != map_addr) { - if ((W_)result > 0x80000000) { - // oops, we were given memory over 2Gb - munmap(result,size); -#if defined(freebsd_HOST_OS) || \ - defined(kfreebsdgnu_HOST_OS) || \ - defined(dragonfly_HOST_OS) - // Some platforms require MAP_FIXED. This is normally - // a bad idea, because MAP_FIXED will overwrite - // existing mappings. - fixed = MAP_FIXED; - goto mmap_again; -#else - errorBelch("mmapForLinker: failed to mmap() memory below 2Gb; " - "asked for %lu bytes at %p. " - "Try specifying an address with +RTS -xm -RTS", - size, map_addr); - return NULL; -#endif - } else { - // hmm, we were given memory somewhere else, but it's - // still under 2Gb so we can use it. - } - } - } else { - if ((W_)result > 0x80000000) { - // oops, we were given memory over 2Gb - // ... try allocating memory somewhere else?; - debugTrace(DEBUG_linker, - "MAP_32BIT didn't work; gave us %lu bytes at 0x%p", - bytes, result); - munmap(result, size); - - // Set a base address and try again... (guess: 1Gb) - mmap_32bit_base = (void*)0x40000000; - goto mmap_again; - } - } -#elif (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)) - // for aarch64 we need to make sure we stay within 4GB of the - // mmap_32bit_base, and we also do not want to update it. - if (result != map_addr) { - // upper limit 4GB - size of the object file - 1mb wiggle room. - if(llabs((uintptr_t)result - (uintptr_t)&stg_upd_frame_info) > (2<<32) - size - (2<<20)) { - // not within range :( - debugTrace(DEBUG_linker, - "MAP_32BIT didn't work; gave us %lu bytes at 0x%p", - bytes, result); - munmap(result, size); - // TODO: some abort/mmap_32bit_base recomputation based on - // if mmap_32bit_base is changed, or still at stg_upd_frame_info - goto mmap_again; - } - } -#endif - - if (mmap_32bit_base != NULL) { - // Next time, ask for memory right after our new mapping to maximize the - // chance that we get low memory. - mmap_32bit_base = (void*) ((uintptr_t)result + size); - } - - IF_DEBUG(linker, - debugBelch("mmapForLinker: mapped %" FMT_Word - " bytes starting at %p\n", (W_)size, result)); - IF_DEBUG(linker, - debugBelch("mmapForLinker: done\n")); - - return result; -} - -/* - * Map read/write pages in low memory. Returns NULL on failure. - */ -void * -mmapAnonForLinker (size_t bytes) -{ - return mmapForLinker (bytes, PROT_READ|PROT_WRITE, MAP_ANONYMOUS, -1, 0); -} - -void munmapForLinker (void *addr, size_t bytes, const char *caller) -{ - int r = munmap(addr, bytes); - if (r == -1) { - // Should we abort here? - sysErrorBelch("munmap: %s", caller); - } -} - -/* Note [Memory protection in the linker] - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * For many years the linker would simply map all of its memory - * with PROT_READ|PROT_WRITE|PROT_EXEC. However operating systems have been - * becoming increasingly reluctant to accept this practice (e.g. #17353, - * #12657) and for good reason: writable code is ripe for exploitation. - * - * Consequently mmapForLinker now maps its memory with PROT_READ|PROT_WRITE. - * After the linker has finished filling/relocating the mapping it must then - * call mmapForLinkerMarkExecutable on the sections of the mapping which - * contain executable code. - * - * Note that the m32 allocator handles protection of its allocations. For this - * reason the caller to m32_alloc() must tell the allocator whether the - * allocation needs to be executable. The caller must then ensure that they - * call m32_allocator_flush() after they are finished filling the region, which - * will cause the allocator to change the protection bits to - * PROT_READ|PROT_EXEC. - * - */ - -/* - * Mark an portion of a mapping previously reserved by mmapForLinker - * as executable (but not writable). - */ -void mmapForLinkerMarkExecutable(void *start, size_t len) -{ - if (len == 0) { - return; - } - IF_DEBUG(linker, - debugBelch("mmapForLinkerMarkExecutable: protecting %" FMT_Word - " bytes starting at %p\n", (W_)len, start)); - if (mprotect(start, len, PROT_READ|PROT_EXEC) == -1) { - barf("mmapForLinkerMarkExecutable: mprotect: %s\n", strerror(errno)); - } -} -#endif - /* * Remove symbols from the symbol table, and free oc->symbols. * This operation is idempotent. @@ -1619,10 +1353,9 @@ preloadObjectFile (pathchar *path) * See also the misalignment logic for darwin below. */ #if defined(darwin_HOST_OS) || defined(openbsd_HOST_OS) - image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0); + image = mmapForLinker(fileSize, MEM_READ_WRITE, MAP_PRIVATE, fd, 0); #else - image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE|PROT_EXEC, - MAP_PRIVATE, fd, 0); + image = mmapForLinker(fileSize, MEM_READ_WRITE_EXECUTE, MAP_PRIVATE, fd, 0); #endif if (image == MAP_FAILED) { @@ -1661,7 +1394,7 @@ preloadObjectFile (pathchar *path) image = stgMallocBytes(fileSize, "loadObj(image)"); -#endif +#endif /* !defined(darwin_HOST_OS) */ int n; n = fread ( image, 1, fileSize, f ); @@ -1706,6 +1439,15 @@ static HsInt loadObj_ (pathchar *path) return 1; // success } + if (isArchive(path)) { + if (loadArchive_(path)) { + return 1; // success + } else { + IF_DEBUG(linker, + debugBelch("tried and failed to load %" PATH_FMT " as an archive\n", path)); + } + } + ObjectCode *oc = preloadObjectFile(path); if (oc == NULL) return 0; ===================================== rts/LinkerInternals.h ===================================== @@ -374,11 +374,6 @@ void exitLinker( void ); void freeObjectCode (ObjectCode *oc); SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo); -void *mmapAnonForLinker (size_t bytes); -void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset); -void mmapForLinkerMarkExecutable (void *start, size_t len); -void munmapForLinker (void *addr, size_t bytes, const char *caller); - void addProddableBlock ( ObjectCode* oc, void* start, int size ); void checkProddableBlock (ObjectCode *oc, void *addr, size_t size ); void freeProddableBlocks (ObjectCode *oc); @@ -412,6 +407,10 @@ pathchar* resolveSymbolAddr (pathchar* buffer, int size, SymbolAddr* symbol, uintptr_t* top); +/* defined in LoadArchive.c */ +bool isArchive (pathchar *path); +HsInt loadArchive_ (pathchar *path); + /************************************************* * Various bits of configuration *************************************************/ @@ -433,6 +432,7 @@ resolveSymbolAddr (pathchar* buffer, int size, #define USE_CONTIGUOUS_MMAP 0 #endif + HsInt isAlreadyLoaded( pathchar *path ); OStatus getObjectLoadStatus_ (pathchar *path); HsInt loadOc( ObjectCode* oc ); @@ -444,20 +444,4 @@ ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize, void initSegment(Segment *s, void *start, size_t size, SegmentProt prot, int n_sections); void freeSegments(ObjectCode *oc); -/* MAP_ANONYMOUS is MAP_ANON on some systems, - e.g. OS X (before Sierra), OpenBSD etc */ -#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) -#define MAP_ANONYMOUS MAP_ANON -#endif - -/* In order to simplify control flow a bit, some references to mmap-related - definitions are blocked off by a C-level if statement rather than a CPP-level - #if statement. Since those are dead branches when !RTS_LINKER_USE_MMAP, we - just stub out the relevant symbols here -*/ -#if !RTS_LINKER_USE_MMAP -#define munmap(x,y) /* nothing */ -#define MAP_ANONYMOUS 0 -#endif - #include "EndPrivate.h" ===================================== rts/ReportMemoryMap.c ===================================== @@ -0,0 +1,138 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Memory-map dumping. + * + * This is intended to be used for reporting the process memory-map + * in diagnostics when the RTS fails to map a block of memory. + * + * ---------------------------------------------------------------------------*/ + +#include "PosixSource.h" +#include "Rts.h" + +#include + +#if defined(darwin_HOST_OS) +#include +#include +#include +#include +#endif + +#include "ReportMemoryMap.h" + +#if defined(mingw32_HOST_OS) + +void reportMemoryMap() { + debugBelch("\nMemory map:\n"); + uint8_t *addr = NULL; + while (true) { + MEMORY_BASIC_INFORMATION info; + int res = VirtualQuery(addr, &info, sizeof(info)); + if (!res && GetLastError() == ERROR_INVALID_PARAMETER) { + return; + } else if (!res) { + sysErrorBelch("VirtualQuery failed"); + return; + } + + if (info.State & MEM_FREE) { + // free range + } else { + const char *protection; + switch (info.Protect) { + case PAGE_EXECUTE: protection = "--x"; break; + case PAGE_EXECUTE_READ: protection = "r-x"; break; + case PAGE_EXECUTE_READWRITE: protection = "rwx"; break; + case PAGE_EXECUTE_WRITECOPY: protection = "rcx"; break; + case PAGE_NOACCESS: protection = "---"; break; + case PAGE_READONLY: protection = "r--"; break; + case PAGE_READWRITE: protection = "rw-"; break; + case PAGE_WRITECOPY: protection = "rc-"; break; + default: protection = "???"; break; + } + + const char *type; + switch (info.Type) { + case MEM_IMAGE: type = "image"; break; + case MEM_MAPPED: type = "mapped"; break; + case MEM_PRIVATE: type = "private"; break; + default: type = "unknown"; break; + } + + debugBelch("%08llx-%08llx %8zuK %3s (%s)\n", + (uintptr_t) info.BaseAddress, + (uintptr_t) info.BaseAddress + info.RegionSize, + (size_t) info.RegionSize, + protection, type); + } + addr = (uint8_t *) info.BaseAddress + info.RegionSize; + } +} + +#elif defined(darwin_HOST_OS) + +void reportMemoryMap() { + // Inspired by MacFUSE /proc implementation + debugBelch("\nMemory map:\n"); + while (true) { + vm_size_t vmsize; + vm_address_t address; + vm_region_basic_info_data_t info; + vm_region_flavor_t flavor = VM_REGION_BASIC_INFO; + memory_object_name_t object; + mach_msg_type_number_t info_count = VM_REGION_BASIC_INFO_COUNT; + kern_return_t kr = + mach_vm_region(mach_task_self(), &address, &vmsize, flavor, + (vm_region_info_t)&info, &info_count, &object); + if (kr == KERN_SUCCESS) { + debugBelch("%08lx-%08lx %8zuK %c%c%c/%c%c%c\n", + address, (address + vmsize), (vmsize >> 10), + (info.protection & VM_PROT_READ) ? 'r' : '-', + (info.protection & VM_PROT_WRITE) ? 'w' : '-', + (info.protection & VM_PROT_EXECUTE) ? 'x' : '-', + (info.max_protection & VM_PROT_READ) ? 'r' : '-', + (info.max_protection & VM_PROT_WRITE) ? 'w' : '-', + (info.max_protection & VM_PROT_EXECUTE) ? 'x' : '-'); + address += vmsize; + } else if (kr == KERN_INVALID_ADDRESS) { + // We presumably reached the end of address space + break; + } else { + debugBelch(" Error: %s\n", mach_error_string(kr)); + break; + } + } +} + +#else + +// Linux et al. +void reportMemoryMap() { + debugBelch("\nMemory map:\n"); + FILE *f = fopen("/proc/self/maps", "r"); + if (f == NULL) { + debugBelch(" Could not open /proc/self/maps\n"); + return; + } + + while (true) { + char buf[256]; + size_t n = fread(buf, 1, sizeof(buf)-1, f); + if (n <= 0) { + debugBelch(" Error: %s\n", strerror(errno)); + break; + } + buf[n] = '\0'; + debugBelch("%s", buf); + if (n < sizeof(buf)-1) { + break; + } + } + debugBelch("\n"); + fclose(f); +} + +#endif ===================================== rts/ReportMemoryMap.h ===================================== @@ -0,0 +1,13 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Memory-map dumping. + * + * This is intended to be used for reporting the process memory-map + * in diagnostics when the RTS fails to map a block of memory. + * + * ---------------------------------------------------------------------------*/ + +void reportMemoryMap(void); + ===================================== rts/linker/Elf.c ===================================== @@ -17,6 +17,7 @@ #include "RtsSymbolInfo.h" #include "CheckUnload.h" #include "LinkerInternals.h" +#include "linker/MMap.h" #include "linker/Elf.h" #include "linker/CacheFlush.h" #include "linker/M32Alloc.h" @@ -652,7 +653,7 @@ mapObjectFileSection (int fd, Elf_Word offset, Elf_Word size, pageOffset = roundDownToPage(offset); pageSize = roundUpToPage(offset-pageOffset+size); - p = mmapForLinker(pageSize, PROT_READ | PROT_WRITE, 0, fd, pageOffset); + p = mmapForLinker(pageSize, MEM_READ_WRITE, 0, fd, pageOffset); if (p == NULL) return NULL; *mapped_size = pageSize; *mapped_offset = pageOffset; @@ -1877,7 +1878,7 @@ ocMprotect_Elf( ObjectCode *oc ) if (section->alloc != SECTION_M32) { // N.B. m32 handles protection of its allocations during // flushing. - mmapForLinkerMarkExecutable(section->mapped_start, section->mapped_size); + mprotectForLinker(section->mapped_start, section->mapped_size, MEM_READ_EXECUTE); } break; default: ===================================== rts/linker/LoadArchive.c ===================================== @@ -7,6 +7,7 @@ #include "LinkerInternals.h" #include "CheckUnload.h" // loaded_objects, insertOCSectionIndices #include "linker/M32Alloc.h" +#include "linker/MMap.h" /* Platform specific headers */ #if defined(OBJFORMAT_PEi386) @@ -240,7 +241,7 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, return true; } -static HsInt loadArchive_ (pathchar *path) +HsInt loadArchive_ (pathchar *path) { char *image = NULL; HsInt retcode = 0; @@ -630,3 +631,21 @@ HsInt loadArchive (pathchar *path) RELEASE_LOCK(&linker_mutex); return r; } + +bool isArchive (pathchar *path) +{ + static const char ARCHIVE_HEADER[] = "!\n"; + char buffer[10]; + FILE *f = pathopen(path, WSTR("rb")); + if (f == NULL) { + return false; + } + + size_t ret = fread(buffer, 1, sizeof(buffer), f); + if (ret < sizeof(buffer)) { + return false; + } + fclose(f); + return strncmp(ARCHIVE_HEADER, buffer, sizeof(ARCHIVE_HEADER)-1) == 0; +} + ===================================== rts/linker/M32Alloc.c ===================================== @@ -10,7 +10,8 @@ #include "sm/OSMem.h" #include "RtsUtils.h" #include "linker/M32Alloc.h" -#include "LinkerInternals.h" +#include "linker/MMap.h" +#include "ReportMemoryMap.h" #include #include @@ -135,6 +136,11 @@ The allocator is *not* thread-safe. */ +// Enable internal consistency checking +#if defined(DEBUG) +#define M32_DEBUG +#endif + #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1)) #define ROUND_DOWN(x,size) (x & ~(size - 1)) @@ -147,7 +153,21 @@ The allocator is *not* thread-safe. /* How many pages should we map at once when re-filling the free page pool? */ #define M32_MAP_PAGES 32 /* Upper bound on the number of pages to keep in the free page pool */ -#define M32_MAX_FREE_PAGE_POOL_SIZE 64 +#define M32_MAX_FREE_PAGE_POOL_SIZE 256 + +/* A utility to verify that a given address is "acceptable" for use by m32. */ +static bool +is_okay_address(void *p) { + int8_t *here = LINKER_LOAD_BASE; + ssize_t displacement = (int8_t *) p - here; + return (displacement > -0x7fffffff) && (displacement < 0x7fffffff); +} + +enum m32_page_type { + FREE_PAGE, // a page in the free page pool + NURSERY_PAGE, // a nursery page + FILLED_PAGE, // a page on the filled list +}; /** * Page header @@ -161,8 +181,7 @@ struct m32_page_t { // unprotected_list or protected_list are linked together with this field. struct { uint32_t size; - uint32_t next; // this is a m32_page_t*, truncated to 32-bits. This is safe - // as we are only allocating in the bottom 32-bits + struct m32_page_t *next; } filled_page; // Pages in the small-allocation nursery encode their current allocation @@ -174,21 +193,64 @@ struct m32_page_t { struct m32_page_t *next; } free_page; }; +#if defined(M32_DEBUG) + enum m32_page_type type; +#endif + uint8_t contents[]; }; +/* Consistency-checking infrastructure */ +#if defined(M32_DEBUG) +static void ASSERT_PAGE_ALIGNED(void *page) { + const size_t pgsz = getPageSize(); + if ((((uintptr_t) page) & (pgsz-1)) != 0) { + barf("m32: invalid page alignment"); + } +} +static void ASSERT_VALID_PAGE(struct m32_page_t *page) { + ASSERT_PAGE_ALIGNED(page); + switch (page->type) { + case FREE_PAGE: + case NURSERY_PAGE: + case FILLED_PAGE: + break; + default: + barf("m32: invalid page state\n"); + } +} +static void ASSERT_PAGE_TYPE(struct m32_page_t *page, enum m32_page_type ty) { + if (page->type != ty) { barf("m32: unexpected page type"); } +} +static void ASSERT_PAGE_NOT_FREE(struct m32_page_t *page) { + if (page->type == FREE_PAGE) { barf("m32: unexpected free page"); } +} +static void SET_PAGE_TYPE(struct m32_page_t *page, enum m32_page_type ty) { + page->type = ty; +} +#else +#define ASSERT_PAGE_ALIGNED(page) +#define ASSERT_VALID_PAGE(page) +#define ASSERT_PAGE_NOT_FREE(page) +#define ASSERT_PAGE_TYPE(page, ty) +#define SET_PAGE_TYPE(page, ty) +#endif + +/* Accessors */ static void m32_filled_page_set_next(struct m32_page_t *page, struct m32_page_t *next) { - if (next > (struct m32_page_t *) 0xffffffff) { - barf("m32_filled_page_set_next: Page not in lower 32-bits"); + ASSERT_PAGE_TYPE(page, FILLED_PAGE); + if (next != NULL && ! is_okay_address(next)) { + barf("m32_filled_page_set_next: Page %p not within 4GB of program text", next); } - page->filled_page.next = (uint32_t) (uintptr_t) next; + page->filled_page.next = next; } static struct m32_page_t * m32_filled_page_get_next(struct m32_page_t *page) { - return (struct m32_page_t *) (uintptr_t) page->filled_page.next; + ASSERT_PAGE_TYPE(page, FILLED_PAGE); + return (struct m32_page_t *) (uintptr_t) page->filled_page.next; } /** @@ -213,21 +275,42 @@ struct m32_allocator_t { * We keep a small pool of free pages around to avoid fragmentation. */ struct m32_page_t *m32_free_page_pool = NULL; +/** Number of pages in free page pool */ unsigned int m32_free_page_pool_size = 0; -// TODO /** - * Free a page or, if possible, place it in the free page pool. + * Free a filled page or, if possible, place it in the free page pool. */ static void m32_release_page(struct m32_page_t *page) { - if (m32_free_page_pool_size < M32_MAX_FREE_PAGE_POOL_SIZE) { - page->free_page.next = m32_free_page_pool; - m32_free_page_pool = page; - m32_free_page_pool_size ++; - } else { - munmapForLinker((void *) page, getPageSize(), "m32_release_page"); + // Some sanity-checking + ASSERT_VALID_PAGE(page); + ASSERT_PAGE_NOT_FREE(page); + + const size_t pgsz = getPageSize(); + ssize_t sz = page->filled_page.size; + IF_DEBUG(sanity, memset(page, 0xaa, sz)); + + // Break the page, which may be a large multi-page allocation, into + // individual pages for the page pool + while (sz > 0) { + if (m32_free_page_pool_size < M32_MAX_FREE_PAGE_POOL_SIZE) { + mprotectForLinker(page, pgsz, MEM_READ_WRITE); + SET_PAGE_TYPE(page, FREE_PAGE); + page->free_page.next = m32_free_page_pool; + m32_free_page_pool = page; + m32_free_page_pool_size ++; + } else { + break; + } + page = (struct m32_page_t *) ((uint8_t *) page + pgsz); + sz -= pgsz; + } + + // The free page pool is full, release the rest back to the system + if (sz > 0) { + munmapForLinker((void *) page, ROUND_UP(sz, pgsz), "m32_release_page"); } } @@ -244,14 +327,18 @@ m32_alloc_page(void) * pages. */ const size_t pgsz = getPageSize(); - uint8_t *chunk = mmapAnonForLinker(pgsz * M32_MAP_PAGES); - if (chunk > (uint8_t *) 0xffffffff) { - barf("m32_alloc_page: failed to get allocation in lower 32-bits"); + const size_t map_sz = pgsz * M32_MAP_PAGES; + uint8_t *chunk = mmapAnonForLinker(map_sz); + if (! is_okay_address(chunk + map_sz)) { + reportMemoryMap(); + barf("m32_alloc_page: failed to allocate pages within 4GB of program text (got %p)", chunk); } + IF_DEBUG(sanity, memset(chunk, 0xaa, map_sz)); #define GET_PAGE(i) ((struct m32_page_t *) (chunk + (i) * pgsz)) for (int i=0; i < M32_MAP_PAGES; i++) { struct m32_page_t *page = GET_PAGE(i); + SET_PAGE_TYPE(page, FREE_PAGE); page->free_page.next = GET_PAGE(i+1); } @@ -264,6 +351,7 @@ m32_alloc_page(void) struct m32_page_t *page = m32_free_page_pool; m32_free_page_pool = page->free_page.next; m32_free_page_pool_size --; + ASSERT_PAGE_TYPE(page, FREE_PAGE); return page; } @@ -289,8 +377,9 @@ static void m32_allocator_unmap_list(struct m32_page_t *head) { while (head != NULL) { + ASSERT_VALID_PAGE(head); struct m32_page_t *next = m32_filled_page_get_next(head); - munmapForLinker((void *) head, head->filled_page.size, "m32_allocator_unmap_list"); + m32_release_page(head); head = next; } } @@ -305,10 +394,9 @@ void m32_allocator_free(m32_allocator *alloc) m32_allocator_unmap_list(alloc->protected_list); /* free partially-filled pages */ - const size_t pgsz = getPageSize(); for (int i=0; i < M32_MAX_PAGES; i++) { if (alloc->pages[i]) { - munmapForLinker(alloc->pages[i], pgsz, "m32_allocator_free"); + m32_release_page(alloc->pages[i]); } } @@ -321,6 +409,8 @@ void m32_allocator_free(m32_allocator *alloc) static void m32_allocator_push_filled_list(struct m32_page_t **head, struct m32_page_t *page) { + ASSERT_PAGE_TYPE(page, FILLED_PAGE); + // N.B. it's the caller's responsibility to set the pagetype to FILLED_PAGE m32_filled_page_set_next(page, *head); *head = page; } @@ -347,6 +437,7 @@ m32_allocator_flush(m32_allocator *alloc) { m32_release_page(alloc->pages[i]); } else { // the page contains data, move it to the unprotected list + SET_PAGE_TYPE(alloc->pages[i], FILLED_PAGE); m32_allocator_push_filled_list(&alloc->unprotected_list, alloc->pages[i]); } alloc->pages[i] = NULL; @@ -356,9 +447,10 @@ m32_allocator_flush(m32_allocator *alloc) { if (alloc->executable) { struct m32_page_t *page = alloc->unprotected_list; while (page != NULL) { + ASSERT_PAGE_TYPE(page, FILLED_PAGE); struct m32_page_t *next = m32_filled_page_get_next(page); m32_allocator_push_filled_list(&alloc->protected_list, page); - mmapForLinkerMarkExecutable(page, page->filled_page.size); + mprotectForLinker(page, page->filled_page.size, MEM_READ_EXECUTE); page = next; } alloc->unprotected_list = NULL; @@ -392,10 +484,12 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment) if (page == NULL) { sysErrorBelch("m32_alloc: Failed to map pages for %zd bytes", size); return NULL; - } else if (page > (struct m32_page_t *) 0xffffffff) { - debugBelch("m32_alloc: warning: Allocation of %zd bytes resulted in pages above 4GB (%p)", - size, page); + } else if (! is_okay_address(page)) { + reportMemoryMap(); + barf("m32_alloc: warning: Allocation of %zd bytes resulted in pages above 4GB (%p)", + size, page); } + SET_PAGE_TYPE(page, FILLED_PAGE); page->filled_page.size = alsize + size; m32_allocator_push_filled_list(&alloc->unprotected_list, (struct m32_page_t *) page); return (char*) page + alsize; @@ -414,6 +508,8 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment) } // page can contain the buffer? + ASSERT_VALID_PAGE(alloc->pages[i]); + ASSERT_PAGE_TYPE(alloc->pages[i], NURSERY_PAGE); size_t alsize = ROUND_UP(alloc->pages[i]->current_size, alignment); if (size <= pgsz - alsize) { void * addr = (char*)alloc->pages[i] + alsize; @@ -431,6 +527,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment) // If we haven't found an empty page, flush the most filled one if (empty == -1) { + SET_PAGE_TYPE(alloc->pages[most_filled], FILLED_PAGE); m32_allocator_push_filled_list(&alloc->unprotected_list, alloc->pages[most_filled]); alloc->pages[most_filled] = NULL; empty = most_filled; @@ -441,6 +538,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment) if (page == NULL) { return NULL; } + SET_PAGE_TYPE(page, NURSERY_PAGE); alloc->pages[empty] = page; // Add header size and padding alloc->pages[empty]->current_size = ===================================== rts/linker/MMap.c ===================================== @@ -0,0 +1,305 @@ +#include "Rts.h" + +#include "sm/OSMem.h" +#include "linker/MMap.h" +#include "Trace.h" +#include "ReportMemoryMap.h" + +#if RTS_LINKER_USE_MMAP +#include +#endif + +/* Link objects into the lower 2Gb on x86_64 and AArch64. GHC assumes the + * small memory model on this architecture (see gcc docs, + * -mcmodel=small). + * + * MAP_32BIT not available on OpenBSD/amd64 + */ +#if defined(MAP_32BIT) && (defined(x86_64_HOST_ARCH) || (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))) +#define MAP_LOW_MEM +#define TRY_MAP_32BIT MAP_32BIT +#else +#define TRY_MAP_32BIT 0 +#endif + +/* MAP_ANONYMOUS is MAP_ANON on some systems, + e.g. OS X (before Sierra), OpenBSD etc */ +#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) +#define MAP_ANONYMOUS MAP_ANON +#endif + +/* In order to simplify control flow a bit, some references to mmap-related + definitions are blocked off by a C-level if statement rather than a CPP-level + #if statement. Since those are dead branches when !RTS_LINKER_USE_MMAP, we + just stub out the relevant symbols here +*/ +#if !RTS_LINKER_USE_MMAP +#define munmap(x,y) /* nothing */ +#define MAP_ANONYMOUS 0 +#endif + +void *mmap_32bit_base = LINKER_LOAD_BASE; + +static const char *memoryAccessDescription(MemoryAccess mode) +{ + switch (mode) { + case MEM_NO_ACCESS: return "no-access"; + case MEM_READ_ONLY: return "read-only"; + case MEM_READ_WRITE: return "read-write"; + case MEM_READ_EXECUTE: return "read-execute"; + case MEM_READ_WRITE_EXECUTE: + return "read-write-execute"; + default: barf("invalid MemoryAccess"); + } +} + +#if defined(mingw32_HOST_OS) + +static DWORD +memoryAccessToProt(MemoryAccess access) +{ + switch (access) { + case MEM_NO_ACCESS: return PAGE_NOACCESS; + case MEM_READ_ONLY: return PAGE_READONLY; + case MEM_READ_WRITE: return PAGE_READWRITE; + case MEM_READ_EXECUTE: return PAGE_EXECUTE_READ; + case MEM_READ_WRITE_EXECUTE: + return PAGE_EXECUTE_READWRITE; + default: barf("invalid MemoryAccess"); + } +} + +// +// Returns NULL on failure. +// +void * +mmapAnonForLinker (size_t bytes) +{ + return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE); +} + +void +munmapForLinker (void *addr, size_t bytes, const char *caller) +{ + if (VirtualFree(addr, 0, MEM_RELEASE) == 0) { + sysErrorBelch("munmapForLinker: %s: Failed to unmap %zd bytes at %p", + caller, bytes, addr); + } +} + +/** + * Change the allowed access modes of a region of memory previously allocated + * with mmapAnonForLinker. + */ +void +mprotectForLinker(void *start, size_t len, MemoryAccess mode) +{ + DWORD old; + if (len == 0) { + return; + } + DWORD prot = memoryAccessToProt(mode); + + if (VirtualProtect(start, len, prot, &old) == 0) { + sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as %s", + len, start, memoryAccessDescription(mode)); + ASSERT(false); + } +} + +#elif RTS_LINKER_USE_MMAP + +static int +memoryAccessToProt(MemoryAccess access) +{ + switch (access) { + case MEM_NO_ACCESS: return 0; + case MEM_READ_ONLY: return PROT_READ; + case MEM_READ_WRITE: return PROT_READ | PROT_WRITE; + case MEM_READ_EXECUTE: return PROT_READ | PROT_EXEC; + case MEM_READ_WRITE_EXECUTE: + return PROT_READ | PROT_WRITE | PROT_EXEC; + default: barf("invalid MemoryAccess"); + } +} + +// +// Returns NULL on failure. +// +void * +mmapForLinker (size_t bytes, MemoryAccess access, uint32_t flags, int fd, int offset) +{ + void *map_addr = NULL; + void *result; + size_t size; + uint32_t tryMap32Bit = RtsFlags.MiscFlags.linkerAlwaysPic + ? 0 + : TRY_MAP_32BIT; + static uint32_t fixed = 0; + int prot = memoryAccessToProt(access); + + IF_DEBUG(linker, debugBelch("mmapForLinker: start\n")); + size = roundUpToPage(bytes); + +#if defined(MAP_LOW_MEM) +mmap_again: +#endif + + if (mmap_32bit_base != NULL) { + map_addr = mmap_32bit_base; + } + + IF_DEBUG(linker, + debugBelch("mmapForLinker: \tprotection %#0x\n", prot)); + IF_DEBUG(linker, + debugBelch("mmapForLinker: \tflags %#0x\n", + MAP_PRIVATE | tryMap32Bit | fixed | flags)); + IF_DEBUG(linker, + debugBelch("mmapForLinker: \tsize %#0zx\n", bytes)); + IF_DEBUG(linker, + debugBelch("mmapForLinker: \tmap_addr %p\n", map_addr)); + + result = mmap(map_addr, size, prot, + MAP_PRIVATE|tryMap32Bit|fixed|flags, fd, offset); + + if (result == MAP_FAILED) { + reportMemoryMap(); + sysErrorBelch("mmap %" FMT_Word " bytes at %p",(W_)size,map_addr); + errorBelch("Try specifying an address with +RTS -xm -RTS"); + return NULL; + } + +#if defined(MAP_LOW_MEM) + if (RtsFlags.MiscFlags.linkerAlwaysPic) { + /* make no attempt at mapping low memory if we are assuming PIC */ + } else if (mmap_32bit_base != NULL) { + if (result != map_addr) { + if ((W_)result > 0x80000000) { + // oops, we were given memory over 2Gb + munmap(result,size); +#if defined(MAP_TRYFIXED) + // Some platforms require MAP_FIXED. We use MAP_TRYFIXED since + // MAP_FIXED will overwrite existing mappings. + fixed = MAP_TRYFIXED; + goto mmap_again; +#else + reportMemoryMap(); + errorBelch("mmapForLinker: failed to mmap() memory below 2Gb; " + "asked for %lu bytes at %p. " + "Try specifying an address with +RTS -xm -RTS", + size, map_addr); + return NULL; +#endif + } else { + // hmm, we were given memory somewhere else, but it's + // still under 2Gb so we can use it. + } + } + } else { + if ((W_)result > 0x80000000) { + // oops, we were given memory over 2Gb + // ... try allocating memory somewhere else?; + debugTrace(DEBUG_linker, + "MAP_32BIT didn't work; gave us %lu bytes at 0x%p", + bytes, result); + munmap(result, size); + + // Set a base address and try again... (guess: 1Gb) + mmap_32bit_base = (void*)0x40000000; + goto mmap_again; + } + } +#elif (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)) + // for aarch64 we need to make sure we stay within 4GB of the + // mmap_32bit_base, and we also do not want to update it. + if (result != map_addr) { + // upper limit 4GB - size of the object file - 1mb wiggle room. + if(llabs((uintptr_t)result - (uintptr_t)&stg_upd_frame_info) > (2<<32) - size - (2<<20)) { + // not within range :( + debugTrace(DEBUG_linker, + "MAP_32BIT didn't work; gave us %lu bytes at 0x%p", + bytes, result); + munmap(result, size); + // TODO: some abort/mmap_32bit_base recomputation based on + // if mmap_32bit_base is changed, or still at stg_upd_frame_info + goto mmap_again; + } + } +#endif + + if (mmap_32bit_base != NULL) { + // Next time, ask for memory right after our new mapping to maximize the + // chance that we get low memory. + mmap_32bit_base = (void*) ((uintptr_t)result + size); + } + + IF_DEBUG(linker, + debugBelch("mmapForLinker: mapped %" FMT_Word + " bytes starting at %p\n", (W_)size, result)); + IF_DEBUG(linker, + debugBelch("mmapForLinker: done\n")); + + return result; +} + +/* + * Map read/write pages in low memory. Returns NULL on failure. + */ +void * +mmapAnonForLinker (size_t bytes) +{ + return mmapForLinker (bytes, MEM_READ_WRITE, MAP_ANONYMOUS, -1, 0); +} + +void munmapForLinker (void *addr, size_t bytes, const char *caller) +{ + int r = munmap(addr, bytes); + if (r == -1) { + // Should we abort here? + sysErrorBelch("munmap: %s", caller); + } +} + +/* Note [Memory protection in the linker] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * For many years the linker would simply map all of its memory + * with PROT_READ|PROT_WRITE|PROT_EXEC. However operating systems have been + * becoming increasingly reluctant to accept this practice (e.g. #17353, + * #12657) and for good reason: writable code is ripe for exploitation. + * + * Consequently mmapForLinker now maps its memory with PROT_READ|PROT_WRITE. + * After the linker has finished filling/relocating the mapping it must then + * call mprotectForLinker on the sections of the mapping which + * contain executable code. + * + * Note that the m32 allocator handles protection of its allocations. For this + * reason the caller to m32_alloc() must tell the allocator whether the + * allocation needs to be executable. The caller must then ensure that they + * call m32_allocator_flush() after they are finished filling the region, which + * will cause the allocator to change the protection bits to + * PROT_READ|PROT_EXEC. + * + */ + +/* + * Mark an portion of a mapping previously reserved by mmapForLinker + * as executable (but not writable). + */ +void mprotectForLinker(void *start, size_t len, MemoryAccess mode) +{ + if (len == 0) { + return; + } + IF_DEBUG(linker, + debugBelch("mprotectForLinker: protecting %" FMT_Word + " bytes starting at %p as %s\n", + (W_)len, start, memoryAccessDescription(mode))); + + int prot = memoryAccessToProt(mode); + + if (mprotect(start, len, prot) == -1) { + sysErrorBelch("mprotectForLinker: failed to protect %zd bytes at %p as %s", + len, start, memoryAccessDescription(mode)); + } +} +#endif ===================================== rts/linker/MMap.h ===================================== @@ -0,0 +1,80 @@ +#pragma once + +#include "BeginPrivate.h" + +#if defined(aarch64_HOST_ARCH) +// On AArch64 MAP_32BIT is not available but we are still bound by the small +// memory model. Consequently we still try using the MAP_LOW_MEM allocation +// strategy. +#define MAP_LOW_MEM +#endif + +/* + * Note [MAP_LOW_MEM] + * ~~~~~~~~~~~~~~~~~~ + * Due to the small memory model (see above), on x86_64 and AArch64 we have to + * map all our non-PIC object files into the low 2Gb of the address space (why + * 2Gb and not 4Gb? Because all addresses must be reachable using a 32-bit + * signed PC-relative offset). On x86_64 Linux we can do this using the + * MAP_32BIT flag to mmap(), however on other OSs (e.g. *BSD, see #2063, and + * also on Linux inside Xen, see #2512), we can't do this. So on these + * systems, we have to pick a base address in the low 2Gb of the address space + * and try to allocate memory from there. + * + * The same holds for aarch64, where the default, even with PIC, model + * is 4GB. The linker is free to emit AARCH64_ADR_PREL_PG_HI21 + * relocations. + * + * We pick a default address based on the OS, but also make this + * configurable via an RTS flag (+RTS -xm) + */ + +#if defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH) +// Try to use stg_upd_frame_info as the base. We need to be within +-4GB of that +// address, otherwise we violate the aarch64 memory model. Any object we load +// can potentially reference any of the ones we bake into the binary (and list) +// in RtsSymbols. Thus we'll need to be within +-4GB of those, +// stg_upd_frame_info is a good candidate as it's referenced often. +#define LINKER_LOAD_BASE ((void *) &stg_upd_frame_info) +#elif defined(x86_64_HOST_ARCH) && defined(mingw32_HOST_OS) +// On Windows (which now uses high-entropy ASLR by default) we need to ensure +// that we map code near the executable image. We use stg_upd_frame_info as a +// proxy for the image location. +#define LINKER_LOAD_BASE ((void *) &stg_upd_frame_info) +#elif defined(MAP_32BIT) || DEFAULT_LINKER_ALWAYS_PIC +// Try to use MAP_32BIT +#define LINKER_LOAD_BASE ((void *) 0x0) +#else +// A guess: 1 GB. +#define LINKER_LOAD_BASE ((void *) 0x40000000) +#endif + +/** Access modes for mprotectForLinker */ +typedef enum { + MEM_NO_ACCESS, + MEM_READ_ONLY, + MEM_READ_WRITE, + MEM_READ_EXECUTE, + MEM_READ_WRITE_EXECUTE, +} MemoryAccess; + +extern void *mmap_32bit_base; + +// Map read/write anonymous memory. +void *mmapAnonForLinker (size_t bytes); + +// Change protection of previous mapping memory. +void mprotectForLinker(void *start, size_t len, MemoryAccess mode); + +// Release a mapping. +void munmapForLinker (void *addr, size_t bytes, const char *caller); + +#if !defined(mingw32_HOST_OS) +// Map a file. +// +// Note that this not available on Windows since file mapping on Windows is +// sufficiently different to warrant its own interface. +void *mmapForLinker (size_t bytes, MemoryAccess prot, uint32_t flags, int fd, int offset); +#endif + +#include "EndPrivate.h" ===================================== rts/linker/MachO.c ===================================== @@ -1210,7 +1210,7 @@ ocGetNames_MachO(ObjectCode* oc) unsigned nstubs = numberOfStubsForSection(oc, sec_idx); unsigned stub_space = STUB_SIZE * nstubs; - void * mem = mmapForLinker(section->size+stub_space, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0); + void * mem = mmapForLinker(section->size+stub_space, MEM_READ_WRITE, MAP_ANON, -1, 0); if( mem == MAP_FAILED ) { sysErrorBelch("failed to mmap allocated memory to load section %d. " @@ -1428,7 +1428,7 @@ ocMprotect_MachO( ObjectCode *oc ) if(segment->size == 0) continue; if(segment->prot == SEGMENT_PROT_RX) { - mmapForLinkerMarkExecutable(segment->start, segment->size); + mprotectForLinker(segment->start, segment->size, MEM_READ_EXECUTE); } } @@ -1443,7 +1443,7 @@ ocMprotect_MachO( ObjectCode *oc ) if(section->alloc == SECTION_M32) continue; switch (section->kind) { case SECTIONKIND_CODE_OR_RODATA: { - mmapForLinkerMarkExecutable(section->mapped_start, section->mapped_size); + mprotectForLinker(section->mapped_start, section->mapped_size, MEM_READ_EXECUTE); break; } default: ===================================== rts/linker/SymbolExtras.c ===================================== @@ -10,6 +10,7 @@ */ #include "LinkerInternals.h" +#include "linker/MMap.h" #if defined(NEED_SYMBOL_EXTRAS) #if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS) @@ -142,7 +143,7 @@ void ocProtectExtras(ObjectCode* oc) * non-executable. */ } else if (USE_CONTIGUOUS_MMAP || RtsFlags.MiscFlags.linkerAlwaysPic) { - mmapForLinkerMarkExecutable(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras); + mprotectForLinker(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras, MEM_READ_EXECUTE); } else { /* * The symbol extras were allocated via m32. They will be protected when ===================================== rts/linker/elf_got.c ===================================== @@ -1,5 +1,6 @@ #include "Rts.h" #include "elf_got.h" +#include "linker/MMap.h" #include ===================================== rts/rts.cabal.in ===================================== @@ -475,6 +475,7 @@ library Libdw.c LibdwPool.c Linker.c + ReportMemoryMap.c Messages.c OldARMAtomic.c PathUtils.c @@ -532,6 +533,7 @@ library linker/Elf.c linker/LoadArchive.c linker/M32Alloc.c + linker/MMap.c linker/MachO.c linker/macho/plt.c linker/macho/plt_aarch64.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b81cd709df8054b8b98ac05d3b9affcee9a8b840...b361bcb04ff46aaac0e4534b695b715b7c39be98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b81cd709df8054b8b98ac05d3b9affcee9a8b840...b361bcb04ff46aaac0e4534b695b715b7c39be98 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 12:54:18 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 25 May 2023 08:54:18 -0400 Subject: [Git][ghc/ghc][wip/js-hline] Apply suggestions Message-ID: <646f5a7ab502c_64cfb15a9e9fc32096@gitlab.mail> Josh Meredith pushed to branch wip/js-hline at Glasgow Haskell Compiler / GHC Commits: 9c42138d by Sylvain Henry at 2023-05-25T12:54:16+00:00 Apply suggestions - - - - - 4 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/Linker/Linker.hs - docs/users_guide/debugging.rst Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -315,7 +315,7 @@ data GeneralFlag | Opt_WriteHie -- generate .hie files -- JavaScript opts - | Opt_DisableJsMinifier -- render JavaScript using a pretty-printed SDoc rather than compact a HLine + | Opt_DisableJsMinifier -- ^ render JavaScript pretty-printed instead of minified (compacted) -- profiling opts | Opt_AutoSccsOnIndividualCafs ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -332,8 +332,6 @@ encodeJsonChar = \case let h = showHex cp "" in text (prefix ++ replicate (pad - length h) '0' ++ h) --- braceNest :: IsLine doc => doc -> doc --- braceNest x = dualsLine (\Refl -> lbrace $$ nest 2 x $$ rbrace) (\Refl -> braces x) interSemi :: JsRender doc => [doc] -> doc interSemi = foldl ($$$) empty . punctuateFinal semi semi @@ -346,16 +344,6 @@ addSemi x = x <> semi <> char '\n' -- hdr { -- body -- } --- hangBrace :: IsLine doc => doc -> doc -> doc --- hangBrace hdr body = dualsLine --- (\Refl -> hdr <+> braces (nest 2 $ ppr body)) --- (\Refl -> hdr <> braces body) - --- ($$$) :: IsLine doc => doc -> doc -> doc --- x $$$ y = dualsLine (\Refl -> x $$ y) (\Refl -> x <> y) - --- (<+?>) :: IsLine doc => doc -> doc -> doc --- x <+?> y = dualsLine (\Refl -> x <+> y) (\Refl -> x <> y) class IsLine doc => JsRender doc where ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -197,10 +197,10 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do - if csPrettyRender cfg - then withFile (out "rts.js") WriteMode $ \h -> - printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) - else withFile (out "rts.js") WriteMode $ \h -> do + withFile (out "rts.js") WriteMode $ \h -> do + if csPrettyRender cfg + then printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) + else do bh <- newBufHandle h bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) bFlush bh ===================================== docs/users_guide/debugging.rst ===================================== @@ -727,7 +727,7 @@ JavaScript code generator ~~~~~~~~~~~~~~~~~~~~~~~~~ .. ghc-flag:: -ddisable-js-minifier - :shortdesc: Generate JavaScript code with whitespace + :shortdesc: Generate pretty-printed JavaScript code instead of minified (compacted) code. :type: dynamic Include human-readable spacing and indentation when generating JavaScript. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c42138dce426e5090f8bf96839364c9ad008023 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c42138dce426e5090f8bf96839364c9ad008023 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 13:09:37 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 25 May 2023 09:09:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-9.2.8-fix-19421-backport Message-ID: <646f5e11ab752_64cfb1647ce743213c2@gitlab.mail> Zubin pushed new branch wip/ghc-9.2.8-fix-19421-backport at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-9.2.8-fix-19421-backport You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 13:35:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 May 2023 09:35:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add a regression test for #13981 Message-ID: <646f640f80bb8_64cfb15ce38843251c8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - d219c892 by Krzysztof Gogolewski at 2023-05-25T09:35:07-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - 30 changed files: - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types.hs-boot - compiler/GHC/Types/Error/Codes.hs - + testsuite/tests/ghci/should_run/T22958c.hs - + testsuite/tests/ghci/should_run/T22958c.stdout - testsuite/tests/ghci/should_run/all.T - testsuite/tests/parser/should_fail/T12446.stderr - testsuite/tests/parser/should_fail/T18251c.stderr - testsuite/tests/parser/should_fail/T18251e.stderr - testsuite/tests/primops/should_run/all.T - testsuite/tests/quotes/TH_double_splice.stderr - testsuite/tests/quotes/TH_top_splice.stderr - testsuite/tests/quotes/TTH_top_splice.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr - testsuite/tests/showIface/should_fail/THPutDocExternal.stderr - testsuite/tests/th/T12411.stderr - testsuite/tests/th/T16133.stderr - testsuite/tests/th/T16976z.stderr - + testsuite/tests/th/TH_NestedSplicesFail1.hs - + testsuite/tests/th/TH_NestedSplicesFail1.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77ce80f9a376ba8be779a2711151f5bfd2d6f9bb...d219c89225b1fc9df0850becde1e879933515250 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77ce80f9a376ba8be779a2711151f5bfd2d6f9bb...d219c89225b1fc9df0850becde1e879933515250 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 14:37:24 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 25 May 2023 10:37:24 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] Some progress Message-ID: <646f72a4b1a4f_64cfb15f7bee83480d1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: c834d7ad by Rodrigo Mesquita at 2023-05-25T15:37:10+01:00 Some progress - - - - - 23 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - compiler/Language/Haskell/Syntax/Expr.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Core ( isId, cmpAltCon, cmpAlt, ltAlt, -- ** Simple 'Expr' access functions and predicates - bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, + bindersOf, bindersOfBinds, rhssOfBind, bindersOfAlts, rhssOfAlts, foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, @@ -254,7 +254,7 @@ data Expr b | App (Expr b) (Arg b) | HasCallStack => Lam b (Expr b) | HasCallStack => Let (Bind b) (Expr b) - | Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants] + | HasCallStack => Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants] -- and Note [Why does Case have a 'Type' field?] | Cast (Expr b) CoercionR -- The Coercion has Representational role | Tick CoreTickish (Expr b) @@ -1934,7 +1934,7 @@ mkLets :: HasCallStack => Typeable b => [Bind b] -> Expr b -> Expr b -- use 'GHC.Core.Make.mkCoreLams' if possible mkLams :: forall b. HasCallStack => Typeable b => [b] -> Expr b -> Expr b -mkLams binders body = case eqT @b @Id of Just Refl -> if not (all isLambdaBinding binders) then pprPanic "mkLams" (text "A let-bound var [" <+> hsep (map pprIdWithBinding binders) <+> text "] was used to construct a lambda binder!") else foldr Lam body binders +mkLams binders body = case eqT @b @Id of Just Refl -> if any (not . isLambdaBinding) binders then pprPanic "mkLams" (text "A let-bound var [" <+> hsep (map pprIdWithBinding binders) <+> text "] was used to construct a lambda binder!") else foldr Lam body binders Nothing -> foldr Lam body binders mkLets binds body = foldr mkLet body binds @@ -2039,6 +2039,10 @@ rhssOfBind :: Bind b -> [Expr b] rhssOfBind (NonRec _ rhs) = [rhs] rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs] +-- | Concat together all the binders in each alternative +bindersOfAlts :: [Alt b] -> [b] +bindersOfAlts = concatMap (\(Alt _ ids _) -> ids) + rhssOfAlts :: [Alt b] -> [Expr b] rhssOfAlts alts = [e | Alt _ _ e <- alts] ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2342,6 +2342,9 @@ occAnal env expr@(Lam {}) = adjustNonRecRhs Nothing $ occAnalLamTail env expr -- mb_join_arity == Nothing <=> markAllManyNonTail occAnal env (Case scrut bndr ty alts) + | isLetBinding bndr || any isLetBinding (bindersOfAlts alts) + = pprPanic "simplExprF1:ouch!" (pprIdWithBinding bndr <+> ppr alts) + | otherwise = let (WithUsageDetails scrut_usage scrut') = occAnal (scrutCtxt env alts) scrut alt_env = addBndrSwap scrut' bndr $ env { occ_encl = OccVanilla } `addOneInScope` bndr @@ -2361,8 +2364,12 @@ occAnal env (Case scrut bndr ty alts) occAnal env (Let bind body) | NonRec b _ <- bind - , isLambdaBinding b - = pprPanic "occAnal" (pprIdWithBinding b) + , not (isLetBinding b) + , isId b + = pprPanic "occAnal:NonRec" (pprIdWithBinding b) + | Rec bs <- bind + , any (\x -> isId (fst x) && (not . isLetBinding . fst) x) bs + = pprPanic "occAnal:Rec" (ppr bs) | otherwise = let body_env = env { occ_encl = OccVanilla } `addInScope` bindersOf bind ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -60,7 +60,7 @@ import GHC.Types.Demand import GHC.Types.Unique ( hasKey ) import GHC.Types.Basic import GHC.Types.Tickish -import GHC.Types.Var ( isTyCoVar ) +import GHC.Types.Var ( isTyCoVar, pprIdWithBinding, isLetBinding, isLambdaBinding ) import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) @@ -587,7 +587,7 @@ unless the kind of the type of rhs is concrete, in the sense of Note [Concrete types] in GHC.Tc.Utils.Concrete. -} -tryCastWorkerWrapper :: SimplEnv -> BindContext +tryCastWorkerWrapper :: HasCallStack => SimplEnv -> BindContext -> InId -> OccInfo -> OutId -> OutExpr -> SimplM (SimplFloats, SimplEnv) @@ -918,7 +918,7 @@ It does *not* attempt to do let-to-case. Why? Because it is used for Nor does it do the atomic-argument thing -} -completeBind :: SimplEnv +completeBind :: HasCallStack => SimplEnv -> BindContext -> InId -- Old binder -> OutId -- New binder; can be a JoinId @@ -973,6 +973,7 @@ completeBind env bind_cxt old_bndr new_bndr new_rhs addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId addLetBndrInfo new_bndr new_arity_type new_unf = new_bndr `setIdInfo` info5 + `setIdBinding` LetBound zeroUE -- See Note [Keeping the IdBinding up to date] where new_arity = arityTypeArity new_arity_type info1 = idInfo new_bndr `setArityInfo` new_arity @@ -1213,6 +1214,9 @@ simplExprF1 env expr@(Lam {}) cont -- and likewise drop counts all binders (incl type lambdas) simplExprF1 env (Case scrut bndr _ alts) cont + | isLetBinding bndr || any isLetBinding (bindersOfAlts alts) + = pprPanic "simplExprF1:ouch!" (pprIdWithBinding bndr <+> ppr alts) + | otherwise = {-#SCC "simplExprF1-Case" #-} pprTrace "simplExprF1:Case:" (ppr bndr <+> ppr (idBinding bndr)) $ simplExprF env scrut (Select { sc_dup = NoDup, sc_bndr = bndr @@ -2933,6 +2937,9 @@ rebuildCase, reallyRebuildCase -------------------------------------------------- rebuildCase env scrut case_bndr alts cont + | isLetBinding case_bndr || any isLetBinding (bindersOfAlts alts) + = pprPanic "reallyRebuildCase:ouch!" (pprIdWithBinding case_bndr <+> ppr alts) + | Lit lit <- scrut -- No need for same treatment as constructors -- because literals are inlined more vigorously , not (litIsLifted lit) @@ -3831,6 +3838,8 @@ mkDupableAlt :: HasCallStack => Platform -> OutId -> JoinFloats -> OutAlt -> SimplM (JoinFloats, OutAlt) mkDupableAlt _platform case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) + | any (not . isLambdaBinding) alt_bndrs + = pprPanic "mkDupableAlt: Alt has let binders" (ppr $ map pprIdWithBinding alt_bndrs) | exprIsTrivial alt_rhs_in -- See point (2) of Note [Duplicating join points] = return (jfloats, Alt con alt_bndrs alt_rhs_in) @@ -3879,7 +3888,8 @@ mkDupableAlt _platform case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) -- so we must zap them here. join_rhs = mkLams (map zapIdUnfolding final_bndrs) rhs_with_seqs - ; pprTraceM "mkDupableAlt:filtered_binders" (ppr $ map (\x -> ppr x <+> ppr (idBinding x)) filtered_binders) + ; pprTraceM "mkDupableAlt:final_bndrs" (ppr $ map pprIdWithBinding final_bndrs) + ; pprTraceM "mkDupableAlt:filtered_binders" (ppr $ map pprIdWithBinding filtered_binders) ; join_bndr <- newJoinId filtered_binders rhs_ty' ; let join_call = mkApps (Var join_bndr) final_args ===================================== compiler/GHC/Core/Opt/Simplify/Monad.hs ===================================== @@ -221,7 +221,7 @@ newJoinId bndrs body_ty id_info = vanillaIdInfo `setArityInfo` arity -- `setOccInfo` strongLoopBreaker - ; return (mkLocalVar details name (LetBound zeroUE) join_id_ty id_info) } -- ROMES:TODO: What are the IdBindings of JoinPoints? Should we consider them explicitly for join points or treat as lets? + ; return (mkLocalVar details name (LetBound zeroUE) join_id_ty id_info) } {- ************************************************************************ ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -4,7 +4,7 @@ The simplifier utilities -} - +{-# LANGUAGE ExistentialQuantification #-} module GHC.Core.Opt.Simplify.Utils ( -- Rebuilding @@ -50,6 +50,7 @@ import GHC.Types.Literal ( isLitRubbish ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Inline import GHC.Core.Opt.Stats ( Tick(..) ) +import GHC.Core.UsageEnv (zeroUE) import qualified GHC.Core.Subst import GHC.Core.Ppr import GHC.Core.TyCo.Ppr ( pprParendType ) @@ -179,7 +180,7 @@ data SimplCont -- See Note [The hole type in ApplyToTy] , sc_cont :: SimplCont } - | Select -- (Select alts K)[e] = K[ case e of alts ] + | HasCallStack => Select -- (Select alts K)[e] = K[ case e of alts ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] , sc_bndr :: InId -- case binder , sc_alts :: [InAlt] -- Alternatives @@ -2289,7 +2290,7 @@ OutId. Test simplCore/should_compile/simpl013 apparently shows this up, although I'm not sure exactly how.. -} -prepareAlts :: OutExpr -> InId -> [InAlt] -> SimplM ([AltCon], [InAlt]) +prepareAlts :: HasCallStack => OutExpr -> InId -> [InAlt] -> SimplM ([AltCon], [InAlt]) -- The returned alternatives can be empty, none are possible -- -- Note that case_bndr is an InId; see Note [Shadowing in prepareAlts] @@ -2538,7 +2539,9 @@ mkCase mode scrut outer_bndr alts_ty (Alt DEFAULT _ deflt_rhs : outer_alts) (Alt con args (wrap_rhs rhs)) -- Simplifier's no-shadowing invariant should ensure -- that outer_bndr is not shadowed by the inner patterns - wrap_rhs rhs = Let (NonRec inner_bndr (Var outer_bndr)) rhs + wrap_rhs rhs = Let (NonRec (inner_bndr `setIdBinding` LetBound zeroUE) (Var outer_bndr)) rhs + -- IdBinding: See Note [Keeping the IdBinding up to date] + -- -- The let is OK even for unboxed binders, wrapped_alts | isDeadBinder inner_bndr = inner_alts ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Core.TyCon.RecWalk import GHC.Core.SimpleOpt( SimpleOpts ) import GHC.Types.Id +import GHC.Types.Var (pprIdWithBinding, isLambdaBinding) import GHC.Types.Id.Info import GHC.Types.Demand import GHC.Types.Cpr @@ -277,7 +278,11 @@ mkWwBodies opts fun_id arg_vars res_ty demands res_cpr mkAppsBeta :: CoreExpr -> [CoreArg] -> CoreExpr -- The precondition holds for our call site in mkWwBodies, because all the FVs -- of as are either cloned_arg_vars (and thus fresh) or fresh worker args. -mkAppsBeta (Lam b body) (a:as) = bindNonRec b a $! mkAppsBeta body as +mkAppsBeta (Lam b body) (a:as) + | not (isLambdaBinding b) + = pprPanic "mkAppsBeta" (pprIdWithBinding b) + | otherwise + = bindNonRec b a $! mkAppsBeta body as mkAppsBeta f as = mkApps f as -- See Note [Limit w/w arity] ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Types.Id.Info ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, Id import GHC.Types.Var ( isNonCoVarId ) import GHC.Types.Var.Set import GHC.Types.Var.Env +import GHC.Core.UsageEnv import GHC.Core.DataCon import GHC.Types.Demand( etaConvertDmdSig, topSubDmd ) import GHC.Types.Tickish @@ -768,9 +769,11 @@ add_info env old_bndr top_level new_rhs new_bndr False -- may be bottom or not new_rhs Nothing -wrapLet :: Maybe (Id,CoreExpr) -> CoreExpr -> CoreExpr +wrapLet :: HasCallStack => Maybe (Id,CoreExpr) -> CoreExpr -> CoreExpr wrapLet Nothing body = body -wrapLet (Just (b,r)) body = Let (NonRec b r) body +wrapLet (Just (b,r)) body = Let (NonRec (b `setIdBinding` LetBound zeroUE) r) body + -- See Note [Keeping the IdBinding up to date] + -- wrapLet is called always on binders lambda bound {- Note [Inline prag in simplOpt] ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -523,7 +523,11 @@ bindNonRec bndr rhs body lambda_bndr = setIdBinding bndr (maybe (LambdaBound ManyTy) LambdaBound (varMultMaybe bndr)) -- ROMES:TODO: Explain, is this the best place to do this? case_bind = mkDefaultCase rhs lambda_bndr body -- ROMES:TODO: I couldn't find the root cause, for now we simply override the idBinding here - let_bind = Let (NonRec (bndr `setIdBinding` LetBound zeroUE) rhs) body + let_bind + | isId bndr + = Let (NonRec (bndr `setIdBinding` LetBound zeroUE) rhs) body + | otherwise + = Let (NonRec bndr rhs) body -- | Tests whether we have to use a @case@ rather than @let@ binding for this -- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant" @@ -547,7 +551,7 @@ mkAltExpr (LitAlt lit) [] [] mkAltExpr (LitAlt _) _ _ = panic "mkAltExpr LitAlt" mkAltExpr DEFAULT _ _ = panic "mkAltExpr DEFAULT" -mkDefaultCase :: CoreExpr -> Id -> CoreExpr -> CoreExpr +mkDefaultCase :: HasCallStack => CoreExpr -> Id -> CoreExpr -> CoreExpr -- Make (case x of y { DEFAULT -> e } mkDefaultCase scrut case_bndr body = assertPpr (isJust (varMultMaybe case_bndr)) (text "mkDefaultCase:Case binder is marked LetBound!") $ @@ -606,7 +610,7 @@ findDefault :: [Alt b] -> ([Alt b], Maybe (Expr b)) findDefault (Alt DEFAULT args rhs : alts) = assert (null args) (alts, Just rhs) findDefault alts = (alts, Nothing) -addDefault :: [Alt b] -> Maybe (Expr b) -> [Alt b] +addDefault :: HasCallStack => [Alt b] -> Maybe (Expr b) -> [Alt b] addDefault alts Nothing = alts addDefault alts (Just rhs) = Alt DEFAULT [] rhs : alts @@ -688,7 +692,8 @@ trimConArgs DEFAULT args = assert (null args) [] trimConArgs (LitAlt _) args = assert (null args) [] trimConArgs (DataAlt dc) args = dropList (dataConUnivTyVars dc) args -filterAlts :: TyCon -- ^ Type constructor of scrutinee's type (used to prune possibilities) +filterAlts :: HasCallStack + => TyCon -- ^ Type constructor of scrutinee's type (used to prune possibilities) -> [Type] -- ^ And its type arguments -> [AltCon] -- ^ 'imposs_cons': constructors known to be impossible due to the form of the scrutinee -> [Alt b] -- ^ Alternatives ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExistentialQuantification #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -74,6 +75,8 @@ import Data.List ( unfoldr ) import Data.Functor.Identity import Control.Monad +import GHC.Core.UsageEnv (zeroUE) + {- Note [CorePrep Overview] ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1722,7 +1725,7 @@ data FloatingBind -- They are always of lifted type; -- unlifted ones are done with FloatCase - | FloatCase + | HasCallStack => FloatCase CpeBody -- Always ok-for-speculation Id -- Case binder AltCon [Var] -- Single alternative @@ -1761,14 +1764,15 @@ data OkToSpec -- ok-to-speculate unlifted bindings | NotOkToSpec -- Some not-ok-to-speculate unlifted bindings -mkFloat :: CorePrepEnv -> Demand -> Bool -> Id -> CpeRhs -> FloatingBind +mkFloat :: HasCallStack => CorePrepEnv -> Demand -> Bool -> Id -> CpeRhs -> FloatingBind +-- romes:TODO: See Note [Keeping the IdBinding up to date] mkFloat env dmd is_unlifted bndr rhs | is_strict || ok_for_spec -- See Note [Speculative evaluation] - , not is_hnf = FloatCase rhs bndr DEFAULT [] ok_for_spec + , not is_hnf = FloatCase rhs (bndr `setIdBinding` LambdaBound ManyTy) DEFAULT [] ok_for_spec -- Don't make a case for a HNF binding, even if it's strict -- Otherwise we get case (\x -> e) of ...! - | is_unlifted = FloatCase rhs bndr DEFAULT [] True + | is_unlifted = FloatCase rhs (bndr `setIdBinding` LambdaBound ManyTy) DEFAULT [] True -- we used to assertPpr ok_for_spec (ppr rhs) here, but it is now disabled -- because exprOkForSpeculation isn't stable under ANF-ing. See for -- example #19489 where the following unlifted expression: @@ -2223,7 +2227,7 @@ fiddleCCall id newVar :: Type -> UniqSM Id newVar ty - = seqType ty `seq` mkSysLocalOrCoVarM (fsLit "sat") (LambdaBound ManyTy) ty -- ROMES:TODO: What kind of binders?! I guess up until now it didn't really matter, but now it does + = seqType ty `seq` mkSysLocalOrCoVarM (fsLit "sat") (LetBound zeroUE) ty ------------------------------------------------------------------------------ ===================================== compiler/GHC/Hs/Binds.hs ===================================== @@ -9,6 +9,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-orphans #-} -- Outputable @@ -49,6 +51,7 @@ import GHC.Data.Bag import GHC.Data.BooleanFormula (LBooleanFormula) import GHC.Types.Name.Reader import GHC.Types.Name +import GHC.Stack import GHC.Utils.Outputable import GHC.Utils.Panic @@ -692,8 +695,8 @@ type instance XXFixitySig (GhcPass p) = DataConCantHappen -- generated for record selectors. We simply record the desired Id -- itself, replete with its name, type and IdDetails. Otherwise it's -- just like a type signature: there should be an accompanying binding -newtype IdSig = IdSig { unIdSig :: Id } - deriving Data +data IdSig = HasCallStack => IdSig { unIdSig :: Id } +deriving instance Data IdSig data AnnSig = AnnSig { ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -321,7 +321,7 @@ dsAbsBinds dflags tyvars dicts exports , abe_poly = global , abe_mono = local, abe_prags = spec_prags }) -- See Note [ABExport wrapper] in "GHC.Hs.Binds" - = do { tup_id <- newSysLocalDs (LambdaBound ManyTy) tup_ty -- ROMES:TODO? + = do { tup_id <- newSysLocalDs (LetBound zeroUE) tup_ty -- ROMES:TODO? ; dsHsWrapper wrap $ \core_wrap -> do { let rhs = core_wrap $ mkLams tyvars $ mkLams dicts $ mkBigTupleSelector all_locals local tup_id $ ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -51,6 +51,7 @@ import GHC.Core.Make import GHC.Driver.Session import GHC.Types.CostCentre import GHC.Types.Id +import GHC.Types.Var (pprIdWithBinding) import GHC.Types.Id.Make import GHC.Unit.Module import GHC.Core.ConLike @@ -155,6 +156,8 @@ ds_val_bind (is_rec, binds) body -- we should never produce a non-recursive list of multiple binds ; (force_vars,prs) <- dsLHsBinds binds + ; pprTraceM "ds_val_bind:binds" (ppr binds) + ; pprTraceM "ds_val_bind:prs" (ppr $ map (pprIdWithBinding . fst) prs) ; let body' = foldr seqVar body force_vars ; assertPpr (not (any (isUnliftedType . idType . fst) prs)) (ppr is_rec $$ ppr binds) $ -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -28,6 +28,7 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) +import GHC.Core.UsageEnv (zeroUE) import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.Session @@ -371,7 +372,6 @@ Among other things in the resulting Pattern: The bindings created by the above patterns are put into the returned wrapper instead. --- ROMES:TODO: Do something about this, lambda bound can become let bound for irrefutable patterns This means a definition of the form: f x = rhs when called with v get's desugared to the equivalent of: @@ -396,12 +396,14 @@ only these which can be assigned a PatternGroup (see patGroup). -} +-- | See 'Tidiying Patterns' above +-- +-- Wraps a call to 'tidy1' which does the interesting stuff, looking at one +-- pattern and fiddling the list of bindings tidyEqnInfo :: Id -> EquationInfo -> DsM (DsWrapper, EquationInfo) -- DsM'd because of internal call to dsLHsBinds -- and mkSelectorBinds. - -- "tidy1" does the interesting stuff, looking at - -- one pattern and fiddling the list of bindings. -- -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. @@ -413,12 +415,13 @@ tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) = do { (wrap, pat') <- tidy1 v orig pat ; return (wrap, eqn { eqn_pats = pat' : pats }) } +-- | See also 'Tidiying Patterns' above tidy1 :: Id -- The Id being scrutinised -> Origin -- Was this a pattern the user wrote? -> Pat GhcTc -- The pattern against which it is to be matched -> DsM (DsWrapper, -- Extra bindings to do before the match Pat GhcTc) -- Equivalent pattern - +-- ^ ------------------------------------------------------- -- (pat', mr') = tidy1 v pat mr -- tidies the *outer level only* of pat, giving pat' @@ -433,13 +436,15 @@ tidy1 v o (BangPat _ (L l p)) = tidy_bang_pat v o l p -- case v of { x -> mr[] } -- = case v of { _ -> let x=v in mr[] } tidy1 v _ (VarPat _ (L _ var)) - = return (wrapBind var v, WildPat (idType var)) + = return (wrapBind (var `setIdBinding` LetBound zeroUE) v, WildPat (idType var)) + -- See Note [Keeping the IdBinding up to date] -- case v of { x at p -> mr[] } -- = case v of { p -> let x=v in mr[] } tidy1 v o (AsPat _ (L _ var) _ pat) = do { (wrap, pat') <- tidy1 v o (unLoc pat) - ; return (wrapBind var v . wrap, pat') } + ; return (wrapBind (var `setIdBinding` LetBound zeroUE) v . wrap, pat') } + -- See Note [Keeping the IdBinding up to date] {- now, here we handle lazy patterns: tidy1 v ~p bs = (v, v1 = case v of p -> v1 : ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -153,7 +153,8 @@ selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWit -- multiplicity stored within the variable -- itself. It's easier to pull it from the -- variable, so we ignore the multiplicity. -selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return ((unLoc var) `setIdBinding` (LambdaBound ManyTy))) -- ROMES:TODO: Are match variables always put in cases? If yes, then this could be a way to guarantee match variables are lambda bound/case bound +selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return ((unLoc var) `setIdBinding` (LambdaBound ManyTy))) + -- ROMES:TODO: Are match variables always put in cases? If yes, then this could be a way to guarantee match variables are lambda bound/case bound -- selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return (unLoc var)) selectMatchVar w other_pat = newSysLocalDs (LambdaBound w) (hsPatType other_pat) -- ROMES:TODO: Can match variables end up in lets and cases?, I think yes. @@ -251,17 +252,22 @@ adjustMatchResultDs encl_fn = \case MR_Fallible body_fn -> MR_Fallible $ \fail -> encl_fn =<< body_fn fail -wrapBinds :: [(Var,Var)] -> CoreExpr -> CoreExpr +wrapBinds :: HasCallStack => [(Var,Var)] -> CoreExpr -> CoreExpr wrapBinds [] e = e wrapBinds ((new,old):prs) e = wrapBind new old (wrapBinds prs e) -wrapBind :: Var -> Var -> CoreExpr -> CoreExpr +wrapBind :: HasCallStack => Var -> Var -> CoreExpr -> CoreExpr wrapBind new old body -- NB: this function must deal with term | new==old = body -- variables, type variables or coercion variables | otherwise = Let (NonRec new (varToCoreExpr old)) body -seqVar :: Var -> CoreExpr -> CoreExpr -seqVar var body = mkDefaultCase (Var var) var body +-- | 'seqVar' produces a 'CoreExpr' in which the evaluation of 'Var' is forced +-- by means of scrutinizing it in a case expression with a single DEFAULT alternative. +seqVar :: HasCallStack => Var -> CoreExpr -> CoreExpr +-- romes:TODO: it's not evident how to consider the case of a variable that was +-- let bound being used for the case scrutinee. Now I'm making them ManyTy to +-- move forward +seqVar var body = mkDefaultCase (Var var) (var `setIdBinding` LambdaBound ManyTy) body mkCoLetMatchResult :: CoreBind -> MatchResult CoreExpr -> MatchResult CoreExpr mkCoLetMatchResult bind = fmap (mkCoreLet bind) @@ -734,8 +740,8 @@ work out well: ; y = case v of K x y -> y } which is better. -} --- Remark: pattern selectors only occur in unrestricted patterns so we are free --- to select Many as the multiplicity of every let-expression introduced. + +-- | See Note [mkSelectorBinds] mkSelectorBinds :: [[CoreTickish]] -- ^ ticks to add, possibly -> LPat GhcTc -- ^ The pattern -> CoreExpr -- ^ Expression to which the pattern is bound @@ -744,13 +750,17 @@ mkSelectorBinds :: [[CoreTickish]] -- ^ ticks to add, possibly -- binds (see Note [Desugar Strict binds] in "GHC.HsToCore.Binds") -- and all the desugared binds +-- ROMES:TODO: Update remark, and what's a pattern selector? +-- Remark: pattern selectors only occur in unrestricted patterns so we are free +-- to select Many as the multiplicity of every let-expression introduced. +-- See also Note [Keeping the IdBinding up to date] mkSelectorBinds ticks pat val_expr | L _ (VarPat _ (L _ v)) <- pat' -- Special case (A) = return (v, [(v, val_expr)]) | is_flat_prod_lpat pat' -- Special case (B) = do { let pat_ty = hsLPatType pat' - ; val_var <- newSysLocalDs (LambdaBound ManyTy) pat_ty -- ROMES:TODO: selector binders are lambda bound? + ; val_var <- newSysLocalDs (LetBound zeroUE) pat_ty ; let mk_bind tick bndr_var -- (mk_bind sv bv) generates bv = case sv of { pat -> bv } @@ -768,7 +778,7 @@ mkSelectorBinds ticks pat val_expr ; return ( val_var, (val_var, val_expr) : binds) } | otherwise -- General case (C) - = do { tuple_var <- newSysLocalDs (LambdaBound ManyTy) tuple_ty -- ROMES:TODO: selector binders are lambda bound? yes since they're used ahead in mkBigTupleSelectorSolo? + = do { tuple_var <- newSysLocalDs (LetBound zeroUE) tuple_ty ; error_expr <- mkErrorAppDs pAT_ERROR_ID tuple_ty (ppr pat') ; tuple_expr <- matchSimply val_expr PatBindRhs pat local_tuple error_expr ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1303,7 +1303,7 @@ checkFunBind strictness locF ann fun is_infix pats (L _ grhss) | Infix <- is_infix = ParseContext (Just $ unLoc fun) NoIncompleteDoBlock | otherwise = noParseContext -makeFunBind :: LocatedN RdrName -> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] +makeFunBind :: HasCallStack => LocatedN RdrName -> LocatedL [LMatch GhcPs (LHsExpr GhcPs)] -> HsBind GhcPs -- Like GHC.Hs.Utils.mkFunBind, but we need to be able to set the fixity too makeFunBind fn ms ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -555,7 +555,7 @@ recoveryCode binder_names sig_fn , Just poly_id <- completeSigPolyId_maybe sig = poly_id | otherwise - = mkLocalId name (LambdaBound ManyTy) forall_a_a -- ROMES:TODO: Does it matter? + = mkLocalId name (LetBound zeroUE) forall_a_a -- ROMES:TODO: Does it matter? forall_a_a :: TcType -- At one point I had (forall r (a :: TYPE r). a), but of course @@ -609,11 +609,12 @@ tcPolyCheck :: TcPragEnv -- it is a FunBind -- it has a complete type signature, tcPolyCheck prag_fn - (CompleteSig { sig_bndr = poly_id - , sig_ctxt = ctxt - , sig_loc = sig_loc }) + cs (L bind_loc (FunBind { fun_id = L nm_loc name , fun_matches = matches })) + | (CompleteSig { sig_bndr = poly_id + , sig_ctxt = ctxt + , sig_loc = sig_loc }) <- cs = do { traceTc "tcPolyCheck" (ppr poly_id $$ ppr sig_loc) ; mono_name <- newNameAt (nameOccName name) (locA nm_loc) @@ -965,7 +966,7 @@ mkInferredPolyId residual insoluble qtvs inferred_theta poly_name mb_sig_inst mo -- (#14000) we may report an ambiguity error for a rather -- bogus type. - ; return (mkLocalId poly_name (LambdaBound ManyTy) inferred_poly_ty) } -- ROMES:TODO: Inferred poly id is prob forall bound, consider lambda bound (its lambda alright, a big one) ? + ; return (mkLocalId poly_name (LetBound zeroUE) inferred_poly_ty) } -- ROMES:TODO: Inferred poly id is prob forall bound, consider lambda bound (its lambda alright, a big one) ? chooseInferredQuantifiers :: WantedConstraints -- residual constraints ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -76,6 +76,7 @@ import Data.Maybe( mapMaybe ) import qualified Data.List.NonEmpty as NE import Control.Monad( unless ) import GHC.Core.UsageEnv (zeroUE) +import GHC.Stack {- ------------------------------------------------------------- @@ -280,7 +281,7 @@ lhsSigTypeContextSpan (L _ HsSig { sig_body = sig_ty }) = go sig_ty go (L _ (HsParTy _ hs_ty)) = go hs_ty -- Look under parens go _ = NoRRC -- Did not find it -completeSigFromId :: UserTypeCtxt -> Id -> TcIdSigInfo +completeSigFromId :: HasCallStack => UserTypeCtxt -> Id -> TcIdSigInfo -- Used for instance methods and record selectors completeSigFromId ctxt id = CompleteSig { sig_bndr = id ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -45,7 +45,7 @@ import GHC.Tc.TyCl.Build( TcMethInfo ) import GHC.Core.Type ( extendTvSubstWithClone, piResultTys ) import GHC.Core.Predicate -import GHC.Core.Multiplicity +import GHC.Core.UsageEnv (zeroUE) import GHC.Core.Class import GHC.Core.Coercion ( pprCoAxiom ) import GHC.Core.FamInstEnv @@ -295,7 +295,7 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn ctxt = FunSigCtxt sel_name warn_redundant - ; let local_dm_id = mkLocalId local_dm_name (LambdaBound ManyTy) local_dm_ty -- ROMES:TODO: + ; let local_dm_id = mkLocalId local_dm_name (LetBound zeroUE) local_dm_ty local_dm_sig = CompleteSig { sig_bndr = local_dm_id , sig_ctxt = ctxt , sig_loc = getLocA hs_ty } ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Core.Type import GHC.Core.SimpleOpt import GHC.Core.Predicate( classMethodInstTy ) import GHC.Tc.Types.Evidence +import GHC.Core.UsageEnv (zeroUE) import GHC.Core.TyCon import GHC.Core.Coercion.Axiom import GHC.Core.DataCon @@ -2016,7 +2017,7 @@ tcMethodBody skol_info clas tyvars dfun_ev_vars inst_tys | is_derived = addLandmarkErrCtxt (derivBindCtxt sel_id clas inst_tys) thing | otherwise = thing -tcMethodBodyHelp :: HsSigFun -> Id -> TcId +tcMethodBodyHelp :: HasCallStack => HsSigFun -> Id -> TcId -> LHsBind GhcRn -> TcM (LHsBinds GhcTc) tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind | Just hs_sig_ty <- hs_sig_fn sel_name @@ -2082,6 +2083,7 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind -- they are all for meth_id ------------------------ +-- | Romes:TODO: What is a MethId? mkMethIds :: Class -> [TcTyVar] -> [EvVar] -> [TcType] -> Id -> TcM (TcId, TcId) -- returns (poly_id, local_id), but ignoring any instance signature @@ -2091,8 +2093,8 @@ mkMethIds clas tyvars dfun_ev_vars inst_tys sel_id ; local_meth_name <- newName sel_occ -- Base the local_meth_name on the selector name, because -- type errors from tcMethodBody come from here - ; let poly_meth_id = mkLocalId poly_meth_name (LambdaBound ManyTy) poly_meth_ty -- ROMES:TODO: - local_meth_id = mkLocalId local_meth_name (LambdaBound ManyTy) local_meth_ty -- ROMES:TODO: + ; let poly_meth_id = mkLocalId poly_meth_name (LetBound zeroUE) poly_meth_ty -- ROMES:TODO: methIds + local_meth_id = mkLocalId local_meth_name (LetBound zeroUE) local_meth_ty -- ROMES:TODO: ; return (poly_meth_id, local_meth_id) } where ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -1445,7 +1445,7 @@ data TcSigInfo = TcIdSig TcIdSigInfo | TcPatSynSig TcPatSynInfo data TcIdSigInfo -- See Note [Complete and partial type signatures] - = CompleteSig -- A complete signature with no wildcards, + = HasCallStack => CompleteSig -- A complete signature with no wildcards, -- so the complete polymorphic type is known. { sig_bndr :: TcId -- The polymorphic Id with that type ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -156,6 +156,7 @@ import Control.Monad import GHC.Data.Maybe import qualified Data.Semigroup as Semi import GHC.Types.Name.Reader +import GHC.Core.UsageEnv (zeroUE) {- ************************************************************************ @@ -322,7 +323,7 @@ emitNewExprHole occ ty newDict :: Class -> [TcType] -> TcM DictId newDict cls tys = do { name <- newSysName (mkDictOcc (getOccName cls)) - ; return (mkLocalId name (LambdaBound ManyTy) (mkClassPred cls tys)) } -- Dicts are lambda bound with Many + ; return (mkLocalId name (LetBound zeroUE) (mkClassPred cls tys)) } predTypeOccName :: PredType -> OccName predTypeOccName ty = case classifyPredType ty of ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -1343,7 +1343,7 @@ updateIdTypeAndMultsM f id@(Id { varType = ty ; return (id { varType = ty', idBinding = binding' }) } updateIdTypeAndMultsM _ other = pprPanic "updateIdTypeAndMultM" (ppr other) -setIdBinding :: Id -> IdBinding -> Id +setIdBinding :: HasCallStack => Id -> IdBinding -> Id setIdBinding id !r | isId id = id { idBinding = r } | otherwise = pprPanic "setIdBinding" (ppr id <+> ppr r) ===================================== compiler/Language/Haskell/Syntax/Expr.hs ===================================== @@ -45,6 +45,8 @@ import Data.Maybe import Data.List.NonEmpty ( NonEmpty ) import GHC.Types.Name.Reader +import GHC.Stack (HasCallStack) + {- Note [RecordDotSyntax field updates] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The extensions @OverloadedRecordDot@ @OverloadedRecordUpdate@ together @@ -427,7 +429,7 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn' -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - | HsLet (XLet p) + | HasCallStack => HsLet (XLet p) !(LHsToken "let" p) (HsLocalBinds p) !(LHsToken "in" p) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c834d7adef595dab79b8dfc3b2e1e4c43c57a9c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c834d7adef595dab79b8dfc3b2e1e4c43c57a9c8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 17:49:28 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 25 May 2023 13:49:28 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/one-shot Message-ID: <646f9fa81417d_64cfb16604f94407984@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/one-shot at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/one-shot You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 18:01:45 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 25 May 2023 14:01:45 -0400 Subject: [Git][ghc/ghc][wip/one-shot] Use the one-shot trick for UM and RewriteM functors Message-ID: <646fa28962245_64cfb161563f8414096@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/one-shot at Glasgow Haskell Compiler / GHC Commits: 8b16101f by Krzysztof Gogolewski at 2023-05-25T20:01:36+02:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2 changed files: - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/Rewrite.hs Changes: ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1430,13 +1430,16 @@ data UMState = UMState newtype UM a = UM' { unUM :: UMState -> UnifyResultM (UMState, a) } -- See Note [The one-shot state monad trick] in GHC.Utils.Monad - deriving (Functor) pattern UM :: (UMState -> UnifyResultM (UMState, a)) -> UM a -- See Note [The one-shot state monad trick] in GHC.Utils.Monad pattern UM m <- UM' m where UM m = UM' (oneShot m) +{-# COMPLETE UM #-} + +instance Functor UM where + fmap f (UM m) = UM (\s -> fmap (\(s', v) -> (s', f v)) (m s)) instance Applicative UM where pure a = UM (\s -> pure (s, a)) ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -56,7 +56,6 @@ import qualified GHC.Data.List.Infinite as Inf -- | The 'RewriteM' monad is a wrapper around 'TcS' with a 'RewriteEnv' newtype RewriteM a = RewriteM { runRewriteM :: RewriteEnv -> TcS a } - deriving (Functor) -- | Smart constructor for 'RewriteM', as describe in Note [The one-shot state -- monad trick] in "GHC.Utils.Monad". @@ -73,6 +72,9 @@ instance Applicative RewriteM where pure x = mkRewriteM $ \_ -> pure x (<*>) = ap +instance Functor RewriteM where + fmap f (RewriteM x) = mkRewriteM $ \env -> fmap f (x env) + instance HasDynFlags RewriteM where getDynFlags = liftTcS getDynFlags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b16101fe5d045b1e2406f277150a2e247e94827 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b16101fe5d045b1e2406f277150a2e247e94827 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 18:35:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 May 2023 14:35:35 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Migrate errors in GHC.Rename.Splice GHC.Rename.Pat Message-ID: <646faa776f0bf_64cfb15a9e9fc4189d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - 30 changed files: - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types.hs-boot - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/parser/should_fail/T12446.stderr - testsuite/tests/parser/should_fail/T18251c.stderr - testsuite/tests/parser/should_fail/T18251e.stderr - testsuite/tests/quotes/TH_double_splice.stderr - testsuite/tests/quotes/TH_top_splice.stderr - testsuite/tests/quotes/TTH_top_splice.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr - testsuite/tests/showIface/should_fail/THPutDocExternal.stderr - testsuite/tests/th/T12411.stderr - testsuite/tests/th/T16133.stderr - testsuite/tests/th/T16976z.stderr - + testsuite/tests/th/TH_NestedSplicesFail1.hs - + testsuite/tests/th/TH_NestedSplicesFail1.stderr - + testsuite/tests/th/TH_NestedSplicesFail2.hs - + testsuite/tests/th/TH_NestedSplicesFail2.stderr - + testsuite/tests/th/TH_NestedSplicesFail3.hs - + testsuite/tests/th/TH_NestedSplicesFail3.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/182df90e4d1f652c3d078294921805b9b982671b...56abe494fac648a97b06f30b6855901291bed8bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/182df90e4d1f652c3d078294921805b9b982671b...56abe494fac648a97b06f30b6855901291bed8bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 18:36:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 May 2023 14:36:16 -0400 Subject: [Git][ghc/ghc][master] Enable ghci tests for unboxed tuples Message-ID: <646faaa0258a8_64cfb157d135042242e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - 3 changed files: - testsuite/tests/primops/should_run/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/unboxedsums/all.T Changes: ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -1,9 +1,8 @@ test('T6135', normal, compile_and_run, ['']) test('T7689', normal, compile_and_run, ['']) -# These tests are using unboxed tuples, so omit ghci -test('T9430', omit_ways(['ghci']), compile_and_run, ['']) +test('T9430', normal, compile_and_run, ['']) test('T4442', - [omit_ways(['ghci']), when(wordsize(32), expect_broken(15184))], + [when(wordsize(32), expect_broken(15184))], compile_and_run, ['']) test('T10481', exit_code(1), compile_and_run, ['']) test('T10678', @@ -18,13 +17,12 @@ test('T16164', normal, compile_and_run, ['']) test('ShowPrim', normal, compile_and_run, ['']) test('T12492', normal, compile_and_run, ['']) -# These tests use unboxed tuples, which GHCi doesn't support -test('ArithInt8', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord8', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithInt16', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord16', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithInt32', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord32', omit_ways(['ghci']), compile_and_run, ['']) +test('ArithInt8', normal, compile_and_run, ['']) +test('ArithWord8', normal, compile_and_run, ['']) +test('ArithInt16', normal, compile_and_run, ['']) +test('ArithWord16', normal, compile_and_run, ['']) +test('ArithInt32', normal, compile_and_run, ['']) +test('ArithWord32', normal, compile_and_run, ['']) test('CmpInt8', normal, compile_and_run, ['']) test('CmpWord8', normal, compile_and_run, ['']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -122,11 +122,9 @@ test('TypeRep', normal, compile_and_run, ['']) test('T11120', normal, compile_and_run, ['']) test('KindInvariant', normal, ghci_script, ['KindInvariant.script']) -# We omit the ghci way in these 3 tests because they use -# unboxed sums and ghci does not support those yet. -test('StrictPats', omit_ways(['ghci']), compile_and_run, ['']) -test('T12809', omit_ways(['ghci']), compile_and_run, ['']) -test('EtaExpandLevPoly', [omit_ways(['ghci'])], compile_and_run, ['']) +test('StrictPats', normal, compile_and_run, ['']) +test('T12809', normal, compile_and_run, ['']) +test('EtaExpandLevPoly', normal, compile_and_run, ['']) test('TestTypeableBinary', normal, compile_and_run, ['']) test('Typeable1', normal, compile_fail, ['-Werror']) ===================================== testsuite/tests/unboxedsums/all.T ===================================== @@ -3,29 +3,29 @@ test('unboxedsums_unit_tests', compile_and_run, ['-package ghc']) -test('unarise', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums1', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums2', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums3', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums4', omit_ways(['ghci']), compile_fail, ['']) -test('unboxedsums5', omit_ways(['ghci']), compile, ['']) -test('unboxedsums6', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums7', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums8', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums9', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums10', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums11', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums12', omit_ways(['ghci']), compile, ['']) +test('unarise', normal, compile_and_run, ['']) +test('unboxedsums1', normal, compile_and_run, ['']) +test('unboxedsums2', omit_ways(['ghci']), compile_and_run, ['']) # broken on ghci because of #23412 +test('unboxedsums3', normal, compile_and_run, ['']) +test('unboxedsums4', normal, compile_fail, ['']) +test('unboxedsums5', normal, compile, ['']) +test('unboxedsums6', normal, compile_and_run, ['']) +test('unboxedsums7', normal, compile_and_run, ['']) +test('unboxedsums8', normal, compile_and_run, ['']) +test('unboxedsums9', normal, compile_and_run, ['']) +test('unboxedsums10', normal, compile_and_run, ['']) +test('unboxedsums11', normal, compile_and_run, ['']) +test('unboxedsums12', normal, compile, ['']) -test('UnboxedSumsTH', [req_th,omit_ways(['ghci'])], compile, ['']) -test('UnboxedSumsTH_Fail', [req_th,omit_ways(['ghci'])], compile_fail, ['']) +test('UnboxedSumsTH', [req_th], compile, ['']) +test('UnboxedSumsTH_Fail', [req_th], compile_fail, ['']) test('ffi1', normal, compile_fail, ['']) test('thunk', only_ways(['normal']), compile_and_run, ['']) test('T12375', only_ways(['normal']), compile_and_run, ['']) test('empty_sum', only_ways(['normal']), compile_and_run, ['']) test('sum_rr', normal, compile, ['']) -test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) +test('T12711', normal, ghci_script, ['T12711.script']) test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns']) test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a487ba9e55b9c6a131a781985d624f23c5d90867 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a487ba9e55b9c6a131a781985d624f23c5d90867 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 19:07:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 May 2023 15:07:20 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Enable ghci tests for unboxed tuples Message-ID: <646fb1e835714_64cfb24040ba44267e0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - 54e0f20f by Matthew Pickering at 2023-05-25T15:07:06-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - 1882aed5 by sheaf at 2023-05-25T15:07:12-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - 10 changed files: - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/Tc/Gen/Expr.hs - hadrian/src/Flavour.hs - + testsuite/tests/pmcheck/should_compile/T23445.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/primops/should_run/all.T - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/unboxedsums/all.T Changes: ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -218,7 +218,7 @@ mkMatchGroup :: AnnoBody p body -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p))) mkMatchGroup origin matches = MG { mg_ext = origin - , mg_alts = matches } + , mg_alts = matches } mkLamCaseMatchGroup :: AnnoBody p body => Origin ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Hs.Syn.Type import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad import GHC.HsToCore.Pmc -import GHC.HsToCore.Pmc.Types ( Nablas, initNablas ) +import GHC.HsToCore.Pmc.Types ( Nablas ) import GHC.HsToCore.Monad import GHC.HsToCore.Binds import GHC.HsToCore.GuardedRHSs @@ -783,16 +783,24 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- Pattern match check warnings for /this match-group/. -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. -- Each Match will split off one Nablas for its RHSs from this. - ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt + ; matches_nablas <- + if isMatchContextPmChecked dflags origin ctxt + + -- See Note [Long-distance information] in GHC.HsToCore.Pmc then addHsScrutTmCs (concat scrs) new_vars $ - -- See Note [Long-distance information] pmcMatches (DsMatchContext ctxt locn) new_vars matches - else pure (initNablasMatches matches) + + -- When we're not doing PM checks on the match group, + -- we still need to propagate long-distance information. + -- See Note [Long-distance information in matchWrapper] + else do { ldi_nablas <- getLdiNablas + ; pure $ initNablasMatches ldi_nablas matches } ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas - ; result_expr <- handleWarnings $ + ; result_expr <- discard_warnings_if_generated origin $ matchEquations ctxt new_vars eqns_info rhs_ty + ; return (new_vars, result_expr) } where -- Called once per equation in the match, or alternative in the case @@ -810,19 +818,67 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches , eqn_orig = FromSource , eqn_rhs = match_result } } - handleWarnings = if isGenerated origin - then discardWarningsDs - else id + discard_warnings_if_generated orig = + if isGenerated orig + then discardWarningsDs + else id + + initNablasMatches :: Nablas -> [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] + initNablasMatches ldi_nablas ms + = map (\(L _ m) -> (ldi_nablas, initNablasGRHSs ldi_nablas (m_grhss m))) ms + + initNablasGRHSs :: Nablas -> GRHSs GhcTc b -> NonEmpty Nablas + initNablasGRHSs ldi_nablas m + = expectJust "GRHSs non-empty" + $ NEL.nonEmpty + $ replicate (length (grhssGRHSs m)) ldi_nablas + +{- Note [Long-distance information in matchWrapper] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The pattern match checking in matchWrapper is done conditionally, depending +on isMatchContextPmChecked. This means that we don't perform pattern match +checking on e.g. generated pattern matches. + +However, when we skip pattern match checking, we still need to keep track +of long-distance information in case we need it in a nested context. + +This came up in #23445. For example: - initNablasMatches :: [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] - initNablasMatches ms - = map (\(L _ m) -> (initNablas, initNablasGRHSs (m_grhss m))) ms + data GADT a where + IsUnit :: GADT () - initNablasGRHSs :: GRHSs GhcTc b -> NonEmpty Nablas - initNablasGRHSs m = expectJust "GRHSs non-empty" - $ NEL.nonEmpty - $ replicate (length (grhssGRHSs m)) initNablas + data Foo b where + FooUnit :: Foo () + FooInt :: Foo Int + data SomeRec = SomeRec { fld :: () } + + bug :: GADT a -> Foo a -> SomeRec -> SomeRec + bug IsUnit foo r = + let gen_fld :: () + gen_fld = case foo of { FooUnit -> () } + in case r of { SomeRec _ -> SomeRec gen_fld } + +Here the body of 'bug' was generated by 'desugarRecordUpd' from the user-written +record update + + cd { fld = case foo of { FooUnit -> () } } + +As a result, we have a generated FunBind gen_fld whose RHS + + case foo of { FooUnit -> () } + +is user-written. This all happens after the GADT pattern match on IsUnit, +which brings into scope the Given equality [G] a ~ (). We need to make sure +that this long distance information is visible when pattern match checking the +user-written case statement. + +To propagate this long-distance information in 'matchWrapper', when we skip +pattern match checks, we make sure to manually pass the long-distance +information to 'mk_eqn_info', which is responsible for recurring further into +the expression (in this case, it will end up recursively calling 'matchWrapper' +on the user-written case statement). +-} matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -39,7 +39,7 @@ module GHC.HsToCore.Pmc ( isMatchContextPmChecked, -- See Note [Long-distance information] - addTyCs, addCoreScrutTmCs, addHsScrutTmCs + addTyCs, addCoreScrutTmCs, addHsScrutTmCs, getLdiNablas ) where import GHC.Prelude @@ -142,8 +142,8 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- Returns one non-empty 'Nablas' for 1.) each pattern of a 'Match' and 2.) -- each of a 'Match'es 'GRHS' for Note [Long-distance information]. -- --- Special case: When there are /no matches/, then the functionassumes it --- checks and @-XEmptyCase@ with only a single match variable. +-- Special case: When there are /no matches/, then the function assumes it +-- checks an @-XEmptyCase@ with only a single match variable. -- See Note [Checking EmptyCase]. pmcMatches :: DsMatchContext -- ^ Match context, for warnings messages ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1070,7 +1070,7 @@ Wrinkle [GADT result type in tcRecordUpd] -} --- | Desugars a record update @record_expr { fld1 = e1, fld2 = e2}@ into a case expression +-- | Desugars a record update @record_expr { fld1 = e1, fld2 = e2 }@ into a case expression -- that matches on the constructors of the record @r@, as described in -- Note [Record Updates]. -- ===================================== hadrian/src/Flavour.hs ===================================== @@ -145,11 +145,13 @@ enableDebugInfo = addArgs $ notStage0 ? mconcat -- | Enable the ticky-ticky profiler in stage2 GHC enableTickyGhc :: Flavour -> Flavour -enableTickyGhc = - addArgs $ orM [stage1, cross] ? mconcat +enableTickyGhc f = + (addArgs (orM [stage1, cross] ? mconcat [ builder (Ghc CompileHs) ? tickyArgs , builder (Ghc LinkHs) ? tickyArgs - ] + ]) f) { ghcThreaded = (< Stage2) } + -- Build single-threaded ghc because ticky profiling is racy with threaded + -- RTS and the C counters are disabled. (See #23439) tickyArgs :: Args tickyArgs = mconcat ===================================== testsuite/tests/pmcheck/should_compile/T23445.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs #-} + +module T23445 where + +data GADT a where + IsUnit :: GADT () + +data Foo b where + FooUnit :: Foo () + FooInt :: Foo Int + +data SomeRec = SomeRec { fld :: () } + +bug :: GADT a -> Foo a -> SomeRec -> SomeRec +bug IsUnit foo r = + r { fld = case foo of { FooUnit -> () } } ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -112,6 +112,10 @@ test('CaseOfKnownCon', [], compile, [overlapping_incomplete]) test('TooManyDeltas', [], compile, [overlapping_incomplete+'-fmax-pmcheck-models=0']) test('LongDistanceInfo', [], compile, [overlapping_incomplete]) test('T21662', [], compile, [overlapping_incomplete]) +test('T19271', [], compile, [overlapping_incomplete]) +test('T21761', [], compile, [overlapping_incomplete]) +test('T22964', [], compile, [overlapping_incomplete]) +test('T23445', [], compile, [overlapping_incomplete]) # Series (inspired) by Luke Maranget @@ -156,6 +160,4 @@ test('EmptyCase007', [], compile, [overlapping_incomplete]) test('EmptyCase008', [], compile, [overlapping_incomplete]) test('EmptyCase009', [], compile, [overlapping_incomplete]) test('EmptyCase010', [], compile, [overlapping_incomplete]) -test('T19271', [], compile, [overlapping_incomplete]) -test('T21761', [], compile, [overlapping_incomplete]) -test('T22964', [], compile, [overlapping_incomplete]) + ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -1,9 +1,8 @@ test('T6135', normal, compile_and_run, ['']) test('T7689', normal, compile_and_run, ['']) -# These tests are using unboxed tuples, so omit ghci -test('T9430', omit_ways(['ghci']), compile_and_run, ['']) +test('T9430', normal, compile_and_run, ['']) test('T4442', - [omit_ways(['ghci']), when(wordsize(32), expect_broken(15184))], + [when(wordsize(32), expect_broken(15184))], compile_and_run, ['']) test('T10481', exit_code(1), compile_and_run, ['']) test('T10678', @@ -18,13 +17,12 @@ test('T16164', normal, compile_and_run, ['']) test('ShowPrim', normal, compile_and_run, ['']) test('T12492', normal, compile_and_run, ['']) -# These tests use unboxed tuples, which GHCi doesn't support -test('ArithInt8', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord8', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithInt16', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord16', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithInt32', omit_ways(['ghci']), compile_and_run, ['']) -test('ArithWord32', omit_ways(['ghci']), compile_and_run, ['']) +test('ArithInt8', normal, compile_and_run, ['']) +test('ArithWord8', normal, compile_and_run, ['']) +test('ArithInt16', normal, compile_and_run, ['']) +test('ArithWord16', normal, compile_and_run, ['']) +test('ArithInt32', normal, compile_and_run, ['']) +test('ArithWord32', normal, compile_and_run, ['']) test('CmpInt8', normal, compile_and_run, ['']) test('CmpWord8', normal, compile_and_run, ['']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -122,11 +122,9 @@ test('TypeRep', normal, compile_and_run, ['']) test('T11120', normal, compile_and_run, ['']) test('KindInvariant', normal, ghci_script, ['KindInvariant.script']) -# We omit the ghci way in these 3 tests because they use -# unboxed sums and ghci does not support those yet. -test('StrictPats', omit_ways(['ghci']), compile_and_run, ['']) -test('T12809', omit_ways(['ghci']), compile_and_run, ['']) -test('EtaExpandLevPoly', [omit_ways(['ghci'])], compile_and_run, ['']) +test('StrictPats', normal, compile_and_run, ['']) +test('T12809', normal, compile_and_run, ['']) +test('EtaExpandLevPoly', normal, compile_and_run, ['']) test('TestTypeableBinary', normal, compile_and_run, ['']) test('Typeable1', normal, compile_fail, ['-Werror']) ===================================== testsuite/tests/unboxedsums/all.T ===================================== @@ -3,29 +3,29 @@ test('unboxedsums_unit_tests', compile_and_run, ['-package ghc']) -test('unarise', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums1', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums2', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums3', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums4', omit_ways(['ghci']), compile_fail, ['']) -test('unboxedsums5', omit_ways(['ghci']), compile, ['']) -test('unboxedsums6', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums7', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums8', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums9', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums10', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums11', omit_ways(['ghci']), compile_and_run, ['']) -test('unboxedsums12', omit_ways(['ghci']), compile, ['']) +test('unarise', normal, compile_and_run, ['']) +test('unboxedsums1', normal, compile_and_run, ['']) +test('unboxedsums2', omit_ways(['ghci']), compile_and_run, ['']) # broken on ghci because of #23412 +test('unboxedsums3', normal, compile_and_run, ['']) +test('unboxedsums4', normal, compile_fail, ['']) +test('unboxedsums5', normal, compile, ['']) +test('unboxedsums6', normal, compile_and_run, ['']) +test('unboxedsums7', normal, compile_and_run, ['']) +test('unboxedsums8', normal, compile_and_run, ['']) +test('unboxedsums9', normal, compile_and_run, ['']) +test('unboxedsums10', normal, compile_and_run, ['']) +test('unboxedsums11', normal, compile_and_run, ['']) +test('unboxedsums12', normal, compile, ['']) -test('UnboxedSumsTH', [req_th,omit_ways(['ghci'])], compile, ['']) -test('UnboxedSumsTH_Fail', [req_th,omit_ways(['ghci'])], compile_fail, ['']) +test('UnboxedSumsTH', [req_th], compile, ['']) +test('UnboxedSumsTH_Fail', [req_th], compile_fail, ['']) test('ffi1', normal, compile_fail, ['']) test('thunk', only_ways(['normal']), compile_and_run, ['']) test('T12375', only_ways(['normal']), compile_and_run, ['']) test('empty_sum', only_ways(['normal']), compile_and_run, ['']) test('sum_rr', normal, compile, ['']) -test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) +test('T12711', normal, ghci_script, ['T12711.script']) test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns']) test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d219c89225b1fc9df0850becde1e879933515250...1882aed59297fd4ae492d577dedfc88eefc5bca8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d219c89225b1fc9df0850becde1e879933515250...1882aed59297fd4ae492d577dedfc88eefc5bca8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 19:17:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 25 May 2023 15:17:43 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] Lam and Let pattern synonyms Message-ID: <646fb457ce69b_64cfb23d79394431927@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 6e5fe8b1 by Rodrigo Mesquita at 2023-05-25T19:59:13+01:00 Lam and Let pattern synonyms For debugging purposes only :) - - - - - 13 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -7,12 +7,12 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE GADTs, StandaloneDeriving #-} +{-# LANGUAGE GADTs, StandaloneDeriving, PatternSynonyms #-} -- | GHC.Core holds all the main data types for use by for the Glasgow Haskell Compiler midsection module GHC.Core ( -- * Main data types - Expr(..), Alt(..), Bind(..), AltCon(..), Arg, + Expr(..,Let,Lam), Alt(..), Bind(..), AltCon(..), Arg, CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr, TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr, @@ -252,8 +252,8 @@ data Expr b = Var Id | Lit Literal | App (Expr b) (Arg b) - | HasCallStack => Lam b (Expr b) - | HasCallStack => Let (Bind b) (Expr b) + | HasCallStack => Lam' b (Expr b) + | HasCallStack => Let' (Bind b) (Expr b) | HasCallStack => Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants] -- and Note [Why does Case have a 'Type' field?] | Cast (Expr b) CoercionR -- The Coercion has Representational role @@ -262,6 +262,30 @@ data Expr b | Coercion Coercion deriving instance Data b => Data (Expr b) + +pattern Lam :: forall b. (HasCallStack, Typeable b) => b -> Expr b -> Expr b +pattern Lam x y <- Lam' x y where + Lam x y + | Just Refl <- eqT @b @Id + , not (isLambdaBinding x) + = pprPanic "pattern Lam!" (pprIdWithBinding x) + | otherwise + = Lam' x y + +pattern Let :: forall b. (HasCallStack, Typeable b) => Bind b -> Expr b -> Expr b +pattern Let x y <- Let' x y where + Let x y + | Just Refl <- eqT @b @Id + , NonRec z _ <- x + , not (isLetBinding z) + = pprPanic "pattern Let 1!" (pprIdWithBinding z) + | Just Refl <- eqT @b @Id + , Rec zs <- x + , any (not . isLetBinding . fst) zs + = pprPanic "pattern Let 2!" (ppr zs) + | otherwise + = Let' x y + -- | Type synonym for expressions that occur in function argument positions. -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not type Arg b = Expr b @@ -1808,7 +1832,7 @@ type TaggedAlt t = Alt (TaggedBndr t) instance Outputable b => Outputable (TaggedBndr b) where ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>' -deTagExpr :: TaggedExpr t -> CoreExpr +deTagExpr :: Typeable t => TaggedExpr t -> CoreExpr deTagExpr (Var v) = Var v deTagExpr (Lit l) = Lit l deTagExpr (Type ty) = Type ty @@ -1820,11 +1844,11 @@ deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts deTagExpr (Tick t e) = Tick t (deTagExpr e) deTagExpr (Cast e co) = Cast (deTagExpr e) co -deTagBind :: TaggedBind t -> CoreBind +deTagBind :: Typeable t => TaggedBind t -> CoreBind deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs) deTagBind (Rec prs) = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs] -deTagAlt :: TaggedAlt t -> CoreAlt +deTagAlt :: Typeable t => TaggedAlt t -> CoreAlt deTagAlt (Alt con bndrs rhs) = Alt con [b | TB b _ <- bndrs] (deTagExpr rhs) {- @@ -1954,12 +1978,12 @@ mkLet bind body = case (eqT @b @Id) of Just Refl -> if not (isLetBinder bind pprLetBinderId (Rec ls) = hsep $ map (pprIdWithBinding . fst) ls -- | @mkLetNonRec bndr rhs body@ wraps @body@ in a @let@ binding @bndr at . -mkLetNonRec :: b -> Expr b -> Expr b -> Expr b +mkLetNonRec :: Typeable b => b -> Expr b -> Expr b -> Expr b mkLetNonRec b rhs body = Let (NonRec b rhs) body -- | @mkLetRec binds body@ wraps @body@ in a @let rec@ with the given set of -- @binds@ if binds is non-empty. -mkLetRec :: [(b, Expr b)] -> Expr b -> Expr b +mkLetRec :: Typeable b => [(b, Expr b)] -> Expr b -> Expr b mkLetRec [] body = body mkLetRec bs body = Let (Rec bs) body @@ -2056,7 +2080,7 @@ flattenBinds [] = [] -- | We often want to strip off leading lambdas before getting down to -- business. Variants are 'collectTyBinders', 'collectValBinders', -- and 'collectTyAndValBinders' -collectBinders :: Expr b -> ([b], Expr b) +collectBinders :: Typeable b => Expr b -> ([b], Expr b) collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr) collectValBinders :: CoreExpr -> ([Id], CoreExpr) collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr) @@ -2064,7 +2088,7 @@ collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr) -- | Strip off exactly N leading lambdas (type or value). -- Good for use with join points. -- Panic if there aren't enough -collectNBinders :: JoinArity -> Expr b -> ([b], Expr b) +collectNBinders :: Typeable b => JoinArity -> Expr b -> ([b], Expr b) collectBinders expr = go [] expr @@ -2111,7 +2135,7 @@ collectNValBinders_maybe orig_n orig_expr -- | Takes a nested application expression and returns the function -- being applied and the arguments to which it is applied -collectArgs :: Expr b -> (Expr b, [Arg b]) +collectArgs :: Typeable b => Expr b -> (Expr b, [Arg b]) collectArgs expr = go expr [] where @@ -2120,7 +2144,7 @@ collectArgs expr -- | Takes a nested application expression and returns the function -- being applied. Looking through casts and ticks to find it. -collectFunSimple :: Expr b -> Expr b +collectFunSimple :: Typeable b => Expr b -> Expr b collectFunSimple expr = go expr where @@ -2268,10 +2292,10 @@ collectAnnArgsTicks tickishOk expr = go e as (t:ts) go e as ts = (e, as, reverse ts) -deAnnotate :: AnnExpr bndr annot -> Expr bndr +deAnnotate :: Typeable bndr => AnnExpr bndr annot -> Expr bndr deAnnotate (_, e) = deAnnotate' e -deAnnotate' :: AnnExpr' bndr annot -> Expr bndr +deAnnotate' :: Typeable bndr => AnnExpr' bndr annot -> Expr bndr deAnnotate' (AnnType t) = Type t deAnnotate' (AnnCoercion co) = Coercion co deAnnotate' (AnnVar v) = Var v @@ -2286,15 +2310,15 @@ deAnnotate' (AnnLet bind body) deAnnotate' (AnnCase scrut v t alts) = Case (deAnnotate scrut) v t (map deAnnAlt alts) -deAnnAlt :: AnnAlt bndr annot -> Alt bndr +deAnnAlt :: Typeable bndr => AnnAlt bndr annot -> Alt bndr deAnnAlt (AnnAlt con args rhs) = Alt con args (deAnnotate rhs) -deAnnBind :: AnnBind b annot -> Bind b +deAnnBind :: Typeable b => AnnBind b annot -> Bind b deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs) deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs] -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr' -collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot) +collectAnnBndrs :: Typeable bndr => AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot) collectAnnBndrs e = collect [] e where ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1738,7 +1738,8 @@ lintIdBndr top_lvl bind_site id thing_inside matchesBindingSite :: IdBinding -> BindingSite -> Bool matchesBindingSite (LetBound _) LetBind = True matchesBindingSite (LambdaBound _) LambdaBind = True - -- ROMES:TODO: Other binding sites! + matchesBindingSite (LambdaBound _) CaseBind = True + matchesBindingSite (LambdaBound _) CasePatBind = True matchesBindingSite _ _ = False {- ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -531,7 +531,7 @@ unwrapBox us var body BI_Box { bi_data_con = box_con, bi_boxed_type = box_ty } -> (us', var', body') where - var' = mkSysLocal (fsLit "uc") uniq (LambdaBound ManyTy) box_ty -- ROMES:TODO: LambdaBound here? + var' = mkSysLocal (fsLit "uc") uniq (LambdaBound ManyTy) box_ty -- ROMES:TODO: LambdaBound since its put in case binder body' = Case (Var var') var' (exprType body) [Alt (DataAlt box_con) [var] body] where ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -265,7 +265,7 @@ mkExitJoinId in_scope ty join_arity = do `extendInScopeSet` exit_id_tmpl -- just cosmetics return (uniqAway avoid exit_id_tmpl) where - exit_id_tmpl = mkSysLocal (fsLit "exit") initExitJoinUnique (LambdaBound ManyTy) ty -- ROMES:TODO: LambdaBound here for ExitJoinId?? + exit_id_tmpl = mkSysLocal (fsLit "exit") initExitJoinUnique (LetBound zeroUE) ty `asJoinId` join_arity addExit :: InScopeSet -> JoinArity -> CoreExpr -> ExitifyM JoinId ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -1751,7 +1751,7 @@ newLvlVar lvld_rhs join_arity_maybe is_mk_static = mkExportedVanillaId (mkSystemVarName uniq (mkFastString "static_ptr")) rhs_ty | otherwise - = mkSysLocal (mkFastString "lvl") uniq (LambdaBound ManyTy) rhs_ty -- ROMES:TODO: What's the IdBinding + = mkSysLocal (mkFastString "lvl") uniq (LetBound zeroUE) rhs_ty -- | Clone the binders bound by a single-alternative case. cloneCaseBndrs :: LevelEnv -> Level -> [Var] -> LvlM (LevelEnv, [Var]) ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -4,7 +4,7 @@ \section[GHC.Core.Opt.Simplify.Monad]{The simplifier Monad} -} - +{-# LANGUAGE ExistentialQuantification #-} module GHC.Core.Opt.Simplify.Env ( -- * The simplifier mode @@ -812,7 +812,7 @@ addJoinFloats floats join_floats , sfInScope = foldlOL extendInScopeSetBind (sfInScope floats) join_floats } -addFloats :: SimplFloats -> SimplFloats -> SimplFloats +addFloats :: HasCallStack => SimplFloats -> SimplFloats -> SimplFloats -- Add both let-floats and join-floats for env2 to env1; -- *plus* the in-scope set for env2, which is bigger -- than that for env1 @@ -849,7 +849,7 @@ mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff !jfloats' | isNilOL jbs = emptyJoinFloats | otherwise = unitJoinFloat (Rec (flattenBinds (fromOL jbs))) -wrapFloats :: SimplFloats -> OutExpr -> OutExpr +wrapFloats :: HasCallStack => SimplFloats -> OutExpr -> OutExpr -- Wrap the floats around the expression wrapFloats (SimplFloats { sfLetFloats = LetFloats bs flag , sfJoinFloats = jbs }) body @@ -867,7 +867,7 @@ wrapJoinFloatsX floats body = ( floats { sfJoinFloats = emptyJoinFloats } , wrapJoinFloats (sfJoinFloats floats) body ) -wrapJoinFloats :: JoinFloats -> OutExpr -> OutExpr +wrapJoinFloats :: HasCallStack => JoinFloats -> OutExpr -> OutExpr -- Wrap the sfJoinFloats of the env around the expression, -- and take them out of the SimplEnv wrapJoinFloats join_floats body ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2249,7 +2249,8 @@ rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) ; return (Lam s' body') } -- Important: do not try to eta-expand this lambda -- See Note [No eta-expansion in runRW#] - _ -> do { s' <- newId (fsLit "s") (LambdaBound ManyTy) realWorldStatePrimTy +-- ROMES:TODO: + _ -> do { s' <- newId (fsLit "s") (LambdaBound OneTy) realWorldStatePrimTy ; let (m,_,_) = splitFunTy fun_ty env' = arg_env `addNewInScopeIds` [s'] cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s' ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Core.TyCon (TyCon, tyConName ) import GHC.Core.Multiplicity import GHC.Core.Ppr ( pprParendExpr ) import GHC.Core.Make ( mkImpossibleExpr ) +import GHC.Types.Var (pprIdWithBinding, isLetBinding, isLambdaBinding, zeroUE) import GHC.Unit.Module import GHC.Unit.Module.ModGuts @@ -1484,11 +1485,22 @@ scExpr' env (Cast e co) = do (usg, e') <- scExpr env e -- Important to use mkCast here -- See Note [SpecConstr call patterns] scExpr' env e@(App _ _) = scApp env (collectArgs e) -scExpr' env (Lam b e) = do let (env', b') = extendBndr env b - (usg, e') <- scExpr env' e - return (usg, Lam b' e') +scExpr' env (Lam b e) + | not (isLambdaBinding b) + = pprPanic "scExpr':Lam" (pprIdWithBinding b) + | otherwise + = do let (env', b') = extendBndr env b + (usg, e') <- scExpr env' e + return (usg, Lam b' e') scExpr' env (Let bind body) + | NonRec b _ <- bind + , not (isLetBinding b) + = pprPanic "scExpr':Let:NonRec" (pprIdWithBinding b) + | Rec bs <- bind + , any (not . isLetBinding . fst) bs + = pprPanic "scExpr':Let:Rec" (ppr bs) + | otherwise = do { (final_usage, binds', body') <- scBind NotTopLevel env bind $ (\env -> scExpr env body) ; return (final_usage, mkLets binds' body') } @@ -1606,6 +1618,8 @@ scApp env (Var fn, args) -- Function is a variable where doBeta :: OutExpr -> [OutExpr] -> OutExpr doBeta (Lam bndr body) (arg : args) = Let (NonRec bndr arg) (doBeta body args) + where bndr' | isId bndr = bndr `setIdBinding` LetBound zeroUE + | otherwise = bndr doBeta fn args = mkApps fn args -- The function is almost always a variable, but not always. ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -65,6 +65,7 @@ module GHC.Core.Utils ( dumpIdInfoOfProgram ) where +import Data.Typeable (Typeable) import GHC.Prelude import GHC.Platform @@ -453,7 +454,7 @@ stripTicksTopT p = go [] -- | Completely strip ticks satisfying a predicate from an -- expression. Note this is O(n) in the size of the expression! -stripTicksE :: (CoreTickish -> Bool) -> Expr b -> Expr b +stripTicksE :: Typeable b => (CoreTickish -> Bool) -> Expr b -> Expr b stripTicksE p expr = go expr where go (App e a) = App (go e) (go a) go (Lam b e) = Lam b (go e) @@ -469,7 +470,7 @@ stripTicksE p expr = go expr go_b (b, e) = (b, go e) go_a (Alt c bs e) = Alt c bs (go e) -stripTicksT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish] +stripTicksT :: Typeable b => (CoreTickish -> Bool) -> Expr b -> [CoreTickish] stripTicksT p expr = fromOL $ go expr where go (App e a) = go e `appOL` go a go (Lam _ e) = go e ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -58,7 +58,6 @@ import GHC.Core.Make import GHC.Core.Rules import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Core.Ppr -import GHC.Core.UsageEnv ( zeroUE ) import GHC.Builtin.Names import GHC.Builtin.Types.Prim ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -45,7 +45,6 @@ import GHC.Tc.TyCl.Build( TcMethInfo ) import GHC.Core.Type ( extendTvSubstWithClone, piResultTys ) import GHC.Core.Predicate -import GHC.Core.UsageEnv (zeroUE) import GHC.Core.Class import GHC.Core.Coercion ( pprCoAxiom ) import GHC.Core.FamInstEnv ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -43,7 +43,6 @@ import GHC.Tc.Types.Origin import GHC.Tc.TyCl.Build import GHC.Tc.Utils.Instantiate import GHC.Tc.Instance.Class( AssocInstInfo(..), isNotAssociated ) -import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv @@ -59,7 +58,6 @@ import GHC.Core.Type import GHC.Core.SimpleOpt import GHC.Core.Predicate( classMethodInstTy ) import GHC.Tc.Types.Evidence -import GHC.Core.UsageEnv (zeroUE) import GHC.Core.TyCon import GHC.Core.Coercion.Axiom import GHC.Core.DataCon @@ -1477,7 +1475,7 @@ tcSuperClasses skol_info dfun_id cls tyvars dfun_evs dfun_ev_binds sc_theta ; sc_ev_id <- newEvVar sc_pred ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id IsCoherent sc_ev_tm ; let sc_top_ty = tcMkDFunSigmaTy tyvars (map idType dfun_evs) sc_pred - sc_top_id = mkLocalId sc_top_name (LambdaBound ManyTy) sc_top_ty -- ROMES:TODO: + sc_top_id = mkLocalId sc_top_name (LetBound zeroUE) sc_top_ty export = ABE { abe_wrap = idHsWrapper , abe_poly = sc_top_id , abe_mono = sc_ev_id @@ -2043,7 +2041,7 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind ; let ctxt = FunSigCtxt sel_name (lhsSigTypeContextSpan hs_sig_ty) -- WantRCC <=> check for redundant constraints in the -- user-specified instance signature - inner_meth_id = mkLocalId inner_meth_name (LambdaBound ManyTy) sig_ty -- ROMES:TODO: + inner_meth_id = mkLocalId inner_meth_name (LetBound zeroUE) sig_ty inner_meth_sig = CompleteSig { sig_bndr = inner_meth_id , sig_ctxt = ctxt , sig_loc = getLocA hs_sig_ty } ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -59,7 +59,7 @@ module GHC.Types.Var ( setIdExported, setIdNotExported, setIdBinding, updateIdTypeButNotMults, updateIdTypeAndMults, updateIdTypeAndMultsM, - IdBinding(..), idBinding, pprIdWithBinding, + IdBinding(..), idBinding, pprIdWithBinding, zeroUE, -- ** Predicates isId, isTyVar, isTcTyVar, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e5fe8b1bbb404792b2f25554fe78232930ef43f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e5fe8b1bbb404792b2f25554fe78232930ef43f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 19:44:17 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 25 May 2023 15:44:17 -0400 Subject: [Git][ghc/ghc][wip/t21766] 192 commits: JS: fix thread-related primops Message-ID: <646fba9184b65_64cfb23d793944331b9@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - 60317bcb by Finley McIlwaine at 2023-05-25T13:40:36-06:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 2bd8ab36 by Finley McIlwaine at 2023-05-25T13:42:22-06:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 30904e96 by Finley McIlwaine at 2023-05-25T13:43:25-06:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - edf2ef30 by Finley McIlwaine at 2023-05-25T13:43:32-06:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 083f1a1b by Finley McIlwaine at 2023-05-25T13:43:32-06:00 Add note describing IPE data compression See ticket #21766 - - - - - 7616cf8f by Finley McIlwaine at 2023-05-25T13:43:32-06:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 6f588fb8 by Finley McIlwaine at 2023-05-25T13:43:32-06:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 7d34d351 by Finley McIlwaine at 2023-05-25T13:43:32-06:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 0793beea by Finley McIlwaine at 2023-05-25T13:43:32-06:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - f2b76b9c by Finley McIlwaine at 2023-05-25T13:43:59-06:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab0fe323b235236798e6c2fd37b5ab409e0029ff...f2b76b9c6faba11f99197c0908d7f557a1136485 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab0fe323b235236798e6c2fd37b5ab409e0029ff...f2b76b9c6faba11f99197c0908d7f557a1136485 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 20:07:18 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 25 May 2023 16:07:18 -0400 Subject: [Git][ghc/ghc][wip/expand-do] imporving error messages for applicative do Message-ID: <646fbff674f55_64cfb24040b9043699e@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: f8b82fcd by Apoorv Ingle at 2023-05-25T15:07:08-05:00 imporving error messages for applicative do - - - - - 4 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -488,6 +488,12 @@ mkExpandedStmt -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedStmt a b = XExpr (ExpandedStmt (HsExpanded a b)) +mkExpandedStmtLExpr + :: ExprLStmt GhcRn -- ^ source statement + -> LHsExpr GhcRn -- ^ expanded expression + -> LHsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +mkExpandedStmtLExpr a b = noLocA $ mkExpandedStmt a b + data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions {-# UNPACK #-} !(HsWrap HsExpr) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -864,6 +864,8 @@ warnUnusedBindValue fun arg@(L loc _) arg_ty , text "loc" <+> ppr l , text "locGen?" <+> ppr (isGeneratedSrcSpan l) , text "noLoc?" <+> ppr (isNoSrcSpan l) + , text "arg" <+> ppr arg + , text "arg_loc" <+> ppr loc ]) putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty where ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -412,7 +412,8 @@ tcExpr (HsMultiIf _ alts) res_ty tcExpr (XExpr (PopSrcSpan expr)) res_ty = popErrCtxt $ tcExpr (unLoc expr) res_ty tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty - = do { traceTc "tcDoStmts stmt" (ppr expr) + = do { traceTc "tcDoStmts" (vcat [text "stmt" <+> ppr stmt + ,text "expr" <+> ppr expr]) ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ tcExpr (unLoc expr) res_ty } @@ -421,20 +422,16 @@ tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) - ; traceTc "tcDoStmts doExpr" (vcat [ text "original:" <+> ppr expanded_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; addErrCtxt (text "In the" <+> matchDoContextErrString doFlav) $ popErrCtxt $ tcExpr expanded_do_expr res_ty + ; traceTc "tcDoStmts doExpr" (ppr expanded_do_expr) + ; tcExpr expanded_do_expr res_ty } tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) - ; traceTc "tcDoStmts mDoExpr" (vcat [ text "original:" <+> ppr expanded_do_expr - , text "expanded:" <+> ppr expand_expr - ]) - ; addErrCtxt (text "In the" <+> matchDoContextErrString doFlav) $ popErrCtxt $ tcExpr expanded_do_expr res_ty + ; traceTc "tcDoStmts mDoExpr" (ppr expanded_do_expr) + ; tcExpr expanded_do_expr res_ty } tcExpr (HsDo _ do_or_lc stmts) res_ty ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1189,21 +1189,30 @@ expandDoStmts = expand_do_stmts -- ANI Questions: 1. What should be the location information in the expanded expression? -- Currently the error is displayed on the expanded expr and not on the unexpanded expr expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) + expand_do_stmts ListComp _ = pprPanic "expand_do_stmts: impossible happened. ListComp" empty + expand_do_stmts _ [] = pprPanic "expand_do_stmts: impossible happened. Empty stmts" empty +expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = + pprPanic "expand_do_stmts: TransStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = +-- See See Note [Monad Comprehensions] + pprPanic "expand_do_stmts: ParStmt" $ ppr stmt + expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return (noLocA (mkExpandedStmt stmt (genPopSrcSpanExpr body))) + = return (mkExpandedStmtLExpr stmt (genPopSrcSpanExpr body)) | SyntaxExprRn ret <- ret_expr -- -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ genPopSrcSpanExpr (noLocA (mkExpandedStmt stmt (genPopSrcSpanExpr (L loc $ genHsApp ret body)))) + = return $ genPopSrcSpanExpr (mkExpandedStmtLExpr stmt (genPopSrcSpanExpr (L loc (genHsApp ret body)))) expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) @@ -1217,11 +1226,11 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ noLocA (mkExpandedStmt stmt + return $ mkExpandedStmtLExpr stmt (mkHsApps (wrapGenSpan bind_op) -- (>>=) [ genPopSrcSpanExpr e , genPopSrcSpanExpr expr - ])) + ]) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) @@ -1230,10 +1239,10 @@ expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bnds)) : lstmts) = -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ noLocA (mkExpandedStmt stmt + return $ mkExpandedStmtLExpr stmt (wrapGenSpan (HsLet noExtField noHsTok bnds - noHsTok (genPopSrcSpanExpr expand_stmts)))) + noHsTok (genPopSrcSpanExpr expand_stmts))) expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = @@ -1242,10 +1251,10 @@ expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ noLocA (mkExpandedStmt stmt + return $ mkExpandedStmtLExpr stmt (mkHsApps (wrapGenSpan f) -- (>>) [ genPopSrcSpanExpr e -- e - , genPopSrcSpanExpr expand_stmts ])) -- stmts' + , genPopSrcSpanExpr expand_stmts ]) -- stmts' expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts @@ -1290,12 +1299,12 @@ expand_do_stmts do_or_lc -- LazyPat becuase we do not want to eagerly evaluate the pattern -- and potentially loop forever -expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = +expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = -- See Note [Applicative BodyStmt] -- -- stmts ~~> stmts' -- ------------------------------------------------------------------------- --- [(<$>, e1), (<*>, e2)] ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... +-- [(<$>, \ x -> e1), (<*>, e2)] ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... -- -- Very similar to HsToCore.Expr.dsDo @@ -1308,13 +1317,15 @@ expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = ; body_with_fails <- foldrM match_args expr' pats_can_fail -- builds (body <$> e1 <*> e2 ...) - ; let expand_ado_expr = foldl mk_apps body_with_fails (zip (map fst args) rhss) + ; let expand_ado_expr = genPopSrcSpanExpr $ foldl mk_apps body_with_fails (zip (map fst args) rhss) -- wrap the expanded expression with a `join` if needed ; case mb_join of - Nothing -> return expand_ado_expr - Just NoSyntaxExprRn -> return expand_ado_expr -- why can this happen? - Just (SyntaxExprRn join_op) -> return $ mkHsApp (noLocA join_op) expand_ado_expr + Nothing -> return $ mkExpandedStmtLExpr stmt expand_ado_expr + Just NoSyntaxExprRn -> return $ mkExpandedStmtLExpr stmt expand_ado_expr -- why can this happen? + Just (SyntaxExprRn join_op) -> + return $ mkExpandedStmtLExpr stmt + ( mkHsApp (wrapGenSpan join_op) expand_ado_expr) } where do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) @@ -1325,21 +1336,13 @@ expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = ; return ((pat, Nothing), expr) } match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) - match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op + match_args (pat, fail_op) body = genPopSrcSpanExpr <$> mk_failable_lexpr_tcm pat body fail_op - mk_apps l (op, r) = + mk_apps l_expr (op, r_expr) = case op of - SyntaxExprRn op -> mkHsApps (noLocA op) [l, r] + SyntaxExprRn op -> mkHsApps (wrapGenSpan op) [genPopSrcSpanExpr l_expr, genPopSrcSpanExpr r_expr] NoSyntaxExprRn -> pprPanic "expand_do_stmts op:" (ppr op) -expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = - pprPanic "expand_do_stmts: TransStmt" $ ppr stmt - -expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = --- See See Note [Monad Comprehensions] - - pprPanic "expand_do_stmts: ParStmt" $ ppr stmt - expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) @@ -1413,4 +1416,27 @@ The points to consider are: TODO expand using examples + +Applicative Do Expansion + +Consider (ado/ado003.hs) + +g :: IO () +g = do + x <- getChar + 'a' <- return (3::Int) -- type error + return () + +this gets expanded to + +g = join ((<*>) (fmap (\ x -> / 'a' -> return ()) + getChar + (return 3::Int) )) + + + +join (<*>) (\ x -> \ 'a' -> return () + \ _ -> fail ..) + getChar + return (3 :: Int) -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8b82fcd1896998c3c5c63f34f67885dca0e6cc2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8b82fcd1896998c3c5c63f34f67885dca0e6cc2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 20:19:12 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 25 May 2023 16:19:12 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] 2 commits: More progress Message-ID: <646fc2c01358d_64cfb238fab604382c6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 80e60a99 by Rodrigo Mesquita at 2023-05-25T21:18:57+01:00 More progress - - - - - c0467125 by Rodrigo Mesquita at 2023-05-25T21:18:57+01:00 Lam and Let pattern synonyms For debugging purposes only :) - - - - - 13 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -7,12 +7,12 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE GADTs, StandaloneDeriving #-} +{-# LANGUAGE GADTs, StandaloneDeriving, PatternSynonyms #-} -- | GHC.Core holds all the main data types for use by for the Glasgow Haskell Compiler midsection module GHC.Core ( -- * Main data types - Expr(..), Alt(..), Bind(..), AltCon(..), Arg, + Expr(..,Let,Lam), Alt(..), Bind(..), AltCon(..), Arg, CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr, TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr, @@ -252,8 +252,8 @@ data Expr b = Var Id | Lit Literal | App (Expr b) (Arg b) - | HasCallStack => Lam b (Expr b) - | HasCallStack => Let (Bind b) (Expr b) + | HasCallStack => Lam' b (Expr b) + | HasCallStack => Let' (Bind b) (Expr b) | HasCallStack => Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants] -- and Note [Why does Case have a 'Type' field?] | Cast (Expr b) CoercionR -- The Coercion has Representational role @@ -262,6 +262,31 @@ data Expr b | Coercion Coercion deriving instance Data b => Data (Expr b) +{-# COMPLETE Var, Lit, App, Lam, Let, Case, Cast, Tick, Type, Coercion #-} + +pattern Lam :: forall b. (HasCallStack, Typeable b) => b -> Expr b -> Expr b +pattern Lam x y <- Lam' x y where + Lam x y + | Just Refl <- eqT @b @Id + , not (isLambdaBinding x) + = pprPanic "pattern Lam!" (pprIdWithBinding x) + | otherwise + = Lam' x y + +pattern Let :: forall b. (HasCallStack, Typeable b) => Bind b -> Expr b -> Expr b +pattern Let x y <- Let' x y where + Let x y + | Just Refl <- eqT @b @Id + , NonRec z _ <- x + , not (isLetBinding z) + = pprPanic "pattern Let 1!" (pprIdWithBinding z) + | Just Refl <- eqT @b @Id + , Rec zs <- x + , any (not . isLetBinding . fst) zs + = pprPanic "pattern Let 2!" (ppr zs) + | otherwise + = Let' x y + -- | Type synonym for expressions that occur in function argument positions. -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not type Arg b = Expr b @@ -1808,7 +1833,7 @@ type TaggedAlt t = Alt (TaggedBndr t) instance Outputable b => Outputable (TaggedBndr b) where ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>' -deTagExpr :: TaggedExpr t -> CoreExpr +deTagExpr :: Typeable t => TaggedExpr t -> CoreExpr deTagExpr (Var v) = Var v deTagExpr (Lit l) = Lit l deTagExpr (Type ty) = Type ty @@ -1820,11 +1845,11 @@ deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts deTagExpr (Tick t e) = Tick t (deTagExpr e) deTagExpr (Cast e co) = Cast (deTagExpr e) co -deTagBind :: TaggedBind t -> CoreBind +deTagBind :: Typeable t => TaggedBind t -> CoreBind deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs) deTagBind (Rec prs) = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs] -deTagAlt :: TaggedAlt t -> CoreAlt +deTagAlt :: Typeable t => TaggedAlt t -> CoreAlt deTagAlt (Alt con bndrs rhs) = Alt con [b | TB b _ <- bndrs] (deTagExpr rhs) {- @@ -1954,12 +1979,12 @@ mkLet bind body = case (eqT @b @Id) of Just Refl -> if not (isLetBinder bind pprLetBinderId (Rec ls) = hsep $ map (pprIdWithBinding . fst) ls -- | @mkLetNonRec bndr rhs body@ wraps @body@ in a @let@ binding @bndr at . -mkLetNonRec :: b -> Expr b -> Expr b -> Expr b +mkLetNonRec :: Typeable b => b -> Expr b -> Expr b -> Expr b mkLetNonRec b rhs body = Let (NonRec b rhs) body -- | @mkLetRec binds body@ wraps @body@ in a @let rec@ with the given set of -- @binds@ if binds is non-empty. -mkLetRec :: [(b, Expr b)] -> Expr b -> Expr b +mkLetRec :: Typeable b => [(b, Expr b)] -> Expr b -> Expr b mkLetRec [] body = body mkLetRec bs body = Let (Rec bs) body @@ -2056,7 +2081,7 @@ flattenBinds [] = [] -- | We often want to strip off leading lambdas before getting down to -- business. Variants are 'collectTyBinders', 'collectValBinders', -- and 'collectTyAndValBinders' -collectBinders :: Expr b -> ([b], Expr b) +collectBinders :: Typeable b => Expr b -> ([b], Expr b) collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr) collectValBinders :: CoreExpr -> ([Id], CoreExpr) collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr) @@ -2064,7 +2089,7 @@ collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr) -- | Strip off exactly N leading lambdas (type or value). -- Good for use with join points. -- Panic if there aren't enough -collectNBinders :: JoinArity -> Expr b -> ([b], Expr b) +collectNBinders :: Typeable b => JoinArity -> Expr b -> ([b], Expr b) collectBinders expr = go [] expr @@ -2111,7 +2136,7 @@ collectNValBinders_maybe orig_n orig_expr -- | Takes a nested application expression and returns the function -- being applied and the arguments to which it is applied -collectArgs :: Expr b -> (Expr b, [Arg b]) +collectArgs :: Typeable b => Expr b -> (Expr b, [Arg b]) collectArgs expr = go expr [] where @@ -2120,7 +2145,7 @@ collectArgs expr -- | Takes a nested application expression and returns the function -- being applied. Looking through casts and ticks to find it. -collectFunSimple :: Expr b -> Expr b +collectFunSimple :: Typeable b => Expr b -> Expr b collectFunSimple expr = go expr where @@ -2268,10 +2293,10 @@ collectAnnArgsTicks tickishOk expr = go e as (t:ts) go e as ts = (e, as, reverse ts) -deAnnotate :: AnnExpr bndr annot -> Expr bndr +deAnnotate :: Typeable bndr => AnnExpr bndr annot -> Expr bndr deAnnotate (_, e) = deAnnotate' e -deAnnotate' :: AnnExpr' bndr annot -> Expr bndr +deAnnotate' :: Typeable bndr => AnnExpr' bndr annot -> Expr bndr deAnnotate' (AnnType t) = Type t deAnnotate' (AnnCoercion co) = Coercion co deAnnotate' (AnnVar v) = Var v @@ -2286,15 +2311,15 @@ deAnnotate' (AnnLet bind body) deAnnotate' (AnnCase scrut v t alts) = Case (deAnnotate scrut) v t (map deAnnAlt alts) -deAnnAlt :: AnnAlt bndr annot -> Alt bndr +deAnnAlt :: Typeable bndr => AnnAlt bndr annot -> Alt bndr deAnnAlt (AnnAlt con args rhs) = Alt con args (deAnnotate rhs) -deAnnBind :: AnnBind b annot -> Bind b +deAnnBind :: Typeable b => AnnBind b annot -> Bind b deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs) deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs] -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr' -collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot) +collectAnnBndrs :: Typeable bndr => AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot) collectAnnBndrs e = collect [] e where ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1738,7 +1738,8 @@ lintIdBndr top_lvl bind_site id thing_inside matchesBindingSite :: IdBinding -> BindingSite -> Bool matchesBindingSite (LetBound _) LetBind = True matchesBindingSite (LambdaBound _) LambdaBind = True - -- ROMES:TODO: Other binding sites! + matchesBindingSite (LambdaBound _) CaseBind = True + matchesBindingSite (LambdaBound _) CasePatBind = True matchesBindingSite _ _ = False {- ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -531,7 +531,7 @@ unwrapBox us var body BI_Box { bi_data_con = box_con, bi_boxed_type = box_ty } -> (us', var', body') where - var' = mkSysLocal (fsLit "uc") uniq (LambdaBound ManyTy) box_ty -- ROMES:TODO: LambdaBound here? + var' = mkSysLocal (fsLit "uc") uniq (LambdaBound ManyTy) box_ty -- ROMES:TODO: LambdaBound since its put in case binder body' = Case (Var var') var' (exprType body) [Alt (DataAlt box_con) [var] body] where ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -265,7 +265,7 @@ mkExitJoinId in_scope ty join_arity = do `extendInScopeSet` exit_id_tmpl -- just cosmetics return (uniqAway avoid exit_id_tmpl) where - exit_id_tmpl = mkSysLocal (fsLit "exit") initExitJoinUnique (LambdaBound ManyTy) ty -- ROMES:TODO: LambdaBound here for ExitJoinId?? + exit_id_tmpl = mkSysLocal (fsLit "exit") initExitJoinUnique (LetBound zeroUE) ty `asJoinId` join_arity addExit :: InScopeSet -> JoinArity -> CoreExpr -> ExitifyM JoinId ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -1751,7 +1751,7 @@ newLvlVar lvld_rhs join_arity_maybe is_mk_static = mkExportedVanillaId (mkSystemVarName uniq (mkFastString "static_ptr")) rhs_ty | otherwise - = mkSysLocal (mkFastString "lvl") uniq (LambdaBound ManyTy) rhs_ty -- ROMES:TODO: What's the IdBinding + = mkSysLocal (mkFastString "lvl") uniq (LetBound zeroUE) rhs_ty -- | Clone the binders bound by a single-alternative case. cloneCaseBndrs :: LevelEnv -> Level -> [Var] -> LvlM (LevelEnv, [Var]) ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -4,7 +4,7 @@ \section[GHC.Core.Opt.Simplify.Monad]{The simplifier Monad} -} - +{-# LANGUAGE ExistentialQuantification #-} module GHC.Core.Opt.Simplify.Env ( -- * The simplifier mode @@ -812,7 +812,7 @@ addJoinFloats floats join_floats , sfInScope = foldlOL extendInScopeSetBind (sfInScope floats) join_floats } -addFloats :: SimplFloats -> SimplFloats -> SimplFloats +addFloats :: HasCallStack => SimplFloats -> SimplFloats -> SimplFloats -- Add both let-floats and join-floats for env2 to env1; -- *plus* the in-scope set for env2, which is bigger -- than that for env1 @@ -849,7 +849,7 @@ mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs _ff !jfloats' | isNilOL jbs = emptyJoinFloats | otherwise = unitJoinFloat (Rec (flattenBinds (fromOL jbs))) -wrapFloats :: SimplFloats -> OutExpr -> OutExpr +wrapFloats :: HasCallStack => SimplFloats -> OutExpr -> OutExpr -- Wrap the floats around the expression wrapFloats (SimplFloats { sfLetFloats = LetFloats bs flag , sfJoinFloats = jbs }) body @@ -867,7 +867,7 @@ wrapJoinFloatsX floats body = ( floats { sfJoinFloats = emptyJoinFloats } , wrapJoinFloats (sfJoinFloats floats) body ) -wrapJoinFloats :: JoinFloats -> OutExpr -> OutExpr +wrapJoinFloats :: HasCallStack => JoinFloats -> OutExpr -> OutExpr -- Wrap the sfJoinFloats of the env around the expression, -- and take them out of the SimplEnv wrapJoinFloats join_floats body ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2249,7 +2249,8 @@ rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) ; return (Lam s' body') } -- Important: do not try to eta-expand this lambda -- See Note [No eta-expansion in runRW#] - _ -> do { s' <- newId (fsLit "s") (LambdaBound ManyTy) realWorldStatePrimTy +-- ROMES:TODO: + _ -> do { s' <- newId (fsLit "s") (LambdaBound OneTy) realWorldStatePrimTy ; let (m,_,_) = splitFunTy fun_ty env' = arg_env `addNewInScopeIds` [s'] cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s' ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Core.TyCon (TyCon, tyConName ) import GHC.Core.Multiplicity import GHC.Core.Ppr ( pprParendExpr ) import GHC.Core.Make ( mkImpossibleExpr ) +import GHC.Types.Var (pprIdWithBinding, isLetBinding, isLambdaBinding, zeroUE) import GHC.Unit.Module import GHC.Unit.Module.ModGuts @@ -1484,11 +1485,22 @@ scExpr' env (Cast e co) = do (usg, e') <- scExpr env e -- Important to use mkCast here -- See Note [SpecConstr call patterns] scExpr' env e@(App _ _) = scApp env (collectArgs e) -scExpr' env (Lam b e) = do let (env', b') = extendBndr env b - (usg, e') <- scExpr env' e - return (usg, Lam b' e') +scExpr' env (Lam b e) + | not (isLambdaBinding b) + = pprPanic "scExpr':Lam" (pprIdWithBinding b) + | otherwise + = do let (env', b') = extendBndr env b + (usg, e') <- scExpr env' e + return (usg, Lam b' e') scExpr' env (Let bind body) + | NonRec b _ <- bind + , not (isLetBinding b) + = pprPanic "scExpr':Let:NonRec" (pprIdWithBinding b) + | Rec bs <- bind + , any (not . isLetBinding . fst) bs + = pprPanic "scExpr':Let:Rec" (ppr bs) + | otherwise = do { (final_usage, binds', body') <- scBind NotTopLevel env bind $ (\env -> scExpr env body) ; return (final_usage, mkLets binds' body') } @@ -1606,6 +1618,8 @@ scApp env (Var fn, args) -- Function is a variable where doBeta :: OutExpr -> [OutExpr] -> OutExpr doBeta (Lam bndr body) (arg : args) = Let (NonRec bndr arg) (doBeta body args) + where bndr' | isId bndr = bndr `setIdBinding` LetBound zeroUE + | otherwise = bndr doBeta fn args = mkApps fn args -- The function is almost always a variable, but not always. ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -65,6 +65,7 @@ module GHC.Core.Utils ( dumpIdInfoOfProgram ) where +import Data.Typeable (Typeable) import GHC.Prelude import GHC.Platform @@ -453,7 +454,7 @@ stripTicksTopT p = go [] -- | Completely strip ticks satisfying a predicate from an -- expression. Note this is O(n) in the size of the expression! -stripTicksE :: (CoreTickish -> Bool) -> Expr b -> Expr b +stripTicksE :: Typeable b => (CoreTickish -> Bool) -> Expr b -> Expr b stripTicksE p expr = go expr where go (App e a) = App (go e) (go a) go (Lam b e) = Lam b (go e) @@ -469,7 +470,7 @@ stripTicksE p expr = go expr go_b (b, e) = (b, go e) go_a (Alt c bs e) = Alt c bs (go e) -stripTicksT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish] +stripTicksT :: Typeable b => (CoreTickish -> Bool) -> Expr b -> [CoreTickish] stripTicksT p expr = fromOL $ go expr where go (App e a) = go e `appOL` go a go (Lam _ e) = go e ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -58,7 +58,6 @@ import GHC.Core.Make import GHC.Core.Rules import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Core.Ppr -import GHC.Core.UsageEnv ( zeroUE ) import GHC.Builtin.Names import GHC.Builtin.Types.Prim ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -45,7 +45,6 @@ import GHC.Tc.TyCl.Build( TcMethInfo ) import GHC.Core.Type ( extendTvSubstWithClone, piResultTys ) import GHC.Core.Predicate -import GHC.Core.UsageEnv (zeroUE) import GHC.Core.Class import GHC.Core.Coercion ( pprCoAxiom ) import GHC.Core.FamInstEnv ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -43,7 +43,6 @@ import GHC.Tc.Types.Origin import GHC.Tc.TyCl.Build import GHC.Tc.Utils.Instantiate import GHC.Tc.Instance.Class( AssocInstInfo(..), isNotAssociated ) -import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv @@ -59,7 +58,6 @@ import GHC.Core.Type import GHC.Core.SimpleOpt import GHC.Core.Predicate( classMethodInstTy ) import GHC.Tc.Types.Evidence -import GHC.Core.UsageEnv (zeroUE) import GHC.Core.TyCon import GHC.Core.Coercion.Axiom import GHC.Core.DataCon @@ -1477,7 +1475,7 @@ tcSuperClasses skol_info dfun_id cls tyvars dfun_evs dfun_ev_binds sc_theta ; sc_ev_id <- newEvVar sc_pred ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id IsCoherent sc_ev_tm ; let sc_top_ty = tcMkDFunSigmaTy tyvars (map idType dfun_evs) sc_pred - sc_top_id = mkLocalId sc_top_name (LambdaBound ManyTy) sc_top_ty -- ROMES:TODO: + sc_top_id = mkLocalId sc_top_name (LetBound zeroUE) sc_top_ty export = ABE { abe_wrap = idHsWrapper , abe_poly = sc_top_id , abe_mono = sc_ev_id @@ -2043,7 +2041,7 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind ; let ctxt = FunSigCtxt sel_name (lhsSigTypeContextSpan hs_sig_ty) -- WantRCC <=> check for redundant constraints in the -- user-specified instance signature - inner_meth_id = mkLocalId inner_meth_name (LambdaBound ManyTy) sig_ty -- ROMES:TODO: + inner_meth_id = mkLocalId inner_meth_name (LetBound zeroUE) sig_ty inner_meth_sig = CompleteSig { sig_bndr = inner_meth_id , sig_ctxt = ctxt , sig_loc = getLocA hs_sig_ty } ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -59,7 +59,7 @@ module GHC.Types.Var ( setIdExported, setIdNotExported, setIdBinding, updateIdTypeButNotMults, updateIdTypeAndMults, updateIdTypeAndMultsM, - IdBinding(..), idBinding, pprIdWithBinding, + IdBinding(..), idBinding, pprIdWithBinding, zeroUE, -- ** Predicates isId, isTyVar, isTcTyVar, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e5fe8b1bbb404792b2f25554fe78232930ef43f...c0467125b7f3201551d57c2dc0ad9a06d93d5f6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e5fe8b1bbb404792b2f25554fe78232930ef43f...c0467125b7f3201551d57c2dc0ad9a06d93d5f6b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 20:19:22 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 25 May 2023 16:19:22 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.2.8-fix-19421-backport] rts: Fix backport for #19421 Message-ID: <646fc2ca3ddb5_64cfb238fab7443876f@gitlab.mail> Zubin pushed to branch wip/ghc-9.2.8-fix-19421-backport at Glasgow Haskell Compiler / GHC Commits: dfa83462 by Zubin Duggal at 2023-05-26T01:47:50+05:30 rts: Fix backport for #19421 Metric Decrease: haddock.Cabal haddock.base haddock.compiler Metric Increase: Naperian T13719 T9203 T9872a T9872b T9872c T9872d parsing001 - - - - - 1 changed file: - rts/linker/MachO.c Changes: ===================================== rts/linker/MachO.c ===================================== @@ -11,6 +11,7 @@ #include "linker/MachO.h" #include "linker/CacheFlush.h" #include "linker/SymbolExtras.h" +#include "linker/MMap.h" #include #include View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfa834627a94d98aaeddb0cb3a0cedca934d2814 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfa834627a94d98aaeddb0cb3a0cedca934d2814 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 20:20:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 25 May 2023 16:20:30 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] Lam and Let pattern synonyms Message-ID: <646fc30e5e86b_64cfb24040ba443911c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 59005e70 by Rodrigo Mesquita at 2023-05-25T21:19:42+01:00 Lam and Let pattern synonyms For debugging purposes only :) This way, we're able to more easily find the first binder in which the IdBinding is wrong. - - - - - 2 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -7,12 +7,12 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE GADTs, StandaloneDeriving #-} +{-# LANGUAGE GADTs, StandaloneDeriving, PatternSynonyms #-} -- | GHC.Core holds all the main data types for use by for the Glasgow Haskell Compiler midsection module GHC.Core ( -- * Main data types - Expr(..), Alt(..), Bind(..), AltCon(..), Arg, + Expr(..,Let,Lam), Alt(..), Bind(..), AltCon(..), Arg, CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr, TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr, @@ -252,8 +252,8 @@ data Expr b = Var Id | Lit Literal | App (Expr b) (Arg b) - | HasCallStack => Lam b (Expr b) - | HasCallStack => Let (Bind b) (Expr b) + | HasCallStack => Lam' b (Expr b) + | HasCallStack => Let' (Bind b) (Expr b) | HasCallStack => Case (Expr b) b Type [Alt b] -- See Note [Case expression invariants] -- and Note [Why does Case have a 'Type' field?] | Cast (Expr b) CoercionR -- The Coercion has Representational role @@ -262,6 +262,31 @@ data Expr b | Coercion Coercion deriving instance Data b => Data (Expr b) +{-# COMPLETE Var, Lit, App, Lam, Let, Case, Cast, Tick, Type, Coercion #-} + +pattern Lam :: forall b. (HasCallStack, Typeable b) => b -> Expr b -> Expr b +pattern Lam x y <- Lam' x y where + Lam x y + | Just Refl <- eqT @b @Id + , not (isLambdaBinding x) + = pprPanic "pattern Lam!" (pprIdWithBinding x) + | otherwise + = Lam' x y + +pattern Let :: forall b. (HasCallStack, Typeable b) => Bind b -> Expr b -> Expr b +pattern Let x y <- Let' x y where + Let x y + | Just Refl <- eqT @b @Id + , NonRec z _ <- x + , not (isLetBinding z) + = pprPanic "pattern Let 1!" (pprIdWithBinding z) + | Just Refl <- eqT @b @Id + , Rec zs <- x + , any (not . isLetBinding . fst) zs + = pprPanic "pattern Let 2!" (ppr zs) + | otherwise + = Let' x y + -- | Type synonym for expressions that occur in function argument positions. -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not type Arg b = Expr b @@ -1808,7 +1833,7 @@ type TaggedAlt t = Alt (TaggedBndr t) instance Outputable b => Outputable (TaggedBndr b) where ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>' -deTagExpr :: TaggedExpr t -> CoreExpr +deTagExpr :: Typeable t => TaggedExpr t -> CoreExpr deTagExpr (Var v) = Var v deTagExpr (Lit l) = Lit l deTagExpr (Type ty) = Type ty @@ -1820,11 +1845,11 @@ deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts deTagExpr (Tick t e) = Tick t (deTagExpr e) deTagExpr (Cast e co) = Cast (deTagExpr e) co -deTagBind :: TaggedBind t -> CoreBind +deTagBind :: Typeable t => TaggedBind t -> CoreBind deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs) deTagBind (Rec prs) = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs] -deTagAlt :: TaggedAlt t -> CoreAlt +deTagAlt :: Typeable t => TaggedAlt t -> CoreAlt deTagAlt (Alt con bndrs rhs) = Alt con [b | TB b _ <- bndrs] (deTagExpr rhs) {- @@ -1954,12 +1979,12 @@ mkLet bind body = case (eqT @b @Id) of Just Refl -> if not (isLetBinder bind pprLetBinderId (Rec ls) = hsep $ map (pprIdWithBinding . fst) ls -- | @mkLetNonRec bndr rhs body@ wraps @body@ in a @let@ binding @bndr at . -mkLetNonRec :: b -> Expr b -> Expr b -> Expr b +mkLetNonRec :: Typeable b => b -> Expr b -> Expr b -> Expr b mkLetNonRec b rhs body = Let (NonRec b rhs) body -- | @mkLetRec binds body@ wraps @body@ in a @let rec@ with the given set of -- @binds@ if binds is non-empty. -mkLetRec :: [(b, Expr b)] -> Expr b -> Expr b +mkLetRec :: Typeable b => [(b, Expr b)] -> Expr b -> Expr b mkLetRec [] body = body mkLetRec bs body = Let (Rec bs) body @@ -2056,7 +2081,7 @@ flattenBinds [] = [] -- | We often want to strip off leading lambdas before getting down to -- business. Variants are 'collectTyBinders', 'collectValBinders', -- and 'collectTyAndValBinders' -collectBinders :: Expr b -> ([b], Expr b) +collectBinders :: Typeable b => Expr b -> ([b], Expr b) collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr) collectValBinders :: CoreExpr -> ([Id], CoreExpr) collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr) @@ -2064,7 +2089,7 @@ collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr) -- | Strip off exactly N leading lambdas (type or value). -- Good for use with join points. -- Panic if there aren't enough -collectNBinders :: JoinArity -> Expr b -> ([b], Expr b) +collectNBinders :: Typeable b => JoinArity -> Expr b -> ([b], Expr b) collectBinders expr = go [] expr @@ -2111,7 +2136,7 @@ collectNValBinders_maybe orig_n orig_expr -- | Takes a nested application expression and returns the function -- being applied and the arguments to which it is applied -collectArgs :: Expr b -> (Expr b, [Arg b]) +collectArgs :: Typeable b => Expr b -> (Expr b, [Arg b]) collectArgs expr = go expr [] where @@ -2120,7 +2145,7 @@ collectArgs expr -- | Takes a nested application expression and returns the function -- being applied. Looking through casts and ticks to find it. -collectFunSimple :: Expr b -> Expr b +collectFunSimple :: Typeable b => Expr b -> Expr b collectFunSimple expr = go expr where @@ -2268,10 +2293,10 @@ collectAnnArgsTicks tickishOk expr = go e as (t:ts) go e as ts = (e, as, reverse ts) -deAnnotate :: AnnExpr bndr annot -> Expr bndr +deAnnotate :: Typeable bndr => AnnExpr bndr annot -> Expr bndr deAnnotate (_, e) = deAnnotate' e -deAnnotate' :: AnnExpr' bndr annot -> Expr bndr +deAnnotate' :: Typeable bndr => AnnExpr' bndr annot -> Expr bndr deAnnotate' (AnnType t) = Type t deAnnotate' (AnnCoercion co) = Coercion co deAnnotate' (AnnVar v) = Var v @@ -2286,15 +2311,15 @@ deAnnotate' (AnnLet bind body) deAnnotate' (AnnCase scrut v t alts) = Case (deAnnotate scrut) v t (map deAnnAlt alts) -deAnnAlt :: AnnAlt bndr annot -> Alt bndr +deAnnAlt :: Typeable bndr => AnnAlt bndr annot -> Alt bndr deAnnAlt (AnnAlt con args rhs) = Alt con args (deAnnotate rhs) -deAnnBind :: AnnBind b annot -> Bind b +deAnnBind :: Typeable b => AnnBind b annot -> Bind b deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs) deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs] -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr' -collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot) +collectAnnBndrs :: Typeable bndr => AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot) collectAnnBndrs e = collect [] e where ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -65,6 +65,7 @@ module GHC.Core.Utils ( dumpIdInfoOfProgram ) where +import Data.Typeable (Typeable) import GHC.Prelude import GHC.Platform @@ -453,7 +454,7 @@ stripTicksTopT p = go [] -- | Completely strip ticks satisfying a predicate from an -- expression. Note this is O(n) in the size of the expression! -stripTicksE :: (CoreTickish -> Bool) -> Expr b -> Expr b +stripTicksE :: Typeable b => (CoreTickish -> Bool) -> Expr b -> Expr b stripTicksE p expr = go expr where go (App e a) = App (go e) (go a) go (Lam b e) = Lam b (go e) @@ -469,7 +470,7 @@ stripTicksE p expr = go expr go_b (b, e) = (b, go e) go_a (Alt c bs e) = Alt c bs (go e) -stripTicksT :: (CoreTickish -> Bool) -> Expr b -> [CoreTickish] +stripTicksT :: Typeable b => (CoreTickish -> Bool) -> Expr b -> [CoreTickish] stripTicksT p expr = fromOL $ go expr where go (App e a) = go e `appOL` go a go (Lam _ e) = go e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59005e70473f1725fae1384d5825a3cbfb9da09e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59005e70473f1725fae1384d5825a3cbfb9da09e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 20:42:41 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 25 May 2023 16:42:41 -0400 Subject: [Git][ghc/ghc][wip/t21766] Update user's guide and release notes, small fixes Message-ID: <646fc841a1944_64cfb24040ba444588b@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 1f5383a3 by Finley McIlwaine at 2023-05-25T14:40:54-06:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 5 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -233,10 +233,6 @@ debug = vanilla { buildFlavour = SlowValidate , withAssertions = True -- WithNuma so at least one job tests Numa , withNuma = True - - -- Build with IPE in debug so at least one job tests - -- uncompressed IPE data - , withIpe = True } ipe :: BuildConfig ===================================== .gitlab/jobs.yaml ===================================== @@ -1091,7 +1091,7 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-numa-slow-validate+ipe": { + "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -1101,7 +1101,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", "junit.xml" ], "reports": { @@ -1143,11 +1143,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", - "BUILD_FLAVOUR": "slow-validate+ipe", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", + "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe", + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } }, @@ -4072,7 +4072,7 @@ "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, - "x86_64-linux-deb10-numa-slow-validate+ipe": { + "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -4082,7 +4082,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", "junit.xml" ], "reports": { @@ -4124,11 +4124,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", - "BUILD_FLAVOUR": "slow-validate+ipe", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", + "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe" + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -10,13 +10,11 @@ import qualified Data.ByteString.Internal as BSI import GHC.IO (unsafePerformIO) #endif -import GHC.Data.FastString (fastStringToShortText) import GHC.Prelude import GHC.Platform import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Unit.Module import GHC.Utils.Outputable -import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..)) import GHC.Cmm ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -119,6 +119,17 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- The compiler may now be configured to compress the debugging information + included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must + build GHC from source (see + `here` for directions) + and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` + script. **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. + GHCi ~~~~ ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,23 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. - This flag will increase the binary size by quite a lot, depending on how - big your project is. For compiling a project the size of GHC the overhead was - about 200 megabytes. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite + a lot, depending on how big your project is. For compiling a project the + size of GHC the overhead was about 200 megabytes. + + :since: 9.8 + + If you wish to reduce the size of :ghc-flag:`-finfo-table-map` enabled + binaries, consider building GHC from source and supplying the + ``--enable-ipe-data-compression`` flag to the ``configure`` script. This + will cause GHC to compress the :ghc-flag:`-finfo-table-map` related + debugging information included in binaries using the `libzstd + `_ compression library. **Note**: This + feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f5383a3b417c6657cbf7170fc052cdc249c3134 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f5383a3b417c6657cbf7170fc052cdc249c3134 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 22:03:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 25 May 2023 18:03:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/testsuite-output-patch Message-ID: <646fdb244606b_64cfb238fab744567ed@gitlab.mail> Ben Gamari pushed new branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/testsuite-output-patch You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 22:34:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 25 May 2023 18:34:20 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21134 Message-ID: <646fe26c82fe5_64cfb24040ba4462650@gitlab.mail> Ben Gamari pushed new branch wip/T21134 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21134 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 22:37:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 25 May 2023 18:37:24 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 2 commits: testsuite: Allow preservation of unexpected output Message-ID: <646fe324284f6_64cfb23d7eab0468284@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: e2e039e1 by Ben Gamari at 2023-05-25T18:37:08-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 46f435d2 by Ben Gamari at 2023-05-25T18:37:08-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 5 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -684,16 +684,20 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty - , if validateNonmovingGc buildConfig - then "RUNTEST_ARGS" =: "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" - else mempty + , let runtestArgs = + [ "--unexpected-output-dir=./unexpected-output" ] ++ + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + , "unexpected-output"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -11,7 +11,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -59,6 +60,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-darwin-validate" } }, @@ -73,7 +75,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -117,6 +120,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-linux-deb10-validate" } }, @@ -131,7 +135,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -175,6 +180,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "i386-linux-deb9-validate" } }, @@ -189,7 +195,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -237,6 +244,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -252,7 +260,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -296,6 +305,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -311,7 +321,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -355,6 +366,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -370,7 +382,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -414,6 +427,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -429,7 +443,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -477,6 +492,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -494,7 +510,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -540,6 +557,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -555,7 +573,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -602,6 +621,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -617,7 +637,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -664,6 +685,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -679,7 +701,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -726,6 +749,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -741,7 +765,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -787,6 +812,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -802,7 +828,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -848,6 +875,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -863,7 +891,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -909,6 +938,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -924,7 +954,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -969,6 +1000,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -984,7 +1016,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1028,6 +1061,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1043,7 +1077,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1087,6 +1122,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1102,7 +1138,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1147,6 +1184,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1162,7 +1200,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1206,6 +1245,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1221,7 +1261,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1265,6 +1306,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1280,7 +1322,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1324,6 +1367,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1339,7 +1383,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1383,6 +1428,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1398,7 +1444,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1443,6 +1490,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1459,7 +1507,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1505,6 +1554,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1520,7 +1570,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1567,6 +1618,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1582,7 +1634,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1626,6 +1679,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1641,7 +1695,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1685,7 +1740,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", "CONFIGURE_ARGS": "", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output --way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", "XZ_OPT": "-9" } @@ -1701,7 +1756,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1745,6 +1801,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1760,7 +1817,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1806,6 +1864,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1821,7 +1880,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1868,6 +1928,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1883,7 +1944,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1929,6 +1991,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1944,7 +2007,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1989,6 +2053,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2004,7 +2069,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2048,6 +2114,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2063,7 +2130,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2107,6 +2175,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2121,7 +2190,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2166,6 +2236,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2180,7 +2251,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2225,6 +2297,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2240,7 +2313,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2289,6 +2363,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2304,7 +2379,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2350,6 +2426,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2365,7 +2442,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2411,6 +2489,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2426,7 +2505,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2475,6 +2555,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2492,7 +2573,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2540,6 +2622,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2555,7 +2638,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2603,6 +2687,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2618,7 +2703,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2666,6 +2752,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2681,7 +2768,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2727,6 +2815,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2742,7 +2831,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2788,6 +2878,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2803,7 +2894,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2849,6 +2941,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2864,7 +2957,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2910,6 +3004,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -2925,7 +3020,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2971,7 +3067,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output --way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-release+boot_nonmoving_gc", "XZ_OPT": "-9" } @@ -2987,7 +3083,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3033,6 +3130,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3048,7 +3146,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3096,6 +3195,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3111,7 +3211,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3159,6 +3260,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3174,7 +3276,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3222,6 +3325,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3237,7 +3341,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3283,6 +3388,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3298,7 +3404,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3344,6 +3451,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3359,7 +3467,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3405,6 +3514,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3419,7 +3529,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3465,6 +3576,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3479,7 +3591,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3525,6 +3638,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3540,7 +3654,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3588,6 +3703,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_utimensat": "no" @@ -3604,7 +3720,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3650,6 +3767,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-freebsd13-validate" } }, @@ -3664,7 +3782,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3711,6 +3830,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, @@ -3725,7 +3845,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3771,6 +3892,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, @@ -3785,7 +3907,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3832,6 +3955,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, @@ -3846,7 +3970,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3893,6 +4018,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, @@ -3907,7 +4033,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3951,6 +4078,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, @@ -3965,7 +4093,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4010,6 +4139,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, @@ -4024,7 +4154,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4069,6 +4200,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, @@ -4083,7 +4215,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4127,6 +4260,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, @@ -4141,7 +4275,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4185,6 +4320,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, @@ -4199,7 +4335,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4243,6 +4380,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, @@ -4257,7 +4395,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4303,6 +4442,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4318,7 +4458,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4364,6 +4505,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, @@ -4378,7 +4520,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4425,6 +4568,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, @@ -4439,7 +4583,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4483,7 +4628,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", "CONFIGURE_ARGS": "", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output --way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" } }, @@ -4498,7 +4643,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4544,6 +4690,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release" } }, @@ -4557,7 +4704,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4602,6 +4750,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-validate" } } ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--unexpected-output-dir", help="directory in which to place unexpected output") parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") @@ -128,6 +129,9 @@ if args.top: if args.test_package_db: config.test_package_db = args.test_package_db +if args.unexpected_output_dir: + config.unexpected_output_dir = Path(args.unexpected_output_dir) + if args.only: config.only = args.only config.run_only_some_tests = True ===================================== testsuite/driver/testglobals.py ===================================== @@ -203,7 +203,7 @@ class TestConfig: self.baseline_commit = None # type: Optional[GitRef] # Additional package dbs to inspect for test dependencies. - self.test_package_db = [] # type: [PathToPackageDb] + self.test_package_db = [] # type: List[PathToPackageDb] # Should we skip performance tests self.skip_perf_tests = False @@ -225,6 +225,10 @@ class TestConfig: # See Note [Haddock runtime stats files] at the bottom of this file. self.stats_files_dir = Path('/please_set_stats_files_dir') + # Where to place observed output files on when unexpected output + # is observed. + self.unexpected_output_dir = None # type: Optional[Path] + # Should we cleanup after test runs? self.cleanup = True ===================================== testsuite/driver/testlib.py ===================================== @@ -2196,11 +2196,15 @@ async def check_prof_ok(name: TestName, way: WayName) -> bool: # new output. Returns true if output matched or was accepted, false # otherwise. See Note [Output comparison] for the meaning of the # normaliser and whitespace_normaliser parameters. -async def compare_outputs(way: WayName, - kind: str, - normaliser: OutputNormalizer, - expected_file, actual_file, diff_file=None, - whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: +async def compare_outputs( + way: WayName, + kind: str, + normaliser: OutputNormalizer, + expected_file: Path, + actual_file: Path, + diff_file: Optional[Path]=None, + whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options if kind == 'stderr' and getTestOpts().ignore_stderr: return True @@ -2234,6 +2238,11 @@ async def compare_outputs(way: WayName, if expected_normalised_path != Path(os.devnull): write_file(expected_normalised_path, expected_str) + if config.unexpected_output_dir is not None: + out = config.unexpected_output_dir / expected_path.relative_to(config.top) + out.parent.mkdir(exist_ok=True, parents=True) + write_file(out, expected_str) + actual_normalised_path = add_suffix(actual_path, 'normalised') write_file(actual_normalised_path, actual_str) @@ -2331,6 +2340,15 @@ def grep_output(normaliser: OutputNormalizer, pattern_file, actual_file, is_subs # squash all whitespace, making the diff unreadable. Instead we rely # on the `diff` program to ignore whitespace changes as much as # possible (#10152). +# +# In addition, to aid CI users we will optionally collect all +# of the unexpected output that we encountered in the +# directory at config.unexpected_output_dir. The intent here is for this +# directory to be preserved as a CI artifact which can then +# be downloaded by the user and committed to their branch +# to address CI failures on platforms which they cannot +# test locally. + # Note [Null device handling] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0722dd1938bdd723fd6eb00acd7a9c55cb1f8c6...46f435d2649ea67049db51213fd009b45253f28f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0722dd1938bdd723fd6eb00acd7a9c55cb1f8c6...46f435d2649ea67049db51213fd009b45253f28f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 22:57:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 May 2023 18:57:41 -0400 Subject: [Git][ghc/ghc][master] rts: Build ticky GHC with single-threaded RTS Message-ID: <646fe7e5d4a8b_64cfb16604f94475224@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - 1 changed file: - hadrian/src/Flavour.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -145,11 +145,13 @@ enableDebugInfo = addArgs $ notStage0 ? mconcat -- | Enable the ticky-ticky profiler in stage2 GHC enableTickyGhc :: Flavour -> Flavour -enableTickyGhc = - addArgs $ orM [stage1, cross] ? mconcat +enableTickyGhc f = + (addArgs (orM [stage1, cross] ? mconcat [ builder (Ghc CompileHs) ? tickyArgs , builder (Ghc LinkHs) ? tickyArgs - ] + ]) f) { ghcThreaded = (< Stage2) } + -- Build single-threaded ghc because ticky profiling is racy with threaded + -- RTS and the C counters are disabled. (See #23439) tickyArgs :: Args tickyArgs = mconcat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc3422d44b89bcd4315075cafb4585d08e463180 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc3422d44b89bcd4315075cafb4585d08e463180 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu May 25 22:58:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 25 May 2023 18:58:23 -0400 Subject: [Git][ghc/ghc][master] Propagate long-distance info in generated code Message-ID: <646fe80f3537a_64cfb2350eac4480537@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - 6 changed files: - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/Tc/Gen/Expr.hs - + testsuite/tests/pmcheck/should_compile/T23445.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -218,7 +218,7 @@ mkMatchGroup :: AnnoBody p body -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p))) mkMatchGroup origin matches = MG { mg_ext = origin - , mg_alts = matches } + , mg_alts = matches } mkLamCaseMatchGroup :: AnnoBody p body => Origin ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Hs.Syn.Type import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad import GHC.HsToCore.Pmc -import GHC.HsToCore.Pmc.Types ( Nablas, initNablas ) +import GHC.HsToCore.Pmc.Types ( Nablas ) import GHC.HsToCore.Monad import GHC.HsToCore.Binds import GHC.HsToCore.GuardedRHSs @@ -783,16 +783,24 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- Pattern match check warnings for /this match-group/. -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. -- Each Match will split off one Nablas for its RHSs from this. - ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt + ; matches_nablas <- + if isMatchContextPmChecked dflags origin ctxt + + -- See Note [Long-distance information] in GHC.HsToCore.Pmc then addHsScrutTmCs (concat scrs) new_vars $ - -- See Note [Long-distance information] pmcMatches (DsMatchContext ctxt locn) new_vars matches - else pure (initNablasMatches matches) + + -- When we're not doing PM checks on the match group, + -- we still need to propagate long-distance information. + -- See Note [Long-distance information in matchWrapper] + else do { ldi_nablas <- getLdiNablas + ; pure $ initNablasMatches ldi_nablas matches } ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas - ; result_expr <- handleWarnings $ + ; result_expr <- discard_warnings_if_generated origin $ matchEquations ctxt new_vars eqns_info rhs_ty + ; return (new_vars, result_expr) } where -- Called once per equation in the match, or alternative in the case @@ -810,19 +818,67 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches , eqn_orig = FromSource , eqn_rhs = match_result } } - handleWarnings = if isGenerated origin - then discardWarningsDs - else id + discard_warnings_if_generated orig = + if isGenerated orig + then discardWarningsDs + else id + + initNablasMatches :: Nablas -> [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] + initNablasMatches ldi_nablas ms + = map (\(L _ m) -> (ldi_nablas, initNablasGRHSs ldi_nablas (m_grhss m))) ms + + initNablasGRHSs :: Nablas -> GRHSs GhcTc b -> NonEmpty Nablas + initNablasGRHSs ldi_nablas m + = expectJust "GRHSs non-empty" + $ NEL.nonEmpty + $ replicate (length (grhssGRHSs m)) ldi_nablas + +{- Note [Long-distance information in matchWrapper] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The pattern match checking in matchWrapper is done conditionally, depending +on isMatchContextPmChecked. This means that we don't perform pattern match +checking on e.g. generated pattern matches. + +However, when we skip pattern match checking, we still need to keep track +of long-distance information in case we need it in a nested context. + +This came up in #23445. For example: - initNablasMatches :: [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] - initNablasMatches ms - = map (\(L _ m) -> (initNablas, initNablasGRHSs (m_grhss m))) ms + data GADT a where + IsUnit :: GADT () - initNablasGRHSs :: GRHSs GhcTc b -> NonEmpty Nablas - initNablasGRHSs m = expectJust "GRHSs non-empty" - $ NEL.nonEmpty - $ replicate (length (grhssGRHSs m)) initNablas + data Foo b where + FooUnit :: Foo () + FooInt :: Foo Int + data SomeRec = SomeRec { fld :: () } + + bug :: GADT a -> Foo a -> SomeRec -> SomeRec + bug IsUnit foo r = + let gen_fld :: () + gen_fld = case foo of { FooUnit -> () } + in case r of { SomeRec _ -> SomeRec gen_fld } + +Here the body of 'bug' was generated by 'desugarRecordUpd' from the user-written +record update + + cd { fld = case foo of { FooUnit -> () } } + +As a result, we have a generated FunBind gen_fld whose RHS + + case foo of { FooUnit -> () } + +is user-written. This all happens after the GADT pattern match on IsUnit, +which brings into scope the Given equality [G] a ~ (). We need to make sure +that this long distance information is visible when pattern match checking the +user-written case statement. + +To propagate this long-distance information in 'matchWrapper', when we skip +pattern match checks, we make sure to manually pass the long-distance +information to 'mk_eqn_info', which is responsible for recurring further into +the expression (in this case, it will end up recursively calling 'matchWrapper' +on the user-written case statement). +-} matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -39,7 +39,7 @@ module GHC.HsToCore.Pmc ( isMatchContextPmChecked, -- See Note [Long-distance information] - addTyCs, addCoreScrutTmCs, addHsScrutTmCs + addTyCs, addCoreScrutTmCs, addHsScrutTmCs, getLdiNablas ) where import GHC.Prelude @@ -142,8 +142,8 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- Returns one non-empty 'Nablas' for 1.) each pattern of a 'Match' and 2.) -- each of a 'Match'es 'GRHS' for Note [Long-distance information]. -- --- Special case: When there are /no matches/, then the functionassumes it --- checks and @-XEmptyCase@ with only a single match variable. +-- Special case: When there are /no matches/, then the function assumes it +-- checks an @-XEmptyCase@ with only a single match variable. -- See Note [Checking EmptyCase]. pmcMatches :: DsMatchContext -- ^ Match context, for warnings messages ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1070,7 +1070,7 @@ Wrinkle [GADT result type in tcRecordUpd] -} --- | Desugars a record update @record_expr { fld1 = e1, fld2 = e2}@ into a case expression +-- | Desugars a record update @record_expr { fld1 = e1, fld2 = e2 }@ into a case expression -- that matches on the constructors of the record @r@, as described in -- Note [Record Updates]. -- ===================================== testsuite/tests/pmcheck/should_compile/T23445.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs #-} + +module T23445 where + +data GADT a where + IsUnit :: GADT () + +data Foo b where + FooUnit :: Foo () + FooInt :: Foo Int + +data SomeRec = SomeRec { fld :: () } + +bug :: GADT a -> Foo a -> SomeRec -> SomeRec +bug IsUnit foo r = + r { fld = case foo of { FooUnit -> () } } ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -112,6 +112,10 @@ test('CaseOfKnownCon', [], compile, [overlapping_incomplete]) test('TooManyDeltas', [], compile, [overlapping_incomplete+'-fmax-pmcheck-models=0']) test('LongDistanceInfo', [], compile, [overlapping_incomplete]) test('T21662', [], compile, [overlapping_incomplete]) +test('T19271', [], compile, [overlapping_incomplete]) +test('T21761', [], compile, [overlapping_incomplete]) +test('T22964', [], compile, [overlapping_incomplete]) +test('T23445', [], compile, [overlapping_incomplete]) # Series (inspired) by Luke Maranget @@ -156,6 +160,4 @@ test('EmptyCase007', [], compile, [overlapping_incomplete]) test('EmptyCase008', [], compile, [overlapping_incomplete]) test('EmptyCase009', [], compile, [overlapping_incomplete]) test('EmptyCase010', [], compile, [overlapping_incomplete]) -test('T19271', [], compile, [overlapping_incomplete]) -test('T21761', [], compile, [overlapping_incomplete]) -test('T22964', [], compile, [overlapping_incomplete]) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fbc8e04e5d8fb05ff60568042802ab2fb34e1a70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fbc8e04e5d8fb05ff60568042802ab2fb34e1a70 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 02:47:03 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 25 May 2023 22:47:03 -0400 Subject: [Git][ghc/ghc][wip/t21766] Update user's guide and release notes, small fixes Message-ID: <64701da739a0b_64cfb29adf0245132a6@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: afd7c274 by Finley McIlwaine at 2023-05-25T20:44:25-06:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 6 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - rts/IPE.c Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -233,10 +233,6 @@ debug = vanilla { buildFlavour = SlowValidate , withAssertions = True -- WithNuma so at least one job tests Numa , withNuma = True - - -- Build with IPE in debug so at least one job tests - -- uncompressed IPE data - , withIpe = True } ipe :: BuildConfig ===================================== .gitlab/jobs.yaml ===================================== @@ -1091,7 +1091,7 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-numa-slow-validate+ipe": { + "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -1101,7 +1101,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", "junit.xml" ], "reports": { @@ -1143,11 +1143,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", - "BUILD_FLAVOUR": "slow-validate+ipe", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", + "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe", + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } }, @@ -4072,7 +4072,7 @@ "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, - "x86_64-linux-deb10-numa-slow-validate+ipe": { + "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -4082,7 +4082,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-numa-slow-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", "junit.xml" ], "reports": { @@ -4124,11 +4124,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate+ipe", - "BUILD_FLAVOUR": "slow-validate+ipe", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", + "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", - "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate+ipe" + "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -10,13 +10,11 @@ import qualified Data.ByteString.Internal as BSI import GHC.IO (unsafePerformIO) #endif -import GHC.Data.FastString (fastStringToShortText) import GHC.Prelude import GHC.Platform import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Unit.Module import GHC.Utils.Outputable -import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..)) import GHC.Cmm ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -119,6 +119,17 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- The compiler may now be configured to compress the debugging information + included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must + build GHC from source (see + `here` for directions) + and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` + script. **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. + GHCi ~~~~ ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,23 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. - This flag will increase the binary size by quite a lot, depending on how - big your project is. For compiling a project the size of GHC the overhead was - about 200 megabytes. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite + a lot, depending on how big your project is. For compiling a project the + size of GHC the overhead was about 200 megabytes. + + :since: 9.8 + + If you wish to reduce the size of :ghc-flag:`-finfo-table-map` enabled + binaries, consider building GHC from source and supplying the + ``--enable-ipe-data-compression`` flag to the ``configure`` script. This + will cause GHC to compress the :ghc-flag:`-finfo-table-map` related + debugging information included in binaries using the `libzstd + `_ compression library. **Note**: This + feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== rts/IPE.c ===================================== @@ -218,7 +218,7 @@ the decompressed IPE data and string table for the given node, respectively, upon return from this function. */ void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node, IpeBufferEntry **entries_dst, char **string_table_dst) { - if (node->compressed) { + if (node->compressed == 1) { // The IPE list buffer node indicates that the strings table and // entries list has been compressed. If zstd is not available, fail. // If zstd is available, decompress. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afd7c274c156ab6bf01d1a3ab0abe2cea7f4f597 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afd7c274c156ab6bf01d1a3ab0abe2cea7f4f597 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 09:38:19 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Fri, 26 May 2023 05:38:19 -0400 Subject: [Git][ghc/ghc][wip/js-hline] 62 commits: Add -Wmissing-role-annotations Message-ID: <64707e0b83180_64cfb33b42b9c5606c6@gitlab.mail> Josh Meredith pushed to branch wip/js-hline at Glasgow Haskell Compiler / GHC Commits: bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - 7f3cd3a1 by Josh Meredith at 2023-05-26T09:35:16+00:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - 30 changed files: - .gitignore - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backpack.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c42138dce426e5090f8bf96839364c9ad008023...7f3cd3a1a12dfec96e270e24ddc07011babba157 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c42138dce426e5090f8bf96839364c9ad008023...7f3cd3a1a12dfec96e270e24ddc07011babba157 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 10:26:01 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 26 May 2023 06:26:01 -0400 Subject: [Git][ghc/ghc][ghc-9.2] rts: Fix backport for #19421 Message-ID: <647089395d994_64cfb362c17cc571953@gitlab.mail> Zubin pushed to branch ghc-9.2 at Glasgow Haskell Compiler / GHC Commits: dfa83462 by Zubin Duggal at 2023-05-26T01:47:50+05:30 rts: Fix backport for #19421 Metric Decrease: haddock.Cabal haddock.base haddock.compiler Metric Increase: Naperian T13719 T9203 T9872a T9872b T9872c T9872d parsing001 - - - - - 1 changed file: - rts/linker/MachO.c Changes: ===================================== rts/linker/MachO.c ===================================== @@ -11,6 +11,7 @@ #include "linker/MachO.h" #include "linker/CacheFlush.h" #include "linker/SymbolExtras.h" +#include "linker/MMap.h" #include #include View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfa834627a94d98aaeddb0cb3a0cedca934d2814 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfa834627a94d98aaeddb0cb3a0cedca934d2814 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 11:31:13 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 26 May 2023 07:31:13 -0400 Subject: [Git][ghc/ghc][wip/testsuite-stack-size] testsuite: Pass -kb16k -kc128k for performance tests Message-ID: <6470988192597_64cfb31e4e46457587c@gitlab.mail> Matthew Pickering pushed to branch wip/testsuite-stack-size at Glasgow Haskell Compiler / GHC Commits: 479d64d9 by Matthew Pickering at 2023-05-26T12:29:48+01:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack underflow (which allocates more stack chunks). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. Fixes #23439 - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -1791,7 +1791,11 @@ async def simple_build(name: Union[TestName, str], stats_file = name + '.comp.stats' if isCompilerStatsTest(): - extra_hc_opts += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' + # Set a bigger chunk size to reduce variation due to additional under/overflowing + # The tests are attempting to test how much work the compiler is doing by proxy of + # bytes allocated. The additional allocations caused by stack overflow can cause + # spurious failures if you trip over the limit (see #23439) + extra_hc_opts += ' +RTS -kc128k -kb16k -V0 -t' + stats_file + ' --machine-readable -RTS' if backpack: extra_hc_opts += ' -outputdir ' + name + '.out' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/479d64d938489a6b1996a63ee49dbd11adc2a166 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/479d64d938489a6b1996a63ee49dbd11adc2a166 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 12:27:38 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 26 May 2023 08:27:38 -0400 Subject: [Git][ghc/ghc][wip/js-th] 203 commits: Add quotRem rules (#22152) Message-ID: <6470a5ba2e43c_64cfb29ad81ac585931@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 92148910 by Sylvain Henry at 2023-05-26T14:32:14+02:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3fde377be3a3711f6803f432f826754cf227ef33...921489108b935085253a36a7ca06d101cec1898c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3fde377be3a3711f6803f432f826754cf227ef33...921489108b935085253a36a7ca06d101cec1898c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 12:36:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 May 2023 08:36:08 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: rts: Build ticky GHC with single-threaded RTS Message-ID: <6470a7b8cc776_64cfb321f81a0596463@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f5ad8f9e by Matthew Pickering at 2023-05-26T08:35:31-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - 3c6fafc7 by Matthew Pickering at 2023-05-26T08:35:32-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 9c6e32da by Matthew Pickering at 2023-05-26T08:35:32-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - be2dac34 by Matthew Pickering at 2023-05-26T08:35:32-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 3428e814 by Matthew Pickering at 2023-05-26T08:35:32-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 39d85ef1 by Matthew Pickering at 2023-05-26T08:35:32-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 27e46bde by Matthew Pickering at 2023-05-26T08:35:32-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - 7a660aaa by Matthew Pickering at 2023-05-26T08:35:32-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 02f970ef by Josh Meredith at 2023-05-26T08:35:32-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - 74a2a9d6 by Sylvain Henry at 2023-05-26T08:35:42-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/JS/Ppr.hs - + compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types.hs - compiler/ghc.cabal.in - docs/users_guide/debugging.rst - hadrian/src/Flavour.hs - testsuite/tests/linters/notes.stdout - + testsuite/tests/pmcheck/should_compile/T23445.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -998,8 +998,9 @@ project-version: # Calculate the project version - . ./version.sh - # Download existing ghcup metadata - - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://gitlab.haskell.org/ghc/ghcup-metadata/-/raw/updates/ghcup-0.0.7.yaml" + # Download existing ghcup metadata for the correct year + - PipelineYear="$(date -d $CI_PIPELINE_CREATED_AT +%Y)" + - nix shell nixpkgs#wget -c wget "https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-$PipelineYear-0.0.7.yaml" -O ghcup-0.0.7.yaml - .gitlab/generate_job_metadata @@ -1044,7 +1045,7 @@ ghcup-metadata-nightly: artifacts: false - job: project-version script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: $NIGHTLY @@ -1063,14 +1064,15 @@ ghcup-metadata-nightly-push: artifacts: true script: - git clone https://gitlab.haskell.org/ghc/ghcup-metadata.git - - cp metadata_test.yaml ghcup-metadata/ghcup-0.0.7.yaml + - PipelineYear="$(date -d $CI_PIPELINE_CREATED_AT +%Y)" + - cp metadata_test.yaml "ghcup-metadata/ghcup-nightlies-$PipelineYear-0.0.7.yaml" - cd ghcup-metadata - git config user.email "ghc-ci at gitlab-haskell.org" - git config user.name "GHC GitLab CI" - git remote add gitlab_origin https://oauth2:$PROJECT_PUSH_TOKEN at gitlab.haskell.org/ghc/ghcup-metadata.git - git add . - git commit -m "Update metadata" - - git push gitlab_origin HEAD:updates -o ci.skip + - git push gitlab_origin HEAD:updates rules: # Only run the update on scheduled nightly pipelines, ie once a day - if: $NIGHTLY && $CI_PIPELINE_SOURCE == "schedule" && $CI_COMMIT_BRANCH == "master" @@ -1080,7 +1082,7 @@ ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: '$RELEASE_JOB == "yes"' ===================================== .gitlab/rel_eng/mk-ghcup-metadata/README.mkd ===================================== @@ -18,6 +18,7 @@ options: --release-mode Generate metadata which points to downloads folder --fragment Output the generated fragment rather than whole modified file --version VERSION Version of the GHC compiler + --date DATE Date of the compiler release ``` The script also requires the `.gitlab/jobs-metadata.yaml` file which can be generated ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -63,7 +63,8 @@ eprint(f"Supported platforms: {job_mapping.keys()}") # Artifact precisely specifies a job what the bindist to download is called. class Artifact(NamedTuple): job_name: str - name: str + download_name: str + output_name: str subdir: str # Platform spec provides a specification which is agnostic to Job @@ -72,8 +73,14 @@ class PlatformSpec(NamedTuple): name: str subdir: str -source_artifact = Artifact('source-tarball', 'ghc-{version}-src.tar.xz', 'ghc-{version}' ) -test_artifact = Artifact('source-tarball', 'ghc-{version}-testsuite.tar.xz', 'ghc-{version}' ) +source_artifact = Artifact('source-tarball' + , 'ghc-{version}-src.tar.xz' + , 'ghc-{version}-src.tar.xz' + , 'ghc-{version}' ) +test_artifact = Artifact('source-tarball' + , 'ghc-{version}-testsuite.tar.xz' + , 'ghc-{version}-testsuite.tar.xz' + , 'ghc-{version}' ) def debian(arch, n): return linux_platform(arch, "{arch}-linux-deb{n}".format(arch=arch, n=n)) @@ -104,7 +111,7 @@ def linux_platform(arch, opsys): return PlatformSpec( opsys, 'ghc-{version}-{arch}-unknown-linux'.format(version="{version}", arch=arch) ) -base_url = 'https://gitlab.haskell.org/ghc/ghc/-/jobs/{job_id}/artifacts/raw/{artifact_name}' +base_url = 'https://gitlab.haskell.org/api/v4/projects/1/jobs/{job_id}/artifacts/{artifact_name}' hash_cache = {} @@ -129,7 +136,7 @@ def download_and_hash(url): def mk_one_metadata(release_mode, version, job_map, artifact): job_id = job_map[artifact.job_name].id - url = base_url.format(job_id=job_id, artifact_name=urllib.parse.quote_plus(artifact.name.format(version=version))) + url = base_url.format(job_id=job_id, artifact_name=urllib.parse.quote_plus(artifact.download_name.format(version=version))) # In --release-mode, the URL in the metadata needs to point into the downloads folder # rather then the pipeline. @@ -143,10 +150,13 @@ def mk_one_metadata(release_mode, version, job_map, artifact): eprint(f"Bindist URL: {url}") eprint(f"Download URL: {final_url}") - # Download and hash from the release pipeline, this must not change anyway during upload. + #Download and hash from the release pipeline, this must not change anyway during upload. h = download_and_hash(url) - res = { "dlUri": final_url, "dlSubdir": artifact.subdir.format(version=version), "dlHash" : h } + res = { "dlUri": final_url + , "dlSubdir": artifact.subdir.format(version=version) + , "dlOutput": artifact.output_name.format(version=version) + , "dlHash" : h } eprint(res) return res @@ -155,10 +165,14 @@ def mk_one_metadata(release_mode, version, job_map, artifact): def mk_from_platform(pipeline_type, platform): info = job_mapping[platform.name][pipeline_type] eprint(f"From {platform.name} / {pipeline_type} selecting {info['name']}") - return Artifact(info['name'] , f"{info['jobInfo']['bindistName']}.tar.xz", platform.subdir) + return Artifact(info['name'] + , f"{info['jobInfo']['bindistName']}.tar.xz" + , "ghc-{version}-{pn}.tar.xz".format(version="{version}", pn=platform.name) + , platform.subdir) + # Generate the new metadata for a specific GHC mode etc -def mk_new_yaml(release_mode, version, pipeline_type, job_map): +def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): def mk(platform): eprint("\n=== " + platform.name + " " + ('=' * (75 - len(platform.name)))) return mk_one_metadata(release_mode, version, job_map, mk_from_platform(pipeline_type, platform)) @@ -227,7 +241,14 @@ def mk_new_yaml(release_mode, version, pipeline_type, job_map): else: change_log = "https://gitlab.haskell.org" - return { "viTags": ["Latest", "TODO_base_version"] + if release_mode: + tags = ["Latest", "TODO_base_version"] + else: + tags = ["LatestNightly"] + + + return { "viTags": tags + , "viReleaseDay": date # Check that this link exists , "viChangeLog": change_log , "viSourceDL": source @@ -239,6 +260,15 @@ def mk_new_yaml(release_mode, version, pipeline_type, job_map): } +def setNightlyTags(ghcup_metadata): + for version in ghcup_metadata['ghcupDownloads']['GHC']: + if "LatestNightly" in ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"]: + ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].remove("LatestNightly") + ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly") + + + + def main() -> None: import argparse @@ -249,6 +279,7 @@ def main() -> None: parser.add_argument('--fragment', action='store_true', help='Output the generated fragment rather than whole modified file') # TODO: We could work out the --version from the project-version CI job. parser.add_argument('--version', required=True, type=str, help='Version of the GHC compiler') + parser.add_argument('--date', required=True, type=str, help='Date of the compiler release') args = parser.parse_args() project = gl.projects.get(1, lazy=True) @@ -269,17 +300,21 @@ def main() -> None: eprint(f"Pipeline Type: {pipeline_type}") - new_yaml = mk_new_yaml(args.release_mode, args.version, pipeline_type, job_map) + new_yaml = mk_new_yaml(args.release_mode, args.version, args.date, pipeline_type, job_map) if args.fragment: print(yaml.dump({ args.version : new_yaml })) else: with open(args.metadata, 'r') as file: ghcup_metadata = yaml.safe_load(file) + if args.version in ghcup_metadata['ghcupDownloads']['GHC']: + raise RuntimeError("Refusing to override existing version in metadata") + setNightlyTags(ghcup_metadata) ghcup_metadata['ghcupDownloads']['GHC'][args.version] = new_yaml print(yaml.dump(ghcup_metadata)) + if __name__ == '__main__': main() ===================================== compiler/GHC/Driver/Config/StgToJS.hs ===================================== @@ -20,6 +20,7 @@ initStgToJSConfig dflags = StgToJSConfig , csInlineLoadRegs = False , csInlineEnter = False , csInlineAlloc = False + , csPrettyRender = gopt Opt_DisableJsMinifier dflags , csTraceRts = False , csAssertRts = False , csBoundsCheck = gopt Opt_DoBoundsChecking dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -314,6 +314,9 @@ data GeneralFlag | Opt_WriteInterface -- forces .hi files to be written even with -fno-code | Opt_WriteHie -- generate .hie files + -- JavaScript opts + | Opt_DisableJsMinifier -- ^ render JavaScript pretty-printed instead of minified (compacted) + -- profiling opts | Opt_AutoSccsOnIndividualCafs | Opt_ProfCountEntries ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1861,6 +1861,10 @@ dynamic_flags_deps = [ , (NotDeprecated, customOrUnrecognisedWarning "W" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fwarn-" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fno-warn-" unSetCustomWarningFlag) + ] + + ------ JavaScript flags ----------------------------------------------- + ++ [ make_ord_flag defFlag "ddisable-js-minifier" (NoArg (setGeneralFlag Opt_DisableJsMinifier)) ] ------ Language flags ------------------------------------------------- ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -218,7 +218,7 @@ mkMatchGroup :: AnnoBody p body -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p))) mkMatchGroup origin matches = MG { mg_ext = origin - , mg_alts = matches } + , mg_alts = matches } mkLamCaseMatchGroup :: AnnoBody p body => Origin ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -184,7 +184,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv ) <> semi _ -> empty - strlit xs = docToSDoc (pprStringLit xs) + strlit xs = pprStringLit xs -- the target which will form the root of what we ask rts_evalIO to run the_cfun ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Hs.Syn.Type import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad import GHC.HsToCore.Pmc -import GHC.HsToCore.Pmc.Types ( Nablas, initNablas ) +import GHC.HsToCore.Pmc.Types ( Nablas ) import GHC.HsToCore.Monad import GHC.HsToCore.Binds import GHC.HsToCore.GuardedRHSs @@ -783,16 +783,24 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- Pattern match check warnings for /this match-group/. -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. -- Each Match will split off one Nablas for its RHSs from this. - ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt + ; matches_nablas <- + if isMatchContextPmChecked dflags origin ctxt + + -- See Note [Long-distance information] in GHC.HsToCore.Pmc then addHsScrutTmCs (concat scrs) new_vars $ - -- See Note [Long-distance information] pmcMatches (DsMatchContext ctxt locn) new_vars matches - else pure (initNablasMatches matches) + + -- When we're not doing PM checks on the match group, + -- we still need to propagate long-distance information. + -- See Note [Long-distance information in matchWrapper] + else do { ldi_nablas <- getLdiNablas + ; pure $ initNablasMatches ldi_nablas matches } ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas - ; result_expr <- handleWarnings $ + ; result_expr <- discard_warnings_if_generated origin $ matchEquations ctxt new_vars eqns_info rhs_ty + ; return (new_vars, result_expr) } where -- Called once per equation in the match, or alternative in the case @@ -810,19 +818,67 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches , eqn_orig = FromSource , eqn_rhs = match_result } } - handleWarnings = if isGenerated origin - then discardWarningsDs - else id + discard_warnings_if_generated orig = + if isGenerated orig + then discardWarningsDs + else id + + initNablasMatches :: Nablas -> [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] + initNablasMatches ldi_nablas ms + = map (\(L _ m) -> (ldi_nablas, initNablasGRHSs ldi_nablas (m_grhss m))) ms + + initNablasGRHSs :: Nablas -> GRHSs GhcTc b -> NonEmpty Nablas + initNablasGRHSs ldi_nablas m + = expectJust "GRHSs non-empty" + $ NEL.nonEmpty + $ replicate (length (grhssGRHSs m)) ldi_nablas + +{- Note [Long-distance information in matchWrapper] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The pattern match checking in matchWrapper is done conditionally, depending +on isMatchContextPmChecked. This means that we don't perform pattern match +checking on e.g. generated pattern matches. + +However, when we skip pattern match checking, we still need to keep track +of long-distance information in case we need it in a nested context. + +This came up in #23445. For example: - initNablasMatches :: [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] - initNablasMatches ms - = map (\(L _ m) -> (initNablas, initNablasGRHSs (m_grhss m))) ms + data GADT a where + IsUnit :: GADT () - initNablasGRHSs :: GRHSs GhcTc b -> NonEmpty Nablas - initNablasGRHSs m = expectJust "GRHSs non-empty" - $ NEL.nonEmpty - $ replicate (length (grhssGRHSs m)) initNablas + data Foo b where + FooUnit :: Foo () + FooInt :: Foo Int + data SomeRec = SomeRec { fld :: () } + + bug :: GADT a -> Foo a -> SomeRec -> SomeRec + bug IsUnit foo r = + let gen_fld :: () + gen_fld = case foo of { FooUnit -> () } + in case r of { SomeRec _ -> SomeRec gen_fld } + +Here the body of 'bug' was generated by 'desugarRecordUpd' from the user-written +record update + + cd { fld = case foo of { FooUnit -> () } } + +As a result, we have a generated FunBind gen_fld whose RHS + + case foo of { FooUnit -> () } + +is user-written. This all happens after the GADT pattern match on IsUnit, +which brings into scope the Given equality [G] a ~ (). We need to make sure +that this long distance information is visible when pattern match checking the +user-written case statement. + +To propagate this long-distance information in 'matchWrapper', when we skip +pattern match checks, we make sure to manually pass the long-distance +information to 'mk_eqn_info', which is responsible for recurring further into +the expression (in this case, it will end up recursively calling 'matchWrapper' +on the user-written case statement). +-} matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -39,7 +39,7 @@ module GHC.HsToCore.Pmc ( isMatchContextPmChecked, -- See Note [Long-distance information] - addTyCs, addCoreScrutTmCs, addHsScrutTmCs + addTyCs, addCoreScrutTmCs, addHsScrutTmCs, getLdiNablas ) where import GHC.Prelude @@ -142,8 +142,8 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- Returns one non-empty 'Nablas' for 1.) each pattern of a 'Match' and 2.) -- each of a 'Match'es 'GRHS' for Note [Long-distance information]. -- --- Special case: When there are /no matches/, then the functionassumes it --- checks and @-XEmptyCase@ with only a single match variable. +-- Special case: When there are /no matches/, then the function assumes it +-- checks an @-XEmptyCase@ with only a single match variable. -- See Note [Checking EmptyCase]. pmcMatches :: DsMatchContext -- ^ Match context, for warnings messages ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -30,6 +30,8 @@ module GHC.Iface.Load ( moduleFreeHolesPrecise, needWiredInHomeIface, loadWiredInHomeIface, + WhereFrom(..), + pprModIfaceSimple, ifaceStats, pprModIface, showIface, @@ -1222,3 +1224,20 @@ pprExtensibleFields :: ExtensibleFields -> SDoc pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ toList fs where pprField (name, (BinData size _data)) = text name <+> text "-" <+> ppr size <+> text "bytes" + + +-- | Reason for loading an interface file +-- +-- Used to figure out whether we want to consider loading hi-boot files or not. +data WhereFrom + = ImportByUser IsBootInterface -- Ordinary user import (perhaps {-# SOURCE #-}) + | ImportBySystem -- Non user import. + | ImportByPlugin -- Importing a plugin. + +instance Outputable WhereFrom where + ppr (ImportByUser IsBoot) = text "{- SOURCE -}" + ppr (ImportByUser NotBoot) = empty + ppr ImportBySystem = text "{- SYSTEM -}" + ppr ImportByPlugin = text "{- PLUGIN -}" + + ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TypeApplications #-} -- For Outputable instances for JS syntax {-# OPTIONS_GHC -Wno-orphans #-} @@ -55,12 +56,13 @@ module GHC.JS.Ppr , JsToDoc(..) , defaultRenderJs , RenderJs(..) + , JsRender(..) , jsToDoc , pprStringLit - , braceNest - , hangBrace , interSemi , addSemi + , braceNest + , hangBrace ) where @@ -75,16 +77,15 @@ import Data.List (sortOn) import Numeric(showHex) -import GHC.Utils.Outputable (Outputable (..), docToSDoc) -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map instance Outputable JExpr where - ppr = docToSDoc . renderJs + ppr = renderJs instance Outputable JVal where - ppr = docToSDoc . renderJs + ppr = renderJs -------------------------------------------------------------------------------- -- Top level API @@ -93,87 +94,86 @@ instance Outputable JVal where -- | Render a syntax tree as a pretty-printable document -- (simply showing the resultant doc produces a nice, -- well formatted String). -renderJs :: (JsToDoc a) => a -> Doc +renderJs :: (JsToDoc a) => a -> SDoc renderJs = renderJs' defaultRenderJs -renderJs' :: (JsToDoc a) => RenderJs -> a -> Doc +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs HLine -> a -> HLine #-} +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs SDoc -> a -> SDoc #-} +renderJs' :: (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc renderJs' r = jsToDocR r -data RenderJs = RenderJs - { renderJsS :: !(RenderJs -> JStat -> Doc) - , renderJsE :: !(RenderJs -> JExpr -> Doc) - , renderJsV :: !(RenderJs -> JVal -> Doc) - , renderJsI :: !(RenderJs -> Ident -> Doc) +data RenderJs doc = RenderJs + { renderJsS :: !(JsRender doc => RenderJs doc -> JStat -> doc) + , renderJsE :: !(JsRender doc => RenderJs doc -> JExpr -> doc) + , renderJsV :: !(JsRender doc => RenderJs doc -> JVal -> doc) + , renderJsI :: !(JsRender doc => RenderJs doc -> Ident -> doc) } -defaultRenderJs :: RenderJs +defaultRenderJs :: RenderJs doc defaultRenderJs = RenderJs defRenderJsS defRenderJsE defRenderJsV defRenderJsI -jsToDoc :: JsToDoc a => a -> Doc +jsToDoc :: JsToDoc a => a -> SDoc jsToDoc = jsToDocR defaultRenderJs -- | Render a syntax tree as a pretty-printable document, using a given prefix -- to all generated names. Use this with distinct prefixes to ensure distinct -- generated names between independent calls to render(Prefix)Js. -renderPrefixJs :: (JsToDoc a, JMacro a) => a -> Doc +renderPrefixJs :: (JsToDoc a, JMacro a) => a -> SDoc renderPrefixJs = renderPrefixJs' defaultRenderJs -renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc +renderPrefixJs' :: (JsToDoc a, JMacro a, JsRender doc) => RenderJs doc -> a -> doc renderPrefixJs' r = jsToDocR r -------------------------------------------------------------------------------- -- Code Generator -------------------------------------------------------------------------------- -class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc +class JsToDoc a where jsToDocR :: JsRender doc => RenderJs doc -> a -> doc instance JsToDoc JStat where jsToDocR r = renderJsS r r instance JsToDoc JExpr where jsToDocR r = renderJsE r r instance JsToDoc JVal where jsToDocR r = renderJsV r r instance JsToDoc Ident where jsToDocR r = renderJsI r r -instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) -instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc [JExpr] where jsToDocR r = jcat . map (addSemi . jsToDocR r) +instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) -defRenderJsS :: RenderJs -> JStat -> Doc +defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <> parens (jsToDocR r cond)) - (jsToDocR r x) - $$ mbElse - where mbElse | y == BlockStat [] = PP.empty - | otherwise = hangBrace (text "else") (jsToDocR r y) + IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) + (jnest $ optBlock r x) + <+?> mbElse + where mbElse | y == BlockStat [] = empty + | otherwise = hangBrace (text "else") (jnest $ optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x - DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+> char '=' <+> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <> parens (jsToDocR r p)) (jsToDocR r b) - WhileStat True p b -> (hangBrace (text "do") (jsToDocR r b)) $+$ text "while" <+> parens (jsToDocR r p) - BreakStat l -> maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l - ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l - LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s + DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) + WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l + ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l + LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s where - printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss + printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) where - forCond = parens $ hcat $ interSemi - [ jsToDocR r init - , jsToDocR r p - , parens (jsToDocR r s1) - ] - ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) + forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) where txt | each = "for each" | otherwise = "for" - SwitchStat e l d -> hangBrace (text "switch" <+> parens (jsToDocR r e)) cases - where l' = map (\(c,s) -> (text "case" <+> parens (jsToDocR r c) <> char ':') $$$ (jsToDocR r s)) l ++ [text "default:" $$$ (jsToDocR r d)] - cases = vcat l' + SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases + where l' = map (\(c,s) -> (text "case" <+?> parens (jsToDocR r c) <> colon) $$$ jnest (optBlock r s)) l + ++ [(text "default:") $$$ jnest (optBlock r d)] + cases = foldl1 ($$$) l' ReturnStat e -> text "return" <+> jsToDocR r e - ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) + ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i - <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) - (jsToDocR r b) - TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally - where mbCatch | s1 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) - mbFinally | s2 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "finally") (jsToDocR r s2) + <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) + (jnest $ optBlock r b) + TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally + where mbCatch | s1 == BlockStat [] = empty + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + mbFinally | s2 == BlockStat [] = empty + | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. @@ -183,36 +183,41 @@ defRenderJsS r = \case -- ... -- }); -- - ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] - _ -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x + ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs -optParens :: RenderJs -> JExpr -> Doc +optBlock :: JsRender doc => RenderJs doc -> JStat -> doc +optBlock r x = case x of + BlockStat{} -> jsToDocR r x + _ -> addSemi $ jsToDocR r x + +optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of UOpExpr _ _ -> parens (jsToDocR r x) _ -> jsToDocR r x -defRenderJsE :: RenderJs -> JExpr -> Doc +defRenderJsE :: JsRender doc => RenderJs doc -> JExpr -> doc defRenderJsE r = \case ValExpr x -> jsToDocR r x SelExpr x y -> jsToDocR r x <> char '.' <> jsToDocR r y IdxExpr x y -> jsToDocR r x <> brackets (jsToDocR r y) - IfExpr x y z -> parens (jsToDocR r x <+> char '?' <+> jsToDocR r y <+> char ':' <+> jsToDocR r z) - InfixExpr op x y -> parens $ hsep [jsToDocR r x, ftext (opText op), jsToDocR r y] + IfExpr x y z -> parens (jsToDocR r x <+?> char '?' <+?> jsToDocR r y <+?> colon <+?> jsToDocR r z) + InfixExpr op x y -> parens $ jsToDocR r x <+?> ftext (opText op) <+?> jsToDocR r y UOpExpr op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) - ApplExpr je xs -> jsToDocR r je <> (parens . hsep . punctuate comma $ map (jsToDocR r) xs) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) + ApplExpr je xs -> jsToDocR r je <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs) -defRenderJsV :: RenderJs -> JVal -> Doc +defRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc defRenderJsV r = \case JVar i -> jsToDocR r i - JList xs -> brackets . hsep . punctuate comma $ map (jsToDocR r) xs + JList xs -> brackets . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs JDouble (SaneDouble d) | d < 0 || isNegativeZero d -> parens (double d) | otherwise -> double d @@ -220,17 +225,17 @@ defRenderJsV r = \case | i < 0 -> parens (integer i) | otherwise -> integer i JStr s -> pprStringLit s - JRegEx s -> hcat [char '/',ftext s, char '/'] + JRegEx s -> char '/' <> ftext s <> char '/' JHash m | isNullUniqMap m -> text "{}" - | otherwise -> braceNest . hsep . punctuate comma . - map (\(x,y) -> squotes (ftext x) <> colon <+> jsToDocR r y) + | otherwise -> braceNest . foldl' (<+?>) empty . punctuate comma . + map (\(x,y) -> char '\'' <> ftext x <> char '\'' <> colon <+?> jsToDocR r y) -- nonDetKeysUniqMap doesn't introduce non-determinism here -- because we sort the elements lexically $ sortOn (LexicalFastString . fst) (nonDetUniqMapToList m) - JFunc is b -> parens $ hangBrace (text "function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) + JFunc is b -> parens $ hangBrace (text "function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) -defRenderJsI :: RenderJs -> Ident -> Doc +defRenderJsI :: JsRender doc => RenderJs doc -> Ident -> doc defRenderJsI _ (TxtI t) = ftext t aOpText :: AOp -> FastString @@ -298,17 +303,17 @@ isAlphaOp = \case VoidOp -> True _ -> False -pprStringLit :: FastString -> Doc -pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] +pprStringLit :: IsLine doc => FastString -> doc +pprStringLit s = char '\"' <> encodeJson s <> char '\"' -------------------------------------------------------------------------------- -- Utilities -------------------------------------------------------------------------------- -encodeJson :: FastString -> Doc +encodeJson :: IsLine doc => FastString -> doc encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) -encodeJsonChar :: Char -> Doc +encodeJsonChar :: IsLine doc => Char -> doc encodeJsonChar = \case '/' -> text "\\/" '\b' -> text "\\b" @@ -329,24 +334,54 @@ encodeJsonChar = \case let h = showHex cp "" in text (prefix ++ replicate (pad - length h) '0' ++ h) -braceNest :: Doc -> Doc -braceNest x = char '{' <+> nest 2 x $$ char '}' - -interSemi :: [Doc] -> [Doc] -interSemi [] = [] -interSemi [s] = [s] -interSemi (x:xs) = x <> text ";" : interSemi xs -addSemi :: Doc -> Doc -addSemi x = x <> text ";" - --- | Hang with braces: --- --- hdr { --- body --- } -hangBrace :: Doc -> Doc -> Doc -hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] - -($$$) :: Doc -> Doc -> Doc -x $$$ y = nest 2 $ x $+$ y +interSemi :: JsRender doc => [doc] -> doc +interSemi = foldl ($$$) empty . punctuateFinal semi semi + +addSemi :: IsLine doc => doc -> doc +addSemi x = x <> semi <> char '\n' + +-- | The structure `{body}`, optionally indented over multiple lines +{-# INLINE braceNest #-} +braceNest :: JsRender doc => doc -> doc +braceNest x = lbrace $$$ jnest x $$$ rbrace + +-- | The structure `hdr {body}`, optionally indented over multiple lines +{-# INLINE hangBrace #-} +hangBrace :: JsRender doc => doc -> doc -> doc +hangBrace hdr body = hdr <+?> braceNest body + +-- | JsRender controls the differences in whitespace between HLine and SDoc. +-- Generally, this involves the indentation and newlines in the human-readable +-- SDoc implementation being replaced in the HLine version by the minimal +-- whitespace required for valid JavaScript syntax. +class IsLine doc => JsRender doc where + + -- | Concatenate with an optional single space + (<+?>) :: doc -> doc -> doc + -- | Concatenate with an optional newline + ($$$) :: doc -> doc -> doc + -- | Concatenate these `doc`s, either vertically (SDoc) or horizontally (HLine) + jcat :: [doc] -> doc + -- | Optionally indent the following + jnest :: doc -> doc + +instance JsRender SDoc where + (<+?>) = (<+>) + {-# INLINE (<+?>) #-} + ($$$) = ($$) + {-# INLINE ($$$) #-} + jcat = vcat + {-# INLINE jcat #-} + jnest = nest 2 + {-# INLINE jnest #-} + +instance JsRender HLine where + (<+?>) = (<>) + {-# INLINE (<+?>) #-} + ($$$) = (<>) + {-# INLINE ($$$) #-} + jcat = hcat + {-# INLINE jcat #-} + jnest = id + {-# INLINE jnest #-} ===================================== compiler/GHC/Linker/Deps.hs ===================================== @@ -0,0 +1,411 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections, RecordWildCards #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} + +module GHC.Linker.Deps + ( LinkDepsOpts (..) + , LinkDeps (..) + , getLinkDeps + ) +where + +import GHC.Prelude + +import GHC.Platform.Ways + +import GHC.Runtime.Interpreter + +import GHC.Linker.Types + +import GHC.Types.SourceFile +import GHC.Types.SrcLoc +import GHC.Types.Unique.DSet +import GHC.Types.Unique.DFM + +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Error + +import GHC.Unit.Env +import GHC.Unit.Finder +import GHC.Unit.Module +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.WholeCoreBindings +import GHC.Unit.Module.Deps +import GHC.Unit.Module.Graph +import GHC.Unit.Home.ModInfo + +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr + +import GHC.Utils.Misc +import GHC.Unit.Home +import GHC.Data.Maybe + +import Control.Monad +import Control.Applicative + +import qualified Data.Set as Set +import qualified Data.Map as M +import Data.List (isSuffixOf) +import Data.Either + +import System.FilePath +import System.Directory + + +data LinkDepsOpts = LinkDepsOpts + { ldObjSuffix :: !String -- ^ Suffix of .o files + , ldOneShotMode :: !Bool -- ^ Is the driver in one-shot mode? + , ldModuleGraph :: !ModuleGraph -- ^ Module graph + , ldUnitEnv :: !UnitEnv -- ^ Unit environment + , ldPprOpts :: !SDocContext -- ^ Rendering options for error messages + , ldFinderCache :: !FinderCache -- ^ Finder cache + , ldFinderOpts :: !FinderOpts -- ^ Finder options + , ldUseByteCode :: !Bool -- ^ Use bytecode rather than objects + , ldMsgOpts :: !(DiagnosticOpts IfaceMessage) -- ^ Options for diagnostics + , ldWays :: !Ways -- ^ Enabled ways + , ldLoadIface :: SDoc -> Module -> IO (MaybeErr MissingInterfaceError ModIface) + -- ^ Interface loader function + } + +data LinkDeps = LinkDeps + { ldNeededLinkables :: [Linkable] + , ldAllLinkables :: [Linkable] + , ldUnits :: [UnitId] + , ldNeededUnits :: UniqDSet UnitId + } + +-- | Find all the packages and linkables that a set of modules depends on +-- +-- Return the module and package dependencies for the needed modules. +-- See Note [Object File Dependencies] +-- +-- Fails with an IO exception if it can't find enough files +-- +getLinkDeps + :: LinkDepsOpts + -> Interp + -> LoaderState + -> SrcSpan -- for error messages + -> [Module] -- If you need these + -> IO LinkDeps -- ... then link these first +getLinkDeps opts interp pls span mods = do + -- The interpreter and dynamic linker can only handle object code built + -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky. + -- So here we check the build tag: if we're building a non-standard way + -- then we need to find & link object files built the "normal" way. + maybe_normal_osuf <- checkNonStdWay opts interp span + + get_link_deps opts pls maybe_normal_osuf span mods + + +get_link_deps + :: LinkDepsOpts + -> LoaderState + -> Maybe FilePath -- replace object suffixes? + -> SrcSpan + -> [Module] + -> IO LinkDeps +get_link_deps opts pls maybe_normal_osuf span mods = do + -- 1. Find the dependent home-pkg-modules/packages from each iface + -- (omitting modules from the interactive package, which is already linked) + (mods_s, pkgs_s) <- + -- Why two code paths here? There is a significant amount of repeated work + -- performed calculating transitive dependencies + -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests) + if ldOneShotMode opts + then follow_deps (filterOut isInteractiveModule mods) + emptyUniqDSet emptyUniqDSet; + else do + (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods + return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs)) + + let + -- 2. Exclude ones already linked + -- Main reason: avoid findModule calls in get_linkable + (mods_needed, links_got) = partitionEithers (map split_mods mods_s) + pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls + + split_mods mod = + let is_linked = lookupModuleEnv (objs_loaded pls) mod + <|> lookupModuleEnv (bcos_loaded pls) mod + in case is_linked of + Just linkable -> Right linkable + Nothing -> Left mod + + -- 3. For each dependent module, find its linkable + -- This will either be in the HPT or (in the case of one-shot + -- compilation) we may need to use maybe_getFileLinkable + lnks_needed <- mapM (get_linkable (ldObjSuffix opts)) mods_needed + + return $ LinkDeps + { ldNeededLinkables = lnks_needed + , ldAllLinkables = links_got ++ lnks_needed + , ldUnits = pkgs_needed + , ldNeededUnits = pkgs_s + } + where + mod_graph = ldModuleGraph opts + unit_env = ldUnitEnv opts + + -- This code is used in `--make` mode to calculate the home package and unit dependencies + -- for a set of modules. + -- + -- It is significantly more efficient to use the shared transitive dependency + -- calculation than to compute the transitive dependency set in the same manner as oneShot mode. + + -- It is also a matter of correctness to use the module graph so that dependencies between home units + -- is resolved correctly. + make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) + make_deps_loop found [] = found + make_deps_loop found@(found_units, found_mods) (nk:nexts) + | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts + | otherwise = + case M.lookup (NodeKey_Module nk) (mgTransDeps mod_graph) of + Just trans_deps -> + let deps = Set.insert (NodeKey_Module nk) trans_deps + -- See #936 and the ghci.prog007 test for why we have to continue traversing through + -- boot modules. + todo_boot_mods = [ModNodeKeyWithUid (GWIB mn NotBoot) uid | NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid) <- Set.toList trans_deps] + in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts) + Nothing -> + let (ModNodeKeyWithUid _ uid) = nk + in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts + + mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) + (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) + + all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps] + + get_mod_info (ModNodeKeyWithUid gwib uid) = + case lookupHug (ue_home_unit_graph unit_env) uid (gwib_mod gwib) of + Just hmi -> + let iface = (hm_iface hmi) + mmod = case mi_hsc_src iface of + HsBootFile -> link_boot_mod_error (mi_module iface) + _ -> return $ Just (mi_module iface) + + in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod + Nothing -> throwProgramError opts $ + text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid + + + -- This code is used in one-shot mode to traverse downwards through the HPT + -- to find all link dependencies. + -- The ModIface contains the transitive closure of the module dependencies + -- within the current package, *except* for boot modules: if we encounter + -- a boot module, we have to find its real interface and discover the + -- dependencies of that. Hence we need to traverse the dependency + -- tree recursively. See bug #936, testcase ghci/prog007. + follow_deps :: [Module] -- modules to follow + -> UniqDSet Module -- accum. module dependencies + -> UniqDSet UnitId -- accum. package dependencies + -> IO ([Module], UniqDSet UnitId) -- result + follow_deps [] acc_mods acc_pkgs + = return (uniqDSetToList acc_mods, acc_pkgs) + follow_deps (mod:mods) acc_mods acc_pkgs + = do + mb_iface <- ldLoadIface opts msg mod + iface <- case mb_iface of + Failed err -> throwProgramError opts $ + missingInterfaceErrorDiagnostic (ldMsgOpts opts) err + Succeeded iface -> return iface + + when (mi_boot iface == IsBoot) $ link_boot_mod_error mod + + let + pkg = moduleUnit mod + deps = mi_deps iface + + pkg_deps = dep_direct_pkgs deps + (boot_deps, mod_deps) = flip partitionWith (Set.toList (dep_direct_mods deps)) $ + \case + (_, GWIB m IsBoot) -> Left m + (_, GWIB m NotBoot) -> Right m + + mod_deps' = case ue_homeUnit unit_env of + Nothing -> [] + Just home_unit -> filter (not . (`elementOfUniqDSet` acc_mods)) (map (mkHomeModule home_unit) $ (boot_deps ++ mod_deps)) + acc_mods' = case ue_homeUnit unit_env of + Nothing -> acc_mods + Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) + acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) + + case ue_homeUnit unit_env of + Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) + acc_mods' acc_pkgs' + _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg)) + where + msg = text "need to link module" <+> ppr mod <+> + text "due to use of Template Haskell" + + + + link_boot_mod_error :: Module -> IO a + link_boot_mod_error mod = throwProgramError opts $ + text "module" <+> ppr mod <+> + text "cannot be linked; it is only available as a boot module" + + no_obj :: Outputable a => a -> IO b + no_obj mod = dieWith opts span $ + text "cannot find object file for module " <> + quotes (ppr mod) $$ + while_linking_expr + + while_linking_expr = text "while linking an interpreted expression" + + + -- See Note [Using Byte Code rather than Object Code for Template Haskell] + homeModLinkable :: HomeModInfo -> Maybe Linkable + homeModLinkable hmi = + if ldUseByteCode opts + then homeModInfoByteCode hmi <|> homeModInfoObject hmi + else homeModInfoObject hmi <|> homeModInfoByteCode hmi + + get_linkable osuf mod -- A home-package module + | Just mod_info <- lookupHugByModule mod (ue_home_unit_graph unit_env) + = adjust_linkable (expectJust "getLinkDeps" (homeModLinkable mod_info)) + | otherwise + = do -- It's not in the HPT because we are in one shot mode, + -- so use the Finder to get a ModLocation... + case ue_homeUnit unit_env of + Nothing -> no_obj mod + Just home_unit -> do + + let fc = ldFinderCache opts + let fopts = ldFinderOpts opts + mb_stuff <- findHomeModule fc fopts home_unit (moduleName mod) + case mb_stuff of + Found loc mod -> found loc mod + _ -> no_obj (moduleName mod) + where + found loc mod = do { + -- ...and then find the linkable for it + mb_lnk <- findObjectLinkableMaybe mod loc ; + case mb_lnk of { + Nothing -> no_obj mod ; + Just lnk -> adjust_linkable lnk + }} + + adjust_linkable lnk + | Just new_osuf <- maybe_normal_osuf = do + new_uls <- mapM (adjust_ul new_osuf) + (linkableUnlinked lnk) + return lnk{ linkableUnlinked=new_uls } + | otherwise = + return lnk + + adjust_ul new_osuf (DotO file) = do + massert (osuf `isSuffixOf` file) + let file_base = fromJust (stripExtension osuf file) + new_file = file_base <.> new_osuf + ok <- doesFileExist new_file + if (not ok) + then dieWith opts span $ + text "cannot find object file " + <> quotes (text new_file) $$ while_linking_expr + else return (DotO new_file) + adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp) + adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp) + adjust_ul _ l@(BCOs {}) = return l + adjust_ul _ l at LoadedBCOs{} = return l + adjust_ul _ (CoreBindings (WholeCoreBindings _ mod _)) = pprPanic "Unhydrated core bindings" (ppr mod) + +{- +Note [Using Byte Code rather than Object Code for Template Haskell] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The `-fprefer-byte-code` flag allows a user to specify that they want to use +byte code (if availble) rather than object code for home module dependenices +when executing Template Haskell splices. + +Why might you want to use byte code rather than object code? + +* Producing object code is much slower than producing byte code (for example if you're using -fno-code) +* Linking many large object files, which happens once per splice, is quite expensive. (#21700) + +So we allow the user to choose to use byte code rather than object files if they want to avoid these +two pitfalls. + +When using `-fprefer-byte-code` you have to arrange to have the byte code availble. +In normal --make mode it will not be produced unless you enable `-fbyte-code-and-object-code`. +See Note [Home module build products] for some more information about that. + +The only other place where the flag is consulted is when enabling code generation +with `-fno-code`, which does so to anticipate what decision we will make at the +splice point about what we would prefer. + +-} + +dieWith :: LinkDepsOpts -> SrcSpan -> SDoc -> IO a +dieWith opts span msg = throwProgramError opts (mkLocMessage MCFatal span msg) + +throwProgramError :: LinkDepsOpts -> SDoc -> IO a +throwProgramError opts doc = throwGhcExceptionIO (ProgramError (renderWithContext (ldPprOpts opts) doc)) + +checkNonStdWay :: LinkDepsOpts -> Interp -> SrcSpan -> IO (Maybe FilePath) +checkNonStdWay _opts interp _srcspan + | ExternalInterp {} <- interpInstance interp = return Nothing + -- with -fexternal-interpreter we load the .o files, whatever way + -- they were built. If they were built for a non-std way, then + -- we will use the appropriate variant of the iserv binary to load them. + +-- #if-guard the following equations otherwise the pattern match checker will +-- complain that they are redundant. +#if defined(HAVE_INTERNAL_INTERPRETER) +checkNonStdWay opts _interp srcspan + | hostFullWays == targetFullWays = return Nothing + -- Only if we are compiling with the same ways as GHC is built + -- with, can we dynamically load those object files. (see #3604) + + | ldObjSuffix opts == normalObjectSuffix && not (null targetFullWays) + = failNonStd opts srcspan + + | otherwise = return (Just (hostWayTag ++ "o")) + where + targetFullWays = fullWays (ldWays opts) + hostWayTag = case waysTag hostFullWays of + "" -> "" + tag -> tag ++ "_" + + normalObjectSuffix :: String + normalObjectSuffix = "o" + +data Way' = Normal | Prof | Dyn + +failNonStd :: LinkDepsOpts -> SrcSpan -> IO (Maybe FilePath) +failNonStd opts srcspan = dieWith opts srcspan $ + text "Cannot load" <+> pprWay' compWay <+> + text "objects when GHC is built" <+> pprWay' ghciWay $$ + text "To fix this, either:" $$ + text " (1) Use -fexternal-interpreter, or" $$ + buildTwiceMsg + where compWay + | ldWays opts `hasWay` WayDyn = Dyn + | ldWays opts `hasWay` WayProf = Prof + | otherwise = Normal + ghciWay + | hostIsDynamic = Dyn + | hostIsProfiled = Prof + | otherwise = Normal + buildTwiceMsg = case (ghciWay, compWay) of + (Normal, Dyn) -> dynamicTooMsg + (Dyn, Normal) -> dynamicTooMsg + _ -> + text " (2) Build the program twice: once" <+> + pprWay' ghciWay <> text ", and then" $$ + text " " <> pprWay' compWay <+> + text "using -osuf to set a different object file suffix." + dynamicTooMsg = text " (2) Use -dynamic-too," <+> + text "and use -osuf and -dynosuf to set object file suffixes as needed." + pprWay' :: Way' -> SDoc + pprWay' way = text $ case way of + Normal -> "the normal way" + Prof -> "with -prof" + Dyn -> "with -dynamic" +#endif + ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -50,7 +50,7 @@ import GHC.Tc.Utils.Monad import GHC.Runtime.Interpreter import GHCi.RemoteTypes - +import GHC.Iface.Load import GHC.ByteCode.Linker import GHC.ByteCode.Asm @@ -67,24 +67,18 @@ import GHC.Types.Unique.DFM import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import GHC.Utils.Error import GHC.Utils.Logger import GHC.Utils.TmpFs import GHC.Unit.Env -import GHC.Unit.Finder import GHC.Unit.Module -import GHC.Unit.Module.ModIface -import GHC.Unit.Module.WholeCoreBindings -import GHC.Unit.Module.Deps -import GHC.Unit.Home.ModInfo import GHC.Unit.State as Packages import qualified GHC.Data.ShortText as ST -import qualified GHC.Data.Maybe as Maybes import GHC.Data.FastString +import GHC.Linker.Deps import GHC.Linker.MacOS import GHC.Linker.Dynamic import GHC.Linker.Types @@ -93,10 +87,9 @@ import GHC.Linker.Types import Control.Monad import qualified Data.Set as Set -import qualified Data.Map as M import Data.Char (isSpace) import Data.IORef -import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition) +import Data.List (intercalate, isPrefixOf, nub, partition) import Data.Maybe import Control.Concurrent.MVar import qualified Control.Monad.Catch as MC @@ -112,15 +105,6 @@ import System.Win32.Info (getSystemDirectory) import GHC.Utils.Exception -import GHC.Unit.Module.Graph -import GHC.Types.SourceFile -import GHC.Utils.Misc -import GHC.Iface.Load -import GHC.Unit.Home -import Data.Either -import Control.Applicative -import GHC.Iface.Errors.Ppr - uninitialised :: a uninitialised = panic "Loader not initialised" @@ -207,28 +191,23 @@ loadDependencies -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required loadDependencies interp hsc_env pls span needed_mods = do -- initLoaderState (hsc_dflags hsc_env) dl - let dflags = hsc_dflags hsc_env - -- The interpreter and dynamic linker can only handle object code built - -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky. - -- So here we check the build tag: if we're building a non-standard way - -- then we need to find & link object files built the "normal" way. - maybe_normal_osuf <- checkNonStdWay dflags interp span + let opts = initLinkDepsOpts hsc_env -- Find what packages and linkables are required - (lnks, all_lnks, pkgs, this_pkgs_needed) - <- getLinkDeps hsc_env pls - maybe_normal_osuf span needed_mods + deps <- getLinkDeps opts interp pls span needed_mods + + let this_pkgs_needed = ldNeededUnits deps -- Link the packages and modules required - pls1 <- loadPackages' interp hsc_env pkgs pls - (pls2, succ) <- loadModuleLinkables interp hsc_env pls1 lnks + pls1 <- loadPackages' interp hsc_env (ldUnits deps) pls + (pls2, succ) <- loadModuleLinkables interp hsc_env pls1 (ldNeededLinkables deps) let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed all_pkgs_loaded = pkgs_loaded pls2 trans_pkgs_needed = unionManyUniqDSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg | pkg_id <- uniqDSetToList this_pkgs_needed , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id] ]) - return (pls2, succ, all_lnks, this_pkgs_loaded) + return (pls2, succ, ldAllLinkables deps, this_pkgs_loaded) -- | Temporarily extend the loaded env. @@ -614,315 +593,27 @@ loadExpr interp hsc_env span root_ul_bco = do -- All wired-in names are in the base package, which we link -- by default, so we can safely ignore them here. -dieWith :: DynFlags -> SrcSpan -> SDoc -> IO a -dieWith dflags span msg = throwGhcExceptionIO (ProgramError (showSDoc dflags (mkLocMessage MCFatal span msg))) - - -checkNonStdWay :: DynFlags -> Interp -> SrcSpan -> IO (Maybe FilePath) -checkNonStdWay _dflags interp _srcspan - | ExternalInterp {} <- interpInstance interp = return Nothing - -- with -fexternal-interpreter we load the .o files, whatever way - -- they were built. If they were built for a non-std way, then - -- we will use the appropriate variant of the iserv binary to load them. - --- #if-guard the following equations otherwise the pattern match checker will --- complain that they are redundant. -#if defined(HAVE_INTERNAL_INTERPRETER) -checkNonStdWay dflags _interp srcspan - | hostFullWays == targetFullWays = return Nothing - -- Only if we are compiling with the same ways as GHC is built - -- with, can we dynamically load those object files. (see #3604) - - | objectSuf_ dflags == normalObjectSuffix && not (null targetFullWays) - = failNonStd dflags srcspan - - | otherwise = return (Just (hostWayTag ++ "o")) - where - targetFullWays = fullWays (ways dflags) - hostWayTag = case waysTag hostFullWays of - "" -> "" - tag -> tag ++ "_" - - normalObjectSuffix :: String - normalObjectSuffix = phaseInputExt StopLn - -data Way' = Normal | Prof | Dyn - -failNonStd :: DynFlags -> SrcSpan -> IO (Maybe FilePath) -failNonStd dflags srcspan = dieWith dflags srcspan $ - text "Cannot load" <+> pprWay' compWay <+> - text "objects when GHC is built" <+> pprWay' ghciWay $$ - text "To fix this, either:" $$ - text " (1) Use -fexternal-interpreter, or" $$ - buildTwiceMsg - where compWay - | ways dflags `hasWay` WayDyn = Dyn - | ways dflags `hasWay` WayProf = Prof - | otherwise = Normal - ghciWay - | hostIsDynamic = Dyn - | hostIsProfiled = Prof - | otherwise = Normal - buildTwiceMsg = case (ghciWay, compWay) of - (Normal, Dyn) -> dynamicTooMsg - (Dyn, Normal) -> dynamicTooMsg - _ -> - text " (2) Build the program twice: once" <+> - pprWay' ghciWay <> text ", and then" $$ - text " " <> pprWay' compWay <+> - text "using -osuf to set a different object file suffix." - dynamicTooMsg = text " (2) Use -dynamic-too," <+> - text "and use -osuf and -dynosuf to set object file suffixes as needed." - pprWay' :: Way' -> SDoc - pprWay' way = text $ case way of - Normal -> "the normal way" - Prof -> "with -prof" - Dyn -> "with -dynamic" -#endif - -getLinkDeps :: HscEnv - -> LoaderState - -> Maybe FilePath -- replace object suffixes? - -> SrcSpan -- for error messages - -> [Module] -- If you need these - -> IO ([Linkable], [Linkable], [UnitId], UniqDSet UnitId) -- ... then link these first - -- The module and package dependencies for the needed modules are returned. - -- See Note [Object File Dependencies] --- Fails with an IO exception if it can't find enough files - -getLinkDeps hsc_env pls replace_osuf span mods --- Find all the packages and linkables that a set of modules depends on - = do { - -- 1. Find the dependent home-pkg-modules/packages from each iface - -- (omitting modules from the interactive package, which is already linked) - ; (mods_s, pkgs_s) <- - -- Why two code paths here? There is a significant amount of repeated work - -- performed calculating transitive dependencies - -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests) - if isOneShot (ghcMode dflags) - then follow_deps (filterOut isInteractiveModule mods) - emptyUniqDSet emptyUniqDSet; - else do - (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods - return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs)) - - ; let - -- 2. Exclude ones already linked - -- Main reason: avoid findModule calls in get_linkable - (mods_needed, links_got) = partitionEithers (map split_mods mods_s) - pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls - - split_mods mod = - let is_linked = findModuleLinkable_maybe (objs_loaded pls) mod <|> findModuleLinkable_maybe (bcos_loaded pls) mod - in case is_linked of - Just linkable -> Right linkable - Nothing -> Left mod - - -- 3. For each dependent module, find its linkable - -- This will either be in the HPT or (in the case of one-shot - -- compilation) we may need to use maybe_getFileLinkable - ; let { osuf = objectSuf dflags } - ; lnks_needed <- mapM (get_linkable osuf) mods_needed - - ; return (lnks_needed, links_got ++ lnks_needed, pkgs_needed, pkgs_s) } +initLinkDepsOpts :: HscEnv -> LinkDepsOpts +initLinkDepsOpts hsc_env = opts where + opts = LinkDepsOpts + { ldObjSuffix = objectSuf dflags + , ldOneShotMode = isOneShot (ghcMode dflags) + , ldModuleGraph = hsc_mod_graph hsc_env + , ldUnitEnv = hsc_unit_env hsc_env + , ldLoadIface = load_iface + , ldPprOpts = initSDocContext dflags defaultUserStyle + , ldFinderCache = hsc_FC hsc_env + , ldFinderOpts = initFinderOpts dflags + , ldUseByteCode = gopt Opt_UseBytecodeRatherThanObjects dflags + , ldMsgOpts = initIfaceMessageOpts dflags + , ldWays = ways dflags + } dflags = hsc_dflags hsc_env - mod_graph = hsc_mod_graph hsc_env + load_iface msg mod = initIfaceCheck (text "loader") hsc_env + $ loadInterface msg mod (ImportByUser NotBoot) - -- This code is used in `--make` mode to calculate the home package and unit dependencies - -- for a set of modules. - -- - -- It is significantly more efficient to use the shared transitive dependency - -- calculation than to compute the transitive dependency set in the same manner as oneShot mode. - - -- It is also a matter of correctness to use the module graph so that dependencies between home units - -- is resolved correctly. - make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) - make_deps_loop found [] = found - make_deps_loop found@(found_units, found_mods) (nk:nexts) - | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts - | otherwise = - case M.lookup (NodeKey_Module nk) (mgTransDeps mod_graph) of - Just trans_deps -> - let deps = Set.insert (NodeKey_Module nk) trans_deps - -- See #936 and the ghci.prog007 test for why we have to continue traversing through - -- boot modules. - todo_boot_mods = [ModNodeKeyWithUid (GWIB mn NotBoot) uid | NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid) <- Set.toList trans_deps] - in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts) - Nothing -> - let (ModNodeKeyWithUid _ uid) = nk - in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts - - mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) - (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) - - all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps] - - get_mod_info (ModNodeKeyWithUid gwib uid) = - case lookupHug (hsc_HUG hsc_env) uid (gwib_mod gwib) of - Just hmi -> - let iface = (hm_iface hmi) - mmod = case mi_hsc_src iface of - HsBootFile -> link_boot_mod_error (mi_module iface) - _ -> return $ Just (mi_module iface) - - in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod - Nothing -> - let err = text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid - in throwGhcExceptionIO (ProgramError (showSDoc dflags err)) - - - -- This code is used in one-shot mode to traverse downwards through the HPT - -- to find all link dependencies. - -- The ModIface contains the transitive closure of the module dependencies - -- within the current package, *except* for boot modules: if we encounter - -- a boot module, we have to find its real interface and discover the - -- dependencies of that. Hence we need to traverse the dependency - -- tree recursively. See bug #936, testcase ghci/prog007. - follow_deps :: [Module] -- modules to follow - -> UniqDSet Module -- accum. module dependencies - -> UniqDSet UnitId -- accum. package dependencies - -> IO ([Module], UniqDSet UnitId) -- result - follow_deps [] acc_mods acc_pkgs - = return (uniqDSetToList acc_mods, acc_pkgs) - follow_deps (mod:mods) acc_mods acc_pkgs - = do - mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ - loadInterface msg mod (ImportByUser NotBoot) - iface <- case mb_iface of - Maybes.Failed err -> - let opts = initIfaceMessageOpts dflags - err_txt = missingInterfaceErrorDiagnostic opts err - in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) - Maybes.Succeeded iface -> return iface - - when (mi_boot iface == IsBoot) $ link_boot_mod_error mod - - let - pkg = moduleUnit mod - deps = mi_deps iface - - pkg_deps = dep_direct_pkgs deps - (boot_deps, mod_deps) = flip partitionWith (Set.toList (dep_direct_mods deps)) $ - \case - (_, GWIB m IsBoot) -> Left m - (_, GWIB m NotBoot) -> Right m - - mod_deps' = case hsc_home_unit_maybe hsc_env of - Nothing -> [] - Just home_unit -> filter (not . (`elementOfUniqDSet` acc_mods)) (map (mkHomeModule home_unit) $ (boot_deps ++ mod_deps)) - acc_mods' = case hsc_home_unit_maybe hsc_env of - Nothing -> acc_mods - Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) - - case hsc_home_unit_maybe hsc_env of - Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) - acc_mods' acc_pkgs' - _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg)) - where - msg = text "need to link module" <+> ppr mod <+> - text "due to use of Template Haskell" - - - - link_boot_mod_error :: Module -> IO a - link_boot_mod_error mod = - throwGhcExceptionIO (ProgramError (showSDoc dflags ( - text "module" <+> ppr mod <+> - text "cannot be linked; it is only available as a boot module"))) - - no_obj :: Outputable a => a -> IO b - no_obj mod = dieWith dflags span $ - text "cannot find object file for module " <> - quotes (ppr mod) $$ - while_linking_expr - - while_linking_expr = text "while linking an interpreted expression" - - - -- See Note [Using Byte Code rather than Object Code for Template Haskell] - homeModLinkable :: DynFlags -> HomeModInfo -> Maybe Linkable - homeModLinkable dflags hmi = - if gopt Opt_UseBytecodeRatherThanObjects dflags - then homeModInfoByteCode hmi <|> homeModInfoObject hmi - else homeModInfoObject hmi <|> homeModInfoByteCode hmi - - get_linkable osuf mod -- A home-package module - | Just mod_info <- lookupHugByModule mod (hsc_HUG hsc_env) - = adjust_linkable (Maybes.expectJust "getLinkDeps" (homeModLinkable dflags mod_info)) - | otherwise - = do -- It's not in the HPT because we are in one shot mode, - -- so use the Finder to get a ModLocation... - case hsc_home_unit_maybe hsc_env of - Nothing -> no_obj mod - Just home_unit -> do - - let fc = hsc_FC hsc_env - let dflags = hsc_dflags hsc_env - let fopts = initFinderOpts dflags - mb_stuff <- findHomeModule fc fopts home_unit (moduleName mod) - case mb_stuff of - Found loc mod -> found loc mod - _ -> no_obj (moduleName mod) - where - found loc mod = do { - -- ...and then find the linkable for it - mb_lnk <- findObjectLinkableMaybe mod loc ; - case mb_lnk of { - Nothing -> no_obj mod ; - Just lnk -> adjust_linkable lnk - }} - - adjust_linkable lnk - | Just new_osuf <- replace_osuf = do - new_uls <- mapM (adjust_ul new_osuf) - (linkableUnlinked lnk) - return lnk{ linkableUnlinked=new_uls } - | otherwise = - return lnk - - adjust_ul new_osuf (DotO file) = do - massert (osuf `isSuffixOf` file) - let file_base = fromJust (stripExtension osuf file) - new_file = file_base <.> new_osuf - ok <- doesFileExist new_file - if (not ok) - then dieWith dflags span $ - text "cannot find object file " - <> quotes (text new_file) $$ while_linking_expr - else return (DotO new_file) - adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp) - adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp) - adjust_ul _ l@(BCOs {}) = return l - adjust_ul _ l at LoadedBCOs{} = return l - adjust_ul _ (CoreBindings (WholeCoreBindings _ mod _)) = pprPanic "Unhydrated core bindings" (ppr mod) - -{- -Note [Using Byte Code rather than Object Code for Template Haskell] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The `-fprefer-byte-code` flag allows a user to specify that they want to use -byte code (if availble) rather than object code for home module dependenices -when executing Template Haskell splices. - -Why might you want to use byte code rather than object code? -* Producing object code is much slower than producing byte code (for example if you're using -fno-code) -* Linking many large object files, which happens once per splice, is quite expensive. (#21700) - -So we allow the user to choose to use byte code rather than object files if they want to avoid these -two pitfalls. - -When using `-fprefer-byte-code` you have to arrange to have the byte code availble. -In normal --make mode it will not be produced unless you enable `-fbyte-code-and-object-code`. -See Note [Home module build products] for some more information about that. - -The only other place where the flag is consulted is when enabling code generation -with `-fno-code`, which does so to anticipate what decision we will make at the -splice point about what we would prefer. - --} {- ********************************************************************** @@ -1019,12 +710,9 @@ partitionLinkable li li {linkableUnlinked=li_uls_bco}] _ -> [li] -findModuleLinkable_maybe :: LinkableSet -> Module -> Maybe Linkable -findModuleLinkable_maybe = lookupModuleEnv - linkableInSet :: Linkable -> LinkableSet -> Bool linkableInSet l objs_loaded = - case findModuleLinkable_maybe objs_loaded (linkableModule l) of + case lookupModuleEnv objs_loaded (linkableModule l) of Nothing -> False Just m -> linkableTime l == linkableTime m ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -91,7 +91,7 @@ stgToJS logger config stg_binds0 this_mod spt_entries foreign_stubs cccs output_ -- Doc to dump when -ddump-js is enabled when (logHasDumpFlag logger Opt_D_dump_js) $ do putDumpFileMaybe logger Opt_D_dump_js "JavaScript code" FormatJS - $ vcat (fmap (docToSDoc . jsToDoc . oiStat . luObjUnit) lus) + $ vcat (fmap (jsToDoc . oiStat . luObjUnit) lus) -- Write the object file bh <- openBinMem (4 * 1024 * 1000) -- a bit less than 4kB ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Unit.Types import GHC.Unit.Module (moduleStableString) import GHC.Utils.Outputable hiding ((<>)) +import GHC.Utils.BufHandle import GHC.Utils.Panic import GHC.Utils.Error import GHC.Utils.Logger (Logger, logVerbAtLeast) @@ -80,7 +81,6 @@ import Control.Monad import Data.Array import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import Data.Function (on) @@ -118,6 +118,9 @@ newtype ArchiveState = ArchiveState { loadedArchives :: IORef (Map FilePath Ar.A emptyArchiveState :: IO ArchiveState emptyArchiveState = ArchiveState <$> newIORef M.empty +defaultJsContext :: SDocContext +defaultJsContext = defaultSDocContext{sdocStyle = PprCode} + jsLinkBinary :: JSLinkConfig -> StgToJSConfig @@ -173,7 +176,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- LTO + rendering of JS code link_stats <- withBinaryFile (out "out.js") WriteMode $ \h -> - renderLinker h mods jsFiles + renderLinker h (csPrettyRender cfg) mods jsFiles ------------------------------------------------------------- @@ -194,8 +197,13 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do - BL.writeFile (out "rts.js") ( BLC.pack rtsDeclsText - <> BLC.pack (rtsText cfg)) + withFile (out "rts.js") WriteMode $ \h -> do + if csPrettyRender cfg + then printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) + bFlush bh -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -302,10 +310,11 @@ data CompactedModuleCode = CompactedModuleCode -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle + -> Bool -- ^ should we render readable JS for debugging? -> [ModuleCode] -- ^ linked code per module -> [FilePath] -- ^ additional JS files -> IO LinkerStats -renderLinker h mods jsFiles = do +renderLinker h render_pretty mods jsFiles = do -- link modules let (compacted_mods, meta) = linkModules mods @@ -314,8 +323,14 @@ renderLinker h mods jsFiles = do putBS = B.hPut h putJS x = do before <- hTell h - Ppr.printLeftRender h (pretty x) - hPutChar h '\n' + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) + else do + bh <- newBufHandle h + -- Append an empty line to correctly end the file in a newline + bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) + bFlush bh after <- hTell h pure $! (after - before) ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -31,7 +31,7 @@ import GHC.Exts import GHC.JS.Syntax import GHC.JS.Ppr -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map @@ -39,10 +39,10 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JStat -> Doc +pretty :: JsRender doc => JStat -> doc pretty = jsToDocR ghcjsRenderJs -ghcjsRenderJs :: RenderJs +ghcjsRenderJs :: RenderJs doc ghcjsRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS @@ -52,7 +52,7 @@ ghcjsRenderJs = defaultRenderJs hdd :: SBS.ShortByteString hdd = SBS.pack (map (fromIntegral . ord) "h$$") -ghcjsRenderJsI :: RenderJs -> Ident -> Doc +ghcjsRenderJsI :: IsLine doc => RenderJs doc -> Ident -> doc ghcjsRenderJsI _ (TxtI fs) -- Fresh symbols are prefixed with "h$$". They aren't explicitly referred by -- name in user code, only in compiled code. Hence we can rename them if we do @@ -75,7 +75,7 @@ ghcjsRenderJsI _ (TxtI fs) -- | Render as an hexadecimal number in reversed order (because it's faster and we -- don't care about the actual value). -hexDoc :: Word -> Doc +hexDoc :: IsLine doc => Word -> doc hexDoc 0 = char '0' hexDoc v = text $ go v where @@ -91,23 +91,23 @@ hexDoc v = text $ go v -- attempt to resugar some of the common constructs -ghcjsRenderJsS :: RenderJs -> JStat -> Doc +ghcjsRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc ghcjsRenderJsS r s = renderJsS defaultRenderJs r s -- don't quote keys in our object literals, so closure compiler works -ghcjsRenderJsV :: RenderJs -> JVal -> Doc +ghcjsRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc ghcjsRenderJsV r (JHash m) | isNullUniqMap m = text "{}" - | otherwise = braceNest . PP.fsep . punctuate comma . - map (\(x,y) -> quoteIfRequired x <> PP.colon <+> jsToDocR r y) + | otherwise = braceNest . fsep . punctuate comma . + map (\(x,y) -> quoteIfRequired x <> colon <+> jsToDocR r y) -- nonDetEltsUniqMap doesn't introduce non-determinism here because -- we sort the elements lexically . sortOn (LexicalFastString . fst) $ nonDetUniqMapToList m where - quoteIfRequired :: FastString -> Doc + quoteIfRequired :: IsLine doc => FastString -> doc quoteIfRequired x | isUnquotedKey x = ftext x - | otherwise = PP.squotes (ftext x) + | otherwise = char '\'' <> ftext x <> char '\'' isUnquotedKey :: FastString -> Bool isUnquotedKey fs = case unpackFS fs of ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -O0 #-} @@ -45,6 +46,7 @@ import GHC.StgToJS.Linker.Opt import GHC.Data.FastString import GHC.Types.Unique.Map +import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -314,12 +316,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRets] -- | print the embedded RTS to a String -rtsText :: StgToJSConfig -> String -rtsText = show . pretty . jsOptimize . rts +rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc +rtsText = pretty @doc . jsOptimize . rts -- | print the RTS declarations to a String. -rtsDeclsText :: String -rtsDeclsText = show . pretty . jsOptimize $ rtsDecls +rtsDeclsText :: forall doc. JsRender doc => doc +rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' rts :: StgToJSConfig -> Sat.JStat ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -86,6 +86,7 @@ data StgToJSConfig = StgToJSConfig , csInlineLoadRegs :: !Bool , csInlineEnter :: !Bool , csInlineAlloc :: !Bool + , csPrettyRender :: !Bool , csTraceRts :: !Bool , csAssertRts :: !Bool , csBoundsCheck :: !Bool ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1070,7 +1070,7 @@ Wrinkle [GADT result type in tcRecordUpd] -} --- | Desugars a record update @record_expr { fld1 = e1, fld2 = e2}@ into a case expression +-- | Desugars a record update @record_expr { fld1 = e1, fld2 = e2 }@ into a case expression -- that matches on the constructors of the record @r@, as described in -- Note [Record Updates]. -- ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -42,7 +42,7 @@ module GHC.Tc.Types( -- Renamer types ErrCtxt, pushErrCtxt, pushErrCtxtSameOrigin, ImportAvails(..), emptyImportAvails, plusImportAvails, - WhereFrom(..), mkModDeps, + mkModDeps, -- Typechecker types TcTypeEnv, TcBinderStack, TcBinder(..), @@ -1407,29 +1407,6 @@ plusImportAvails imp_orphs = unionListsOrd orphs1 orphs2, imp_finsts = unionListsOrd finsts1 finsts2 } -{- -************************************************************************ -* * -\subsection{Where from} -* * -************************************************************************ - -The @WhereFrom@ type controls where the renamer looks for an interface file --} - -data WhereFrom - = ImportByUser IsBootInterface -- Ordinary user import (perhaps {-# SOURCE #-}) - | ImportBySystem -- Non user import. - | ImportByPlugin -- Importing a plugin; - -- See Note [Care with plugin imports] in GHC.Iface.Load - -instance Outputable WhereFrom where - ppr (ImportByUser IsBoot) = text "{- SOURCE -}" - ppr (ImportByUser NotBoot) = empty - ppr ImportBySystem = text "{- SYSTEM -}" - ppr ImportByPlugin = text "{- PLUGIN -}" - - {- ********************************************************************* * * Type signatures ===================================== compiler/ghc.cabal.in ===================================== @@ -541,6 +541,7 @@ Library GHC.JS.Unsat.Syntax GHC.Linker GHC.Linker.Config + GHC.Linker.Deps GHC.Linker.Dynamic GHC.Linker.ExtraObj GHC.Linker.Loader ===================================== docs/users_guide/debugging.rst ===================================== @@ -723,6 +723,16 @@ assembler. Dump the final JavaScript code produced by the JavaScript code generator. +JavaScript code generator +~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. ghc-flag:: -ddisable-js-minifier + :shortdesc: Generate pretty-printed JavaScript code instead of minified (compacted) code. + :type: dynamic + + Include human-readable spacing and indentation when generating JavaScript. + + Miscellaneous backend dumps ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== hadrian/src/Flavour.hs ===================================== @@ -145,11 +145,13 @@ enableDebugInfo = addArgs $ notStage0 ? mconcat -- | Enable the ticky-ticky profiler in stage2 GHC enableTickyGhc :: Flavour -> Flavour -enableTickyGhc = - addArgs $ orM [stage1, cross] ? mconcat +enableTickyGhc f = + (addArgs (orM [stage1, cross] ? mconcat [ builder (Ghc CompileHs) ? tickyArgs , builder (Ghc LinkHs) ? tickyArgs - ] + ]) f) { ghcThreaded = (< Stage2) } + -- Build single-threaded ghc because ticky profiling is racy with threaded + -- RTS and the C counters are disabled. (See #23439) tickyArgs :: Args tickyArgs = mconcat ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -37,7 +37,6 @@ ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fres ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] ===================================== testsuite/tests/pmcheck/should_compile/T23445.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs #-} + +module T23445 where + +data GADT a where + IsUnit :: GADT () + +data Foo b where + FooUnit :: Foo () + FooInt :: Foo Int + +data SomeRec = SomeRec { fld :: () } + +bug :: GADT a -> Foo a -> SomeRec -> SomeRec +bug IsUnit foo r = + r { fld = case foo of { FooUnit -> () } } ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -112,6 +112,10 @@ test('CaseOfKnownCon', [], compile, [overlapping_incomplete]) test('TooManyDeltas', [], compile, [overlapping_incomplete+'-fmax-pmcheck-models=0']) test('LongDistanceInfo', [], compile, [overlapping_incomplete]) test('T21662', [], compile, [overlapping_incomplete]) +test('T19271', [], compile, [overlapping_incomplete]) +test('T21761', [], compile, [overlapping_incomplete]) +test('T22964', [], compile, [overlapping_incomplete]) +test('T23445', [], compile, [overlapping_incomplete]) # Series (inspired) by Luke Maranget @@ -156,6 +160,4 @@ test('EmptyCase007', [], compile, [overlapping_incomplete]) test('EmptyCase008', [], compile, [overlapping_incomplete]) test('EmptyCase009', [], compile, [overlapping_incomplete]) test('EmptyCase010', [], compile, [overlapping_incomplete]) -test('T19271', [], compile, [overlapping_incomplete]) -test('T21761', [], compile, [overlapping_incomplete]) -test('T22964', [], compile, [overlapping_incomplete]) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1882aed59297fd4ae492d577dedfc88eefc5bca8...74a2a9d636575f5dda7a33f824ece32e75dc8584 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1882aed59297fd4ae492d577dedfc88eefc5bca8...74a2a9d636575f5dda7a33f824ece32e75dc8584 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 12:57:36 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 26 May 2023 08:57:36 -0400 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.2.8-release Message-ID: <6470acc0c48b3_64cfb16604f946071ed@gitlab.mail> Zubin pushed new tag ghc-9.2.8-release at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.2.8-release You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 13:06:04 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 26 May 2023 09:06:04 -0400 Subject: [Git][ghc/ghc][wip/js-th] Remove InteractiveContext update Message-ID: <6470aebc1b662_64cfb362c17cc607589@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: f411c496 by Sylvain Henry at 2023-05-26T15:10:51+02:00 Remove InteractiveContext update - - - - - 1 changed file: - compiler/GHC/Driver/Main.hs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1858,7 +1858,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do c `seqList` d `seqList` (seqEltsUFM (seqTagSig) tag_env)) - (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds) + (myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) False this_mod location prepd_binds) let cost_centre_info = (late_local_ccs ++ caf_ccs, caf_cc_stacks) @@ -1980,7 +1980,7 @@ hscInteractive hsc_env cgguts location = do -- omit it here (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _ignore_stg_cg_infos) <- {-# SCC "CoreToStg" #-} - myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds + myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) True this_mod location prepd_binds ----------------- Generate byte code ------------------ comp_bc <- byteCodeGen hsc_env this_mod stg_binds data_tycons mod_breaks ------------------ Create f-x-dynamic C-side stuff ----- @@ -2155,21 +2155,21 @@ doCodeGen hsc_env this_mod denv data_tycons return $ Stream.mapM dump2 $ generateCgIPEStub hsc_env this_mod denv pipeline_stream -myCoreToStg :: Logger -> DynFlags -> InteractiveContext +myCoreToStg :: Logger -> DynFlags -> [Var] -> Bool -> Module -> ModLocation -> CoreProgram -> IO ( [CgStgTopBinding] -- output program , InfoTableProvMap , CollectedCCs -- CAF cost centre info (declared and used) , StgCgInfos ) -myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do +myCoreToStg logger dflags ic_inscope for_bytecode this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg (initCoreToStgOpts dflags) this_mod ml prepd_binds (stg_binds_with_fvs,stg_cg_info) <- {-# SCC "Stg2Stg" #-} - stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode) + stg2stg logger ic_inscope (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG @@ -2330,7 +2330,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) - (hsc_IC hsc_env) + (interactiveInScope (hsc_IC hsc_env)) True this_mod iNTERACTIVELoc @@ -2575,24 +2575,23 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } - let ictxt = (hsc_IC hsc_env) { - ic_mod_index = getKey u - -- Ensure module uniqueness ("GhciNNNN") by reusing the unique - -- we've used for the binding. If ic_mod_index was mutable, we - -- would simply bump it here after its use. - -- - -- This uniqueness is needed by the JS linker. Without it we - -- break the 1-1 relationship between modules and object - -- files, i.e. we get different object files for the same module - -- and the JS linker doesn't support this. - } - let this_mod = icInteractiveModule ictxt + -- Ensure module uniqueness by giving it a name like "GhciNNNN". + -- This uniqueness is needed by the JS linker. Without it we break the 1-1 + -- relationship between modules and object files, i.e. we get different object + -- files for the same module and the JS linker doesn't support this. + -- + -- Note that we can't use icInteractiveModule because the ic_mod_index value + -- isn't bumped between invocations of hscCompileExpr, so uniqueness isn't + -- guaranteed. + -- + -- We reuse the unique we obtained for the binding, but any unique would do. + let this_mod = mkInteractiveModule (getKey u) let for_bytecode = True (stg_binds, _prov_map, _collected_ccs, _stg_cg_infos) <- myCoreToStg logger dflags - ictxt + (interactiveInScope (hsc_IC hsc_env)) for_bytecode this_mod this_loc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f411c496451d6b9aafaad3520aa2b25434e49a0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f411c496451d6b9aafaad3520aa2b25434e49a0d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 13:09:41 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 26 May 2023 09:09:41 -0400 Subject: [Git][ghc/ghc][wip/js-th] JS: implement TH support Message-ID: <6470af951aae5_64cfb33b42b9c6083b1@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: bdd3f754 by Sylvain Henry at 2023-05-26T15:15:08+02:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Types.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/ghc.cabal.in - + ghc-interp.js - hadrian/src/Base.hs - hadrian/src/Rules/Generate.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - libraries/template-haskell/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/annotations/should_compile/all.T - testsuite/tests/annotations/should_fail/all.T - testsuite/tests/annotations/should_run/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bdd3f75448a26b0e1ed648de5bd210aadc8d68c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bdd3f75448a26b0e1ed648de5bd210aadc8d68c6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 13:54:19 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 26 May 2023 09:54:19 -0400 Subject: [Git][ghc/ghc][wip/t21766] Remove IPE enabled builds from CI Message-ID: <6470ba0b5bfdd_64cfb31e4e46461378e@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 228d5a24 by Finley McIlwaine at 2023-05-26T07:51:26-06:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -142,7 +142,6 @@ data BuildConfig , withAssertions :: Bool , withNuma :: Bool , withZstd :: Bool - , withIpe :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -171,8 +170,7 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts [FullyStatic | fullyStatic] ++ [ThreadSanitiser | threadSanitiser] ++ [NoSplitSections | noSplitSections, buildFlavour == Release ] ++ - [BootNonmovingGc | validateNonmovingGc ] ++ - [Ipe | withIpe] + [BootNonmovingGc | validateNonmovingGc ] data Flavour = Flavour BaseFlavour [FlavourTrans] @@ -183,7 +181,6 @@ data FlavourTrans = | ThreadSanitiser | NoSplitSections | BootNonmovingGc - | Ipe data BaseFlavour = Release | Validate | SlowValidate deriving Eq @@ -202,7 +199,6 @@ vanilla = BuildConfig , withAssertions = False , withNuma = False , withZstd = False - , withIpe = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -235,10 +231,8 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -ipe :: BuildConfig -ipe = vanilla { withIpe = True - , withZstd = True - } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } static :: BuildConfig static = vanilla { fullyStatic = True } @@ -341,7 +335,6 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f flavour_string ThreadSanitiser = "thread_sanitizer" flavour_string NoSplitSections = "no_split_sections" flavour_string BootNonmovingGc = "boot_nonmoving_gc" - flavour_string Ipe = "ipe" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -893,7 +886,7 @@ job_groups = , validateBuilds Amd64 (Linux Debian10) nativeInt , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) , fastCI (validateBuilds Amd64 (Linux Debian10) debug) - , disableValidate (validateBuilds Amd64 (Linux Debian10) ipe) + , disableValidate (validateBuilds Amd64 (Linux Debian10) zstdIpe) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure (modifyValidateJobs manual tsan_jobs) @@ -901,7 +894,7 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) ipe) + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) , disableValidate (standardBuilds Amd64 (Linux Debian11)) -- We still build Deb9 bindists for now due to Ubuntu 18 and Linux Mint 19 -- not being at EOL until April 2023 and they still need tinfo5. ===================================== .gitlab/jobs.yaml ===================================== @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1264,7 +1264,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1328,65 +1328,6 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb10-validate+ipe": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "8 weeks", - "paths": [ - "ghc-x86_64-linux-deb10-validate+ipe.tar.xz", - "junit.xml" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb10-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+ipe", - "BUILD_FLAVOUR": "validate+ipe", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", - "TEST_ENV": "x86_64-linux-deb10-validate+ipe", - "XZ_OPT": "-9" - } - }, "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -2701,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3869,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3930,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4189,7 +4130,7 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, - "x86_64-linux-deb10-validate+debug_info": { + "x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -4199,7 +4140,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "ghc-x86_64-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -4224,7 +4165,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4241,13 +4182,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", - "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate" } }, - "x86_64-linux-deb10-validate+ipe": { + "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -4257,7 +4198,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+ipe.tar.xz", + "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", "junit.xml" ], "reports": { @@ -4282,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4299,10 +4240,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+ipe", - "BUILD_FLAVOUR": "validate+ipe", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", - "TEST_ENV": "x86_64-linux-deb10-validate+ipe" + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", + "BUILD_FLAVOUR": "validate+debug_info", + "CONFIGURE_ARGS": "", + "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, "x86_64-linux-deb10-validate+llvm": { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/228d5a2479b2712ee6d5dfd80921e01bcebae0dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/228d5a2479b2712ee6d5dfd80921e01bcebae0dc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 13:57:02 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 26 May 2023 09:57:02 -0400 Subject: [Git][ghc/ghc][wip/t21766] 13 commits: rts: Build ticky GHC with single-threaded RTS Message-ID: <6470baae1a56e_64cfb296177306160df@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - 46ea4bbe by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 1629de0a by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 803b2ac7 by Finley McIlwaine at 2023-05-26T13:56:32+00:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 07f2df7d by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 57ec3de2 by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Add note describing IPE data compression See ticket #21766 - - - - - d4b11464 by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 47aed822 by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 1f22f942 by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 9e80b722 by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - dc532d04 by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 220c546a by Finley McIlwaine at 2023-05-26T13:56:32+00:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 29 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - rts/IPE.c - rts/IPE.h - rts/include/rts/IPE.h - rts/rts.cabal.in - + testsuite/tests/pmcheck/should_compile/T23445.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/rts/ipe/ipeEventLog_fromMap.c - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - testsuite/tests/rts/ipe/ipe_lib.h Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -141,6 +141,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -154,10 +155,11 @@ data BuildConfig -- Extra arguments to pass to ./configure due to the BuildConfig configureArgsStr :: BuildConfig -> String configureArgsStr bc = unwords $ - ["--enable-unregisterised"| unregisterised bc ] + ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ] + ++ ["--enable-ipe-data-compression" | withZstd bc ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -172,8 +174,12 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts data Flavour = Flavour BaseFlavour [FlavourTrans] -data FlavourTrans - = Llvm | Dwarf | FullyStatic | ThreadSanitiser | NoSplitSections +data FlavourTrans = + Llvm + | Dwarf + | FullyStatic + | ThreadSanitiser + | NoSplitSections | BootNonmovingGc data BaseFlavour = Release | Validate | SlowValidate deriving Eq @@ -192,6 +198,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -224,6 +231,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -313,18 +323,18 @@ testEnv arch opsys bc = intercalate "-" $ -- | The hadrian flavour string we are going to use for this build flavourString :: Flavour -> String -flavourString (Flavour base trans) = baseString base ++ concatMap (("+" ++) . flavourString) trans +flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . flavour_string) trans where - baseString Release = "release" - baseString Validate = "validate" - baseString SlowValidate = "slow-validate" + base_string Release = "release" + base_string Validate = "validate" + base_string SlowValidate = "slow-validate" - flavourString Llvm = "llvm" - flavourString Dwarf = "debug_info" - flavourString FullyStatic = "fully_static" - flavourString ThreadSanitiser = "thread_sanitizer" - flavourString NoSplitSections = "no_split_sections" - flavourString BootNonmovingGc = "boot_nonmoving_gc" + flavour_string Llvm = "llvm" + flavour_string Dwarf = "debug_info" + flavour_string FullyStatic = "fully_static" + flavour_string ThreadSanitiser = "thread_sanitizer" + flavour_string NoSplitSections = "no_split_sections" + flavour_string BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -517,7 +527,7 @@ manualRule rules = rules { when = Manual } -- For example, even if you don't explicitly disable a rule it will end up in the -- rule list with the OFF state. enumRules :: OnOffRules -> [OnOffRule] -enumRules o = map lkup rules +enumRules o = map lkup rulesList where enabled_rules = rule_set o lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r @@ -553,6 +563,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. | NonmovingGc -- ^ Only run this job when the "non-moving GC" label is set. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -579,12 +590,14 @@ ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" ruleString Off Nightly = "$NIGHTLY == null" +ruleString On IpeData = "$CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/" +ruleString Off IpeData = true ruleString On Disable = false ruleString Off Disable = true -- Enumeration of all the rules -rules :: [Rule] -rules = [minBound .. maxBound] +rulesList :: [Rule] +rulesList = [minBound .. maxBound] -- | A 'Job' is the description of a single job in a gitlab pipeline. The -- job contains all the information about how to do the build but can be further @@ -873,6 +886,7 @@ job_groups = , validateBuilds Amd64 (Linux Debian10) nativeInt , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) , fastCI (validateBuilds Amd64 (Linux Debian10) debug) + , disableValidate (validateBuilds Amd64 (Linux Debian10) zstdIpe) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure (modifyValidateJobs manual tsan_jobs) @@ -880,7 +894,7 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) , disableValidate (standardBuilds Amd64 (Linux Debian11)) -- We still build Deb9 bindists for now due to Ubuntu 18 and Linux Mint 19 -- not being at EOL until April 2023 and they still need tinfo5. ===================================== .gitlab/jobs.yaml ===================================== @@ -35,7 +35,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -97,7 +97,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -155,7 +155,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -276,7 +276,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -335,7 +335,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -394,7 +394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -453,7 +453,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -518,7 +518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -579,7 +579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -948,7 +948,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1126,7 +1126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1264,7 +1264,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4130,6 +4130,64 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, + "x86_64-linux-deb10-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "2 weeks", + "paths": [ + "ghc-x86_64-linux-deb10-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb10-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate" + } + }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4165,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4223,7 +4281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4282,7 +4340,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4342,7 +4400,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4402,7 +4460,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4463,7 +4521,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4522,7 +4580,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4578,7 +4636,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -218,7 +218,7 @@ mkMatchGroup :: AnnoBody p body -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p))) mkMatchGroup origin matches = MG { mg_ext = origin - , mg_alts = matches } + , mg_alts = matches } mkLamCaseMatchGroup :: AnnoBody p body => Origin ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Hs.Syn.Type import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad import GHC.HsToCore.Pmc -import GHC.HsToCore.Pmc.Types ( Nablas, initNablas ) +import GHC.HsToCore.Pmc.Types ( Nablas ) import GHC.HsToCore.Monad import GHC.HsToCore.Binds import GHC.HsToCore.GuardedRHSs @@ -783,16 +783,24 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- Pattern match check warnings for /this match-group/. -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. -- Each Match will split off one Nablas for its RHSs from this. - ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt + ; matches_nablas <- + if isMatchContextPmChecked dflags origin ctxt + + -- See Note [Long-distance information] in GHC.HsToCore.Pmc then addHsScrutTmCs (concat scrs) new_vars $ - -- See Note [Long-distance information] pmcMatches (DsMatchContext ctxt locn) new_vars matches - else pure (initNablasMatches matches) + + -- When we're not doing PM checks on the match group, + -- we still need to propagate long-distance information. + -- See Note [Long-distance information in matchWrapper] + else do { ldi_nablas <- getLdiNablas + ; pure $ initNablasMatches ldi_nablas matches } ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas - ; result_expr <- handleWarnings $ + ; result_expr <- discard_warnings_if_generated origin $ matchEquations ctxt new_vars eqns_info rhs_ty + ; return (new_vars, result_expr) } where -- Called once per equation in the match, or alternative in the case @@ -810,19 +818,67 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches , eqn_orig = FromSource , eqn_rhs = match_result } } - handleWarnings = if isGenerated origin - then discardWarningsDs - else id + discard_warnings_if_generated orig = + if isGenerated orig + then discardWarningsDs + else id + + initNablasMatches :: Nablas -> [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] + initNablasMatches ldi_nablas ms + = map (\(L _ m) -> (ldi_nablas, initNablasGRHSs ldi_nablas (m_grhss m))) ms + + initNablasGRHSs :: Nablas -> GRHSs GhcTc b -> NonEmpty Nablas + initNablasGRHSs ldi_nablas m + = expectJust "GRHSs non-empty" + $ NEL.nonEmpty + $ replicate (length (grhssGRHSs m)) ldi_nablas + +{- Note [Long-distance information in matchWrapper] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The pattern match checking in matchWrapper is done conditionally, depending +on isMatchContextPmChecked. This means that we don't perform pattern match +checking on e.g. generated pattern matches. + +However, when we skip pattern match checking, we still need to keep track +of long-distance information in case we need it in a nested context. + +This came up in #23445. For example: - initNablasMatches :: [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] - initNablasMatches ms - = map (\(L _ m) -> (initNablas, initNablasGRHSs (m_grhss m))) ms + data GADT a where + IsUnit :: GADT () - initNablasGRHSs :: GRHSs GhcTc b -> NonEmpty Nablas - initNablasGRHSs m = expectJust "GRHSs non-empty" - $ NEL.nonEmpty - $ replicate (length (grhssGRHSs m)) initNablas + data Foo b where + FooUnit :: Foo () + FooInt :: Foo Int + data SomeRec = SomeRec { fld :: () } + + bug :: GADT a -> Foo a -> SomeRec -> SomeRec + bug IsUnit foo r = + let gen_fld :: () + gen_fld = case foo of { FooUnit -> () } + in case r of { SomeRec _ -> SomeRec gen_fld } + +Here the body of 'bug' was generated by 'desugarRecordUpd' from the user-written +record update + + cd { fld = case foo of { FooUnit -> () } } + +As a result, we have a generated FunBind gen_fld whose RHS + + case foo of { FooUnit -> () } + +is user-written. This all happens after the GADT pattern match on IsUnit, +which brings into scope the Given equality [G] a ~ (). We need to make sure +that this long distance information is visible when pattern match checking the +user-written case statement. + +To propagate this long-distance information in 'matchWrapper', when we skip +pattern match checks, we make sure to manually pass the long-distance +information to 'mk_eqn_info', which is responsible for recurring further into +the expression (in this case, it will end up recursively calling 'matchWrapper' +on the user-written case statement). +-} matchEquations :: HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -39,7 +39,7 @@ module GHC.HsToCore.Pmc ( isMatchContextPmChecked, -- See Note [Long-distance information] - addTyCs, addCoreScrutTmCs, addHsScrutTmCs + addTyCs, addCoreScrutTmCs, addHsScrutTmCs, getLdiNablas ) where import GHC.Prelude @@ -142,8 +142,8 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- Returns one non-empty 'Nablas' for 1.) each pattern of a 'Match' and 2.) -- each of a 'Match'es 'GRHS' for Note [Long-distance information]. -- --- Special case: When there are /no matches/, then the functionassumes it --- checks and @-XEmptyCase@ with only a single match variable. +-- Special case: When there are /no matches/, then the function assumes it +-- checks an @-XEmptyCase@ with only a single match variable. -- See Note [Checking EmptyCase]. pmcMatches :: DsMatchContext -- ^ Match context, for warnings messages ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,67 +1,188 @@ +{-# LANGUAGE CPP #-} + module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where +import Foreign + +#if defined(HAVE_LIBZSTD) +import Foreign.C.Types +import qualified Data.ByteString.Internal as BSI +import GHC.IO (unsafePerformIO) +#endif + import GHC.Prelude import GHC.Platform +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Unit.Module import GHC.Utils.Outputable -import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..)) +import GHC.Cmm import GHC.Cmm.CLabel -import GHC.Cmm.Expr import GHC.Cmm.Utils import GHC.StgToCmm.Config -import GHC.StgToCmm.Lit (newByteStringCLit) import GHC.StgToCmm.Monad -import GHC.StgToCmm.Utils import GHC.Data.ShortText (ShortText) import qualified GHC.Data.ShortText as ST -import qualified Data.Map.Strict as M import Control.Monad.Trans.State.Strict + import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Lazy as BSL +import qualified Data.Map.Strict as M + +{- +Note [Compression and Decompression of IPE data] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Compiling with `-finfo-table-map` causes build results to include a map from +info tables to source positions called the info table provenance entry (IPE) +map. See Note [Mapping Info Tables to Source Positions]. The IPE information +can grow the size of build results significantly. At the time of writing, a +default build of GHC results in a total of 109M of libHSghc-*.so build results. +A default+ipe build of GHC (see ./hadrian/doc/flavours.md) results in 262M of +libHSghc-*.so build results without compression. + +We reduce the impact of IPE data on the size of build results by compressing +the data before it is emitted using the zstd compression library. See +Note [The Info Table Provenance Entry (IPE) Map] for information on the layout +of IPE data on disk and in the RTS. We cannot simply compress all data held in +the IPE entry buffer, as the pointers to info tables must be converted to +memory addresses during linking. Therefore, we can only compress the strings +table and the IPE entries themselves (which essentially only consist of indices +into the strings table). -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +With compression, a default+ipe build of GHC results in a total of 205M of +libHSghc-*.so build results. This is over a 20% reduction from the uncompressed +case. + +Decompression happens lazily, as it only occurs when the IPE map is +constructed (which is also done lazily on first lookup or traversal). During +construction, the 'compressed' field of each IPE buffer list node is examined. +If the field indicates that the data has been compressed, the entry data and +strings table are decompressed before continuing with the normal IPE map +construction. +-} + +emitIpeBufferListNode :: + Module + -> [InfoProvEnt] + -> FCode () emitIpeBufferListNode _ [] = return () emitIpeBufferListNode this_mod ents = do cfg <- getStgToCmmConfig - let ctx = stgToCmmContext cfg + + tables_lbl <- mkStringLitLabel <$> newUnique + strings_lbl <- mkStringLitLabel <$> newUnique + entries_lbl <- mkStringLitLabel <$> newUnique + + let ctx = stgToCmmContext cfg platform = stgToCmmPlatform cfg + int n = mkIntCLit platform n + + (cg_ipes, strtab) = flip runState emptyStringTable $ do + module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod) + mapM (toCgIPE platform ctx module_name) ents + + tables :: [CmmStatic] + tables = map (CmmStaticLit . CmmLabel . ipeInfoTablePtr) cg_ipes + + uncompressed_strings :: BS.ByteString + uncompressed_strings = getStringTableStrings strtab + + strings_bytes :: BS.ByteString + strings_bytes = compress defaultCompressionLevel uncompressed_strings + + strings :: [CmmStatic] + strings = [CmmString strings_bytes] + + uncompressed_entries :: BS.ByteString + uncompressed_entries = toIpeBufferEntries (platformByteOrder platform) cg_ipes + + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries - let (cg_ipes, strtab) = flip runState emptyStringTable $ do - module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod) - mapM (toCgIPE platform ctx module_name) ents - - let -- Emit the fields of an IpeBufferEntry struct. - toIpeBufferEntry :: CgInfoProvEnt -> [CmmLit] - toIpeBufferEntry cg_ipe = - [ CmmLabel (ipeInfoTablePtr cg_ipe) - , strtab_offset (ipeTableName cg_ipe) - , strtab_offset (ipeClosureDesc cg_ipe) - , strtab_offset (ipeTypeDesc cg_ipe) - , strtab_offset (ipeLabel cg_ipe) - , strtab_offset (ipeModuleName cg_ipe) - , strtab_offset (ipeSrcFile cg_ipe) - , strtab_offset (ipeSrcSpan cg_ipe) - , int32 0 - ] - - int n = mkIntCLit platform n - int32 n = CmmInt n W32 - strtab_offset (StrTabOffset n) = int32 (fromIntegral n) - - strings <- newByteStringCLit (getStringTableStrings strtab) - let lits = [ zeroCLit platform -- 'next' field - , strings -- 'strings' field - , int $ length cg_ipes -- 'count' field - ] ++ concatMap toIpeBufferEntry cg_ipes - emitDataLits (mkIPELabel this_mod) lits + entries :: [CmmStatic] + entries = [CmmString entries_bytes] + + ipe_buffer_lbl :: CLabel + ipe_buffer_lbl = mkIPELabel this_mod + + ipe_buffer_node :: [CmmStatic] + ipe_buffer_node = map CmmStaticLit + [ -- 'next' field + zeroCLit platform + + -- 'compressed' field + , int do_compress + + -- 'count' field + , int $ length cg_ipes + + -- 'tables' field + , CmmLabel tables_lbl + + -- 'entries' field + , CmmLabel entries_lbl + + -- 'entries_size' field (decompressed size) + , int $ BS.length uncompressed_entries + + -- 'string_table' field + , CmmLabel strings_lbl + + -- 'string_table_size' field (decompressed size) + , int $ BS.length uncompressed_strings + ] + + -- Emit the list of info table pointers + emitDecl $ CmmData + (Section Data tables_lbl) + (CmmStaticsRaw tables_lbl tables) + + -- Emit the strings table + emitDecl $ CmmData + (Section Data strings_lbl) + (CmmStaticsRaw strings_lbl strings) + + -- Emit the list of IPE buffer entries + emitDecl $ CmmData + (Section Data entries_lbl) + (CmmStaticsRaw entries_lbl entries) + + -- Emit the IPE buffer list node + emitDecl $ CmmData + (Section Data ipe_buffer_lbl) + (CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node) + +-- | Emit the fields of an IpeBufferEntry struct for each entry in a given list. +toIpeBufferEntries :: + ByteOrder -- ^ Byte order to write the data in + -> [CgInfoProvEnt] -- ^ List of IPE buffer entries + -> BS.ByteString +toIpeBufferEntries byte_order cg_ipes = + BSL.toStrict . BSB.toLazyByteString . mconcat + $ map (mconcat . map word32Builder . to_ipe_buf_ent) cg_ipes + where + to_ipe_buf_ent :: CgInfoProvEnt -> [Word32] + to_ipe_buf_ent cg_ipe = + [ ipeTableName cg_ipe + , ipeClosureDesc cg_ipe + , ipeTypeDesc cg_ipe + , ipeLabel cg_ipe + , ipeModuleName cg_ipe + , ipeSrcFile cg_ipe + , ipeSrcSpan cg_ipe + , 0 -- padding + ] + + word32Builder :: Word32 -> BSB.Builder + word32Builder = case byte_order of + BigEndian -> BSB.word32BE + LittleEndian -> BSB.word32LE toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt toCgIPE platform ctx module_name ipe = do @@ -77,7 +198,7 @@ toCgIPE platform ctx module_name ipe = do coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ src_loc_file + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name @@ -105,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -130,9 +251,50 @@ lookupStringTable str = state $ \st -> , stLength = stLength st + ST.byteLength str + 1 , stLookup = M.insert str res (stLookup st) } - res = StrTabOffset (stLength st) + res = fromIntegral (stLength st) in (res, st') +do_compress :: Int +compress :: Int -> BS.ByteString -> BS.ByteString +#if !defined(HAVE_LIBZSTD) +do_compress = 0 +compress _ bs = bs +#else +do_compress = 1 + +compress clvl (BSI.PS srcForeignPtr off len) = unsafePerformIO $ + withForeignPtr srcForeignPtr $ \srcPtr -> do + maxCompressedSize <- zstd_compress_bound $ fromIntegral len + dstForeignPtr <- BSI.mallocByteString (fromIntegral maxCompressedSize) + withForeignPtr dstForeignPtr $ \dstPtr -> do + compressedSize <- fromIntegral <$> + zstd_compress + dstPtr + maxCompressedSize + (srcPtr `plusPtr` off) + (fromIntegral len) + (fromIntegral clvl) + BSI.create compressedSize $ \p -> BSI.memcpy p dstPtr compressedSize + +foreign import ccall unsafe "ZSTD_compress" + zstd_compress :: + Ptr dst -- ^ Destination buffer + -> CSize -- ^ Capacity of destination buffer + -> Ptr src -- ^ Source buffer + -> CSize -- ^ Size of source buffer + -> CInt -- ^ Compression level + -> IO CSize + +-- | Compute the maximum compressed size for a given source buffer size +foreign import ccall unsafe "ZSTD_compressBound" + zstd_compress_bound :: + CSize -- ^ Size of source buffer + -> IO CSize +#endif + +defaultCompressionLevel :: Int +defaultCompressionLevel = 3 + newtype DList a = DList ([a] -> [a]) emptyDList :: DList a ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1070,7 +1070,7 @@ Wrinkle [GADT result type in tcRecordUpd] -} --- | Desugars a record update @record_expr { fld1 = e1, fld2 = e2}@ into a case expression +-- | Desugars a record update @record_expr { fld1 = e1, fld2 = e2 }@ into a case expression -- that matches on the constructors of the record @r@, as described in -- Note [Record Updates]. -- ===================================== compiler/ghc.cabal.in ===================================== @@ -57,6 +57,10 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian @@ -77,6 +81,10 @@ Library if flag(build-tool-depends) build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0, genprimopcode:genprimopcode, deriveConstants:deriveConstants + if flag(with-libzstd) + extra-libraries: zstd + CPP-Options: -DHAVE_LIBZSTD + Build-Depends: base >= 4.11 && < 4.19, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, ===================================== configure.ac ===================================== @@ -1104,6 +1104,10 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap], GHC_ADJUSTORS_METHOD([Target]) AC_SUBST([UseLibffiForAdjustors]) +dnl ** IPE data compression +dnl -------------------------------------------------------------- +FP_FIND_LIBZSTD + dnl ** Other RTS features dnl -------------------------------------------------------------- FP_FIND_LIBDW @@ -1249,6 +1253,17 @@ echo "\ makeinfo : $MAKEINFO git : $GIT cabal-install : $CABAL +" + +USING_LIBNUMA=$(if [ "$HaveLibNuma" = "1" ]; then echo "YES"; else echo "NO"; fi;) +USING_LIBZSTD=$(if [ "$HaveLibZstd" = "1" ]; then echo "YES"; else echo "NO"; fi;) +USING_LIBDW=$(if [ "$USE_LIBDW" = "1" ]; then echo "YES"; else echo "NO"; fi;) + +echo "\ + Using optional dependencies: + libnuma : $USING_LIBNUMA + libzstd : $USING_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -119,6 +119,17 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- The compiler may now be configured to compress the debugging information + included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must + build GHC from source (see + `here` for directions) + and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` + script. **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. + GHCi ~~~~ ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,23 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. - This flag will increase the binary size by quite a lot, depending on how - big your project is. For compiling a project the size of GHC the overhead was - about 200 megabytes. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite + a lot, depending on how big your project is. For compiling a project the + size of GHC the overhead was about 200 megabytes. + + :since: 9.8 + + If you wish to reduce the size of :ghc-flag:`-finfo-table-map` enabled + binaries, consider building GHC from source and supplying the + ``--enable-ipe-data-compression`` flag to the ``configure`` script. This + will cause GHC to compress the :ghc-flag:`-finfo-table-map` related + debugging information included in binaries using the `libzstd + `_ compression library. **Note**: This + feature requires that the machine building GHC has + `libzstd `_ installed. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== hadrian/cfg/system.config.in ===================================== @@ -200,10 +200,14 @@ libdw-lib-dir = @LibdwLibDir@ libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ +libzstd-include-dir = @LibZstdIncludeDir@ +libzstd-lib-dir = @LibZstdLibDir@ + # Optional Dependencies: #======================= use-lib-dw = @UseLibdw@ +use-lib-zstd = @UseLibZstd@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ ===================================== hadrian/src/Flavour.hs ===================================== @@ -145,11 +145,13 @@ enableDebugInfo = addArgs $ notStage0 ? mconcat -- | Enable the ticky-ticky profiler in stage2 GHC enableTickyGhc :: Flavour -> Flavour -enableTickyGhc = - addArgs $ orM [stage1, cross] ? mconcat +enableTickyGhc f = + (addArgs (orM [stage1, cross] ? mconcat [ builder (Ghc CompileHs) ? tickyArgs , builder (Ghc LinkHs) ? tickyArgs - ] + ]) f) { ghcThreaded = (< Stage2) } + -- Build single-threaded ghc because ticky profiling is racy with threaded + -- RTS and the C counters are disabled. (See #23439) tickyArgs :: Args tickyArgs = mconcat ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,6 +35,7 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma + | UseLibzstd | UseLibm | UseLibrt | UseLibdl @@ -65,6 +66,7 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" + UseLibzstd -> "use-lib-zstd" UseLibm -> "use-lib-m" UseLibrt -> "use-lib-rt" UseLibdl -> "use-lib-dl" ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -60,6 +60,8 @@ data Setting = BuildArch | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir + | LibZstdIncludeDir + | LibZstdLibDir | LlvmTarget | ProjectGitCommitId | ProjectName @@ -161,6 +163,8 @@ setting key = lookupSystemConfig $ case key of LibdwLibDir -> "libdw-lib-dir" LibnumaIncludeDir -> "libnuma-include-dir" LibnumaLibDir -> "libnuma-lib-dir" + LibZstdIncludeDir -> "libzstd-include-dir" + LibZstdLibDir -> "libzstd-lib-dir" LlvmTarget -> "llvm-target" ProjectGitCommitId -> "project-git-commit-id" ProjectName -> "project-name" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -292,6 +292,7 @@ rtsCabalFlags = mconcat , flag "CabalNeedLibpthread" UseLibpthread , flag "CabalHaveLibbfd" UseLibbfd , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalHaveLibZstd" UseLibzstd , flag "CabalNeedLibatomic" NeedLibatomic , flag "CabalUseSystemLibFFI" UseSystemFfi , flag "CabalLibffiAdjustors" UseLibffiForAdjustors ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -74,6 +74,7 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. @@ -288,6 +289,8 @@ rtsPackageArgs = package rts ? do libdwLibraryDir <- getSetting LibdwLibDir libnumaIncludeDir <- getSetting LibnumaIncludeDir libnumaLibraryDir <- getSetting LibnumaLibDir + libzstdIncludeDir <- getSetting LibZstdIncludeDir + libzstdLibraryDir <- getSetting LibZstdLibDir -- Arguments passed to GHC when compiling C and .cmm sources. let ghcArgs = mconcat @@ -394,6 +397,7 @@ rtsPackageArgs = package rts ? do , builder (Cabal Setup) ? mconcat [ cabalExtraDirs libdwIncludeDir libdwLibraryDir , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir + , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir ] , builder (Cc (FindCDependencies CDep)) ? cArgs ===================================== m4/fp_find_libnuma.m4 ===================================== @@ -30,7 +30,7 @@ AC_DEFUN([FP_FIND_LIBNUMA], [Enable NUMA memory policy and thread affinity support in the runtime system via numactl's libnuma [default=auto]])]) - if test "$enable_numa" != "no" ; then + if test "$enable_numa" = "yes" ; then CFLAGS2="$CFLAGS" CFLAGS="$LIBNUMA_CFLAGS $CFLAGS" LDFLAGS2="$LDFLAGS" @@ -41,7 +41,7 @@ AC_DEFUN([FP_FIND_LIBNUMA], if test "$ac_cv_header_numa_h$ac_cv_header_numaif_h" = "yesyes" ; then AC_CHECK_LIB(numa, numa_available,HaveLibNuma=1) fi - if test "$enable_numa:$HaveLibNuma" = "yes:0" ; then + if test "$HaveLibNuma" = "0" ; then AC_MSG_ERROR([Cannot find system libnuma (required by --enable-numa)]) fi ===================================== m4/fp_find_libzstd.m4 ===================================== @@ -0,0 +1,79 @@ +AC_DEFUN([FP_FIND_LIBZSTD], +[ + dnl ** Is IPE data compression enabled? + dnl -------------------------------------------------------------- + AC_ARG_ENABLE( + ipe-data-compression, + [AS_HELP_STRING( + [--enable-ipe-data-compression], + [Enable compression of info table provenance entries using the + zstd compression library [default=no]] + )], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableIpeDataCompression])], + [EnableIpeDataCompression=NO] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd? + dnl -------------------------------------------------------------- + AC_ARG_WITH( + libzstd-libraries, + [AS_HELP_STRING( + [--with-libzstd-libraries=ARG], + [Find libraries for libzstd in ARG [default=system default]] + )], + [ + LibZstdLibDir="$withval" + LIBZSTD_LDFLAGS="-L$withval" + ] + ) + + AC_SUBST(LibZstdLibDir) + + AC_ARG_WITH( + libzstd-includes, + [AS_HELP_STRING( + [--with-libzstd-includes=ARG], + [Find includes for libzstd in ARG [default=system default]] + )], + [ + LibZstdIncludeDir="$withval" + LIBZSTD_CFLAGS="-I$withval" + ] + ) + + AC_SUBST(LibZstdIncludeDir) + + CFLAGS2="$CFLAGS" + CFLAGS="$LIBZSTD_CFLAGS $CFLAGS" + LDFLAGS2="$LDFLAGS" + LDFLAGS="$LIBZSTD_LDFLAGS $LDFLAGS" + + AC_CHECK_HEADERS([zstd.h]) + + if test "$ac_cv_header_zstd_h" = "yes" ; then + AC_CHECK_LIB(zstd,ZSTD_versionString,HaveLibZstd=1) + fi + if test "$HaveLibZstd" = "0" ; then + AC_MSG_ERROR( + [Cannot find system libzstd (required by + --enable-ipe-data-compression)] + ) + fi + + CFLAGS="$CFLAGS2" + LDFLAGS="$LDFLAGS2" + fi + + AC_DEFINE_UNQUOTED([HAVE_LIBZSTD], [$HaveLibZstd], [Define to 1 if you + wish to compress IPE data in compiler results (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + else + AC_SUBST([UseLibZstd],[NO]) + AC_SUBST([CabalHaveLibZstd],[False]) + fi +]) ===================================== rts/IPE.c ===================================== @@ -20,6 +20,10 @@ #include #include +#if HAVE_LIBZSTD == 1 +#include +#endif + #if defined(TRACING) #include "Trace.h" #endif @@ -36,8 +40,9 @@ collecting IPE lists on registration. It's a singly linked list of IPE list buffers (IpeBufferListNode). These are emitted by the code generator, with generally one produced per module. Each -contains an array of IPE entries and a link field (which is used to link -buffers onto the pending list. +contains a pointer to a list of IPE entries, a pointer to a list of info +table pointers, and a link field (which is used to link buffers onto the +pending list. For reasons of space efficiency, IPE entries are represented slightly differently in the object file than the InfoProvEnt which we ultimately expose @@ -77,23 +82,23 @@ void exitIpe(void) { } #endif // THREADED_RTS -static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) +static InfoProvEnt ipeBufferEntryToIpe(const char *strings, const StgInfoTable *tbl, const IpeBufferEntry ent) { - const char *strings = node->string_table; return (InfoProvEnt) { - .info = ent->info, + .info = tbl, .prov = { - .table_name = &strings[ent->table_name], - .closure_desc = &strings[ent->closure_desc], - .ty_desc = &strings[ent->ty_desc], - .label = &strings[ent->label], - .module = &strings[ent->module_name], - .src_file = &strings[ent->src_file], - .src_span = &strings[ent->src_span] + .table_name = &strings[ent.table_name], + .closure_desc = &strings[ent.closure_desc], + .ty_desc = &strings[ent.ty_desc], + .label = &strings[ent.label], + .module = &strings[ent.module_name], + .src_file = &strings[ent.src_file], + .src_span = &strings[ent.src_span] } }; } + #if defined(TRACING) static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, const void *value) { @@ -105,8 +110,18 @@ void dumpIPEToEventLog(void) { // Dump pending entries IpeBufferListNode *cursor = RELAXED_LOAD(&ipeBufferList); while (cursor != NULL) { + IpeBufferEntry *entries; + char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(cursor, &entries, &strings); + for (uint32_t i = 0; i < cursor->count; i++) { - const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); + const InfoProvEnt ent = ipeBufferEntryToIpe( + strings, + cursor->tables[i], + entries[i] + ); traceIPE(&ent); } cursor = cursor->next; @@ -120,6 +135,7 @@ void dumpIPEToEventLog(void) { RELEASE_LOCK(&ipeMapLock); } + #else void dumpIPEToEventLog(void) { } @@ -169,16 +185,84 @@ void updateIpeMap() { } while (pending != NULL) { - IpeBufferListNode *currentNode = pending; - InfoProvEnt *ip_ents = stgMallocBytes(sizeof(InfoProvEnt) * currentNode->count, "updateIpeMap"); - for (uint32_t i = 0; i < currentNode->count; i++) { - const IpeBufferEntry *ent = ¤tNode->entries[i]; - ip_ents[i] = ipeBufferEntryToIpe(currentNode, ent); - insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); + IpeBufferListNode *current_node = pending; + const IpeBufferEntry *entries; + const char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(current_node, &entries, &strings); + + // Convert the on-disk IPE buffer entry representation (IpeBufferEntry) + // into the runtime representation (InfoProvEnt) + InfoProvEnt *ip_ents = stgMallocBytes( + sizeof(InfoProvEnt) * current_node->count, + "updateIpeMap: ip_ents" + ); + for (uint32_t i = 0; i < current_node->count; i++) { + const IpeBufferEntry ent = entries[i]; + const StgInfoTable *tbl = current_node->tables[i]; + ip_ents[i] = ipeBufferEntryToIpe(strings, tbl, ent); + insertHashTable(ipeMap, (StgWord) tbl, &ip_ents[i]); } - pending = currentNode->next; + pending = current_node->next; } RELEASE_LOCK(&ipeMapLock); } + +/* Decompress the IPE data and strings table referenced by an IPE buffer list +node if it is compressed. No matter whether the data is compressed, the pointers +referenced by the 'entries_dst' and 'string_table_dst' parameters will point at +the decompressed IPE data and string table for the given node, respectively, +upon return from this function. +*/ +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node, IpeBufferEntry **entries_dst, char **string_table_dst) { + if (node->compressed == 1) { + // The IPE list buffer node indicates that the strings table and + // entries list has been compressed. If zstd is not available, fail. + // If zstd is available, decompress. +#if HAVE_LIBZSTD == 0 + barf("An IPE buffer list node has been compressed, but the \ + decompression library (zstd) is not available."); +#else + size_t compressed_sz = ZSTD_findFrameCompressedSize( + node->string_table, + node->string_table_size + ); + char *decompressed_strings = stgMallocBytes( + node->string_table_size, + "updateIpeMap: decompressed_strings" + ); + ZSTD_decompress( + decompressed_strings, + node->string_table_size, + node->string_table, + compressed_sz + ); + *string_table_dst = decompressed_strings; + + // Decompress the IPE data + compressed_sz = ZSTD_findFrameCompressedSize( + node->entries, + node->entries_size + ); + void *decompressed_entries = stgMallocBytes( + node->entries_size, + "updateIpeMap: decompressed_entries" + ); + ZSTD_decompress( + decompressed_entries, + node->entries_size, + node->entries, + compressed_sz + ); + *entries_dst = decompressed_entries; +#endif // HAVE_LIBZSTD == 0 + + } else { + // Not compressed, no need to decompress + *entries_dst = node->entries; + *string_table_dst = node->string_table; + } +} ===================================== rts/IPE.h ===================================== @@ -17,5 +17,6 @@ void dumpIPEToEventLog(void); void updateIpeMap(void); void initIpe(void); void exitIpe(void); +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*, IpeBufferEntry**, char**); #include "EndPrivate.h" ===================================== rts/include/rts/IPE.h ===================================== @@ -52,9 +52,6 @@ typedef uint32_t StringIdx; // The size of this must be a multiple of the word size // to ensure correct packing. typedef struct { - // When TNTC is enabled this will point to the entry code - // not the info table itself. - const StgInfoTable *info; StringIdx table_name; StringIdx closure_desc; StringIdx ty_desc; @@ -69,10 +66,23 @@ GHC_STATIC_ASSERT(sizeof(IpeBufferEntry) % (WORD_SIZE_IN_BITS / 8) == 0, "sizeof typedef struct IpeBufferListNode_ { struct IpeBufferListNode_ *next; + // Everything below is read-only and generated by the codegen - const char *string_table; + + // This flag should be treated as a boolean + StgWord compressed; + StgWord count; - IpeBufferEntry entries[]; + + // When TNTC is enabled, these will point to the entry code + // not the info table itself. + StgInfoTable **tables; + + IpeBufferEntry *entries; + StgWord entries_size; // decompressed size + + char *string_table; + StgWord string_table_size; // decompressed size } IpeBufferListNode; void registerInfoProvList(IpeBufferListNode *node); ===================================== rts/rts.cabal.in ===================================== @@ -45,6 +45,8 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ flag leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -211,6 +213,8 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== testsuite/tests/pmcheck/should_compile/T23445.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs #-} + +module T23445 where + +data GADT a where + IsUnit :: GADT () + +data Foo b where + FooUnit :: Foo () + FooInt :: Foo Int + +data SomeRec = SomeRec { fld :: () } + +bug :: GADT a -> Foo a -> SomeRec -> SomeRec +bug IsUnit foo r = + r { fld = case foo of { FooUnit -> () } } ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -112,6 +112,10 @@ test('CaseOfKnownCon', [], compile, [overlapping_incomplete]) test('TooManyDeltas', [], compile, [overlapping_incomplete+'-fmax-pmcheck-models=0']) test('LongDistanceInfo', [], compile, [overlapping_incomplete]) test('T21662', [], compile, [overlapping_incomplete]) +test('T19271', [], compile, [overlapping_incomplete]) +test('T21761', [], compile, [overlapping_incomplete]) +test('T22964', [], compile, [overlapping_incomplete]) +test('T23445', [], compile, [overlapping_incomplete]) # Series (inspired) by Luke Maranget @@ -156,6 +160,4 @@ test('EmptyCase007', [], compile, [overlapping_incomplete]) test('EmptyCase008', [], compile, [overlapping_incomplete]) test('EmptyCase009', [], compile, [overlapping_incomplete]) test('EmptyCase010', [], compile, [overlapping_incomplete]) -test('T19271', [], compile, [overlapping_incomplete]) -test('T21761', [], compile, [overlapping_incomplete]) -test('T22964', [], compile, [overlapping_incomplete]) + ===================================== testsuite/tests/rts/ipe/ipeEventLog_fromMap.c ===================================== @@ -19,7 +19,7 @@ int main(int argc, char *argv[]) { registerInfoProvList(list2); // Query an IPE to initialize the underlying hash map. - lookupIPE(list1->entries[0].info); + lookupIPE(list1->tables[0]); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -40,15 +40,23 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(fortyTwo); + node->entries[0] = makeAnyProvEntry(cap, &st, 42); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -72,15 +80,23 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(twentyThree); + node->entries[0] = makeAnyProvEntry(cap, &st, 23); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -103,17 +119,26 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, } void shouldFindTwoFromTheSameList(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * 2); + node->entries = malloc(sizeof(IpeBufferEntry) * 2); + StringTable st; init_string_table(&st); HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); - node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); - node->count = 2; node->next = NULL; + node->compressed = 0; + node->count = 2; + node->tables[0] = get_itbl(one); + node->tables[1] = get_itbl(two); + node->entries[0] = makeAnyProvEntry(cap, &st, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, 2); + node->entries_size = sizeof(IpeBufferEntry) * 2; node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,9 +25,8 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferEntry provEnt; - provEnt.info = get_itbl(closure); unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; char *tableName = malloc(sizeof(char) * tableNameLength); @@ -69,15 +68,27 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj clo IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { const int n = end - start; - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); + + // Allocate buffers for IpeBufferListNode + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * n); + node->entries = malloc(sizeof(IpeBufferEntry) * n); + StringTable st; init_string_table(&st); + + // Make the entries and fill the buffers for (int i=start; i < end; i++) { HaskellObj closure = rts_mkInt(cap, 42); - node->entries[i] = makeAnyProvEntry(cap, &st, closure, i); + node->tables[i] = get_itbl(closure); + node->entries[i] = makeAnyProvEntry(cap, &st, i); } + + // Set the rest of the fields node->next = NULL; + node->compressed = 0; node->count = n; node->string_table = st.buffer; + return node; } ===================================== testsuite/tests/rts/ipe/ipe_lib.h ===================================== @@ -12,6 +12,6 @@ void init_string_table(StringTable *st); uint32_t add_string(StringTable *st, const char *s); IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end); -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/228d5a2479b2712ee6d5dfd80921e01bcebae0dc...220c546a0c9ee677400c92fe5cbf6fa5f381c1fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/228d5a2479b2712ee6d5dfd80921e01bcebae0dc...220c546a0c9ee677400c92fe5cbf6fa5f381c1fd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 14:39:16 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 26 May 2023 10:39:16 -0400 Subject: [Git][ghc/ghc][wip/testsuite-stack-size] testsuite: Pass -kb16k -kc128k for performance tests Message-ID: <6470c494efd5b_64cfb3898d6e46237a4@gitlab.mail> Matthew Pickering pushed to branch wip/testsuite-stack-size at Glasgow Haskell Compiler / GHC Commits: f8860dc9 by Matthew Pickering at 2023-05-26T15:38:58+01:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -1791,7 +1791,11 @@ async def simple_build(name: Union[TestName, str], stats_file = name + '.comp.stats' if isCompilerStatsTest(): - extra_hc_opts += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' + # Set a bigger chunk size to reduce variation due to additional under/overflowing + # The tests are attempting to test how much work the compiler is doing by proxy of + # bytes allocated. The additional allocations caused by stack overflow can cause + # spurious failures if you trip over the limit (see #23439) + extra_hc_opts += ' +RTS -kc128k -kb16k -V0 -t' + stats_file + ' --machine-readable -RTS' if backpack: extra_hc_opts += ' -outputdir ' + name + '.out' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8860dc9088020a9e6c640f2fa040539bc21a8c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8860dc9088020a9e6c640f2fa040539bc21a8c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 15:46:20 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 26 May 2023 11:46:20 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23323 Message-ID: <6470d44c8c80c_64cfb31e4e46465739c@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23323 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23323 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 16:06:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 May 2023 12:06:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Introduce GHCiMessage to wrap GhcMessage Message-ID: <6470d8fb21187_64cfb16604f9466935f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a71d4982 by Matthew Pickering at 2023-05-26T12:06:08-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 262f3f05 by Matthew Pickering at 2023-05-26T12:06:08-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - a2840cd5 by Matthew Pickering at 2023-05-26T12:06:08-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - b7aa094f by Matthew Pickering at 2023-05-26T12:06:08-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 1a471230 by Matthew Pickering at 2023-05-26T12:06:08-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 64f224f3 by Matthew Pickering at 2023-05-26T12:06:08-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - 80e1a85d by Matthew Pickering at 2023-05-26T12:06:08-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - b738a302 by Matthew Pickering at 2023-05-26T12:06:09-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 9b5d9324 by Matthew Pickering at 2023-05-26T12:06:09-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 815b5b53 by Matthew Pickering at 2023-05-26T12:06:09-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 869abfdc by Matthew Pickering at 2023-05-26T12:06:09-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 76c5f2e4 by Matthew Pickering at 2023-05-26T12:06:09-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - 994acef8 by Matthew Pickering at 2023-05-26T12:06:09-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 264403a9 by Josh Meredith at 2023-05-26T12:06:09-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - 8a418a23 by Norman Ramsey at 2023-05-26T12:06:10-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 78b24be7 by Sylvain Henry at 2023-05-26T12:06:13-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/JS/Ppr.hs - + compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74a2a9d636575f5dda7a33f824ece32e75dc8584...78b24be76d4601ebc2ae918f654827dbff1cd656 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74a2a9d636575f5dda7a33f824ece32e75dc8584...78b24be76d4601ebc2ae918f654827dbff1cd656 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 18:04:02 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 26 May 2023 14:04:02 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 17 commits: Add Data.List.unsnoc Message-ID: <6470f4921a076_64cfb31e4e46470109b@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - 55647cdd by Apoorv Ingle at 2023-05-26T12:22:21-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 770c7d67 by Apoorv Ingle at 2023-05-26T12:22:26-05:00 PopSrcSpan as a XXExprGhcRn - - - - - d4545ea1 by Apoorv Ingle at 2023-05-26T12:22:27-05:00 add PopSrcSpan in appropriate places while desugaring - - - - - 83573fc4 by Apoorv Ingle at 2023-05-26T12:22:27-05:00 add correct source spans for warnDiscardedDoBindings - - - - - 52c675b0 by Apoorv Ingle at 2023-05-26T12:22:27-05:00 use mkExpandStmt to store original stmts along with expanded expr for using the right context for error message printing - - - - - 808214c8 by Apoorv Ingle at 2023-05-26T12:22:27-05:00 do not leak generated expressions in the error context, need to fix push and pop error contexts for ExpandedStmts - - - - - 8a629060 by Apoorv Ingle at 2023-05-26T12:22:27-05:00 imporving error messages for applicative do - - - - - ebf3b8bb by Apoorv Ingle at 2023-05-26T13:03:07-05:00 remove special case from isMatchContextPmChecked - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl/Instance.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8b82fcd1896998c3c5c63f34f67885dca0e6cc2...ebf3b8bbc0146ea9ac8cbd824773e2df83021f55 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8b82fcd1896998c3c5c63f34f67885dca0e6cc2...ebf3b8bbc0146ea9ac8cbd824773e2df83021f55 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 18:53:34 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 26 May 2023 14:53:34 -0400 Subject: [Git][ghc/ghc][wip/expand-do] set correct src spans to statement expansions Message-ID: <6471002e4570a_64cfb321f81a07026d2@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 2805090d by Apoorv Ingle at 2023-05-26T13:53:21-05:00 set correct src spans to statement expansions - - - - - 6 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - testsuite/tests/deSugar/should_compile/T3263-2.hs - testsuite/tests/pmcheck/should_compile/DoubleMatch.hs - testsuite/tests/rebindable/T18324.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,8 +858,7 @@ warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg@(L loc _) arg_ty | Just (l, f) <- fish_var fun , f `hasKey` thenMClassOpKey -- it is a (>>) - , isNoSrcSpan l || isGeneratedSrcSpan l -- it is compiler generated - -- TODO: check why is isGeneratedSrcSpan false? + , isGeneratedSrcSpan l -- it is compiler generated (>>) = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun , text "loc" <+> ppr l , text "locGen?" <+> ppr (isGeneratedSrcSpan l) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -412,8 +412,8 @@ tcExpr (HsMultiIf _ alts) res_ty tcExpr (XExpr (PopSrcSpan expr)) res_ty = popErrCtxt $ tcExpr (unLoc expr) res_ty tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty - = do { traceTc "tcDoStmts" (vcat [ text "stmt" <+> ppr stmt - , text "expr" <+> ppr expr + = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt + , text "expr:" <+> ppr expr , text "res_ty" <+> ppr res_ty ]) ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ tcExpr (unLoc expr) res_ty @@ -423,7 +423,9 @@ tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) - ; traceTc "tcDoStmts doExpr" (ppr expanded_do_expr) + ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo + , text "expr:" <+> ppr expand_expr + ]) ; tcExpr expanded_do_expr res_ty } @@ -431,7 +433,9 @@ tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) - ; traceTc "tcDoStmts mDoExpr" (ppr expanded_do_expr) + ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo + , text "expr:" <+> ppr expand_expr + ]) ; tcExpr expanded_do_expr res_ty } ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1214,8 +1214,8 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ genPopSrcSpanExpr $ mkExpandedStmtLExpr stmt - (genPopSrcSpanExpr (L loc (genHsApp ret body))) + = return $ genPopSrcSpanExpr $ L loc $ mkExpandedStmt stmt + (genPopSrcSpanExpr (L loc (genHsApp ret body))) expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) @@ -1229,11 +1229,10 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ mkExpandedStmtLExpr stmt - (mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ genPopSrcSpanExpr e - , genPopSrcSpanExpr expr - ]) + return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ L loc (mkExpandedStmt stmt $ (genPopSrcSpanExpr e)) + , genPopSrcSpanExpr expr + ]) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) @@ -1248,23 +1247,22 @@ expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bnds)) : lstmts) = noHsTok (genPopSrcSpanExpr expand_stmts))) -expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ mkExpandedStmtLExpr stmt - (genPopSrcSpanExpr $ mkHsApps (wrapGenSpan f) -- (>>) - [ genPopSrcSpanExpr e -- e - , genPopSrcSpanExpr expand_stmts ]) -- stmts' + return $ (genPopSrcSpanExpr $ (mkHsApps (wrapGenSpan f) -- (>>) + [ L loc (mkExpandedStmt stmt $ (genPopSrcSpanExpr e)) -- e + , genPopSrcSpanExpr expand_stmts ])) -- stmts' expand_do_stmts do_or_lc - ((L _ (RecStmt { recS_stmts = rec_stmts - , recS_later_ids = later_ids -- forward referenced local ids - , recS_rec_ids = local_ids -- ids referenced outside of the rec block - , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr - , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr -- use it explicitly -- at the end of expanded rec block })) @@ -1294,9 +1292,9 @@ expand_do_stmts do_or_lc Nothing (SyntaxExprRn return_fun) do_stmts :: XRec GhcRn [ExprLStmt GhcRn] - do_stmts = wrapGenSpan $ (unLoc rec_stmts) ++ [return_stmt] + do_stmts = L stmts_loc $ rec_stmts ++ [return_stmt] do_block :: LHsExpr GhcRn - do_block = wrapGenSpan $ HsDo noExtField (DoExpr Nothing) $ do_stmts + do_block = L do_loc $ HsDo noExtField (DoExpr Nothing) $ do_stmts mfix_expr :: LHsExpr GhcRn mfix_expr = mkHsLamDoExp [ wrapGenSpan (LazyPat noExtField $ mkBigLHsVarPatTup all_ids) ] $ do_block -- LazyPat becuase we do not want to eagerly evaluate the pattern @@ -1442,4 +1440,18 @@ join (<*>) (\ x -> \ 'a' -> return () \ _ -> fail ..) getChar return (3 :: Int) + + + +Impredicative types (T18324) + +t :: IO Id +p :: Id -> (Bool, Int) +foo2 = do { x <- t ; return (p x) } + +foo2 = do { x <- t ; return (p x) } + {Expansion: (>>=) t (\ x -> return (p x))} + + + -} ===================================== testsuite/tests/deSugar/should_compile/T3263-2.hs ===================================== @@ -14,14 +14,14 @@ t2 :: Monad m => m (m Int) t2 = return (return 10) -- No warning -asdft3 :: Monad m => m (m Int) -asdft3 = do +t3 :: Monad m => m (m Int) +t3 = do return 10 return (return 10) -- Warning -asdft4 :: forall m. Monad m => m Int -asdft4 = do +t4 :: forall m. Monad m => m Int +t4 = do return (return 10 :: m Int) return 10 @@ -41,7 +41,7 @@ t6 = mdo unit :: () unit = () --- -- No warning +-- No warning t7 :: forall m. Monad m => m Int t7 = do return unit ===================================== testsuite/tests/pmcheck/should_compile/DoubleMatch.hs ===================================== @@ -16,27 +16,3 @@ doingThing handler = do Handler1 -> 1 return action return v - --- doingThing123 :: Handler -> IO Int --- doingThing123 handler = (>>=) --- (case handler of --- Default -> return 0 --- _other_handler -> do --- asdf <- return 1 --- let action = case handler of --- Handler1 -> 1 --- return action) --- (\v -> return v) - - --- doingThing123 :: Handler -> IO Int --- doingThing123 handler = (>>=) --- (case handler of --- Default -> return 0 --- _other_handler -> --- (>>=)(return 1) (\asdf -> --- let action = case handler of --- Handler1 -> 1 --- in --- return action)) --- (\v -> return v) ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -18,6 +18,3 @@ blah x y = return (3::Int) main = do x <- foo1 putStrLn $ show x - - - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2805090d27abe23bbc5435313f6e0b15b79250ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2805090d27abe23bbc5435313f6e0b15b79250ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 18:58:52 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 26 May 2023 14:58:52 -0400 Subject: [Git][ghc/ghc][wip/expand-do] set correct src spans to statement expansions Message-ID: <6471016c4fe4_64cfb33b42b9c703793@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 4ea7be30 by Apoorv Ingle at 2023-05-26T13:58:43-05:00 set correct src spans to statement expansions - - - - - 7 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - testsuite/tests/deSugar/should_compile/T3263-2.hs - testsuite/tests/pmcheck/should_compile/DoubleMatch.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/rebindable/T18324.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,8 +858,7 @@ warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg@(L loc _) arg_ty | Just (l, f) <- fish_var fun , f `hasKey` thenMClassOpKey -- it is a (>>) - , isNoSrcSpan l || isGeneratedSrcSpan l -- it is compiler generated - -- TODO: check why is isGeneratedSrcSpan false? + , isGeneratedSrcSpan l -- it is compiler generated (>>) = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun , text "loc" <+> ppr l , text "locGen?" <+> ppr (isGeneratedSrcSpan l) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -412,8 +412,8 @@ tcExpr (HsMultiIf _ alts) res_ty tcExpr (XExpr (PopSrcSpan expr)) res_ty = popErrCtxt $ tcExpr (unLoc expr) res_ty tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty - = do { traceTc "tcDoStmts" (vcat [ text "stmt" <+> ppr stmt - , text "expr" <+> ppr expr + = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt + , text "expr:" <+> ppr expr , text "res_ty" <+> ppr res_ty ]) ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ tcExpr (unLoc expr) res_ty @@ -423,7 +423,9 @@ tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) - ; traceTc "tcDoStmts doExpr" (ppr expanded_do_expr) + ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo + , text "expr:" <+> ppr expand_expr + ]) ; tcExpr expanded_do_expr res_ty } @@ -431,7 +433,9 @@ tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) - ; traceTc "tcDoStmts mDoExpr" (ppr expanded_do_expr) + ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo + , text "expr:" <+> ppr expand_expr + ]) ; tcExpr expanded_do_expr res_ty } ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1214,11 +1214,11 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ genPopSrcSpanExpr $ mkExpandedStmtLExpr stmt - (genPopSrcSpanExpr (L loc (genHsApp ret body))) + = return $ genPopSrcSpanExpr $ L loc $ mkExpandedStmt stmt + (genPopSrcSpanExpr (L loc (genHsApp ret body))) -expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) +expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding pat can fail @@ -1229,11 +1229,10 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ mkExpandedStmtLExpr stmt - (mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ genPopSrcSpanExpr e - , genPopSrcSpanExpr expr - ]) + return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ L loc (mkExpandedStmt stmt $ (genPopSrcSpanExpr e)) + , genPopSrcSpanExpr expr + ]) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) @@ -1248,23 +1247,22 @@ expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bnds)) : lstmts) = noHsTok (genPopSrcSpanExpr expand_stmts))) -expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ mkExpandedStmtLExpr stmt - (genPopSrcSpanExpr $ mkHsApps (wrapGenSpan f) -- (>>) - [ genPopSrcSpanExpr e -- e - , genPopSrcSpanExpr expand_stmts ]) -- stmts' + return $ (genPopSrcSpanExpr $ (mkHsApps (wrapGenSpan f) -- (>>) + [ L loc (mkExpandedStmt stmt $ (genPopSrcSpanExpr e)) -- e + , genPopSrcSpanExpr expand_stmts ])) -- stmts' expand_do_stmts do_or_lc - ((L _ (RecStmt { recS_stmts = rec_stmts - , recS_later_ids = later_ids -- forward referenced local ids - , recS_rec_ids = local_ids -- ids referenced outside of the rec block - , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr - , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr -- use it explicitly -- at the end of expanded rec block })) @@ -1294,9 +1292,9 @@ expand_do_stmts do_or_lc Nothing (SyntaxExprRn return_fun) do_stmts :: XRec GhcRn [ExprLStmt GhcRn] - do_stmts = wrapGenSpan $ (unLoc rec_stmts) ++ [return_stmt] + do_stmts = L stmts_loc $ rec_stmts ++ [return_stmt] do_block :: LHsExpr GhcRn - do_block = wrapGenSpan $ HsDo noExtField (DoExpr Nothing) $ do_stmts + do_block = L do_loc $ HsDo noExtField (DoExpr Nothing) $ do_stmts mfix_expr :: LHsExpr GhcRn mfix_expr = mkHsLamDoExp [ wrapGenSpan (LazyPat noExtField $ mkBigLHsVarPatTup all_ids) ] $ do_block -- LazyPat becuase we do not want to eagerly evaluate the pattern @@ -1442,4 +1440,18 @@ join (<*>) (\ x -> \ 'a' -> return () \ _ -> fail ..) getChar return (3 :: Int) + + + +Impredicative types (T18324) + +t :: IO Id +p :: Id -> (Bool, Int) +foo2 = do { x <- t ; return (p x) } + +foo2 = do { x <- t ; return (p x) } + {Expansion: (>>=) t (\ x -> return (p x))} + + + -} ===================================== testsuite/tests/deSugar/should_compile/T3263-2.hs ===================================== @@ -14,14 +14,14 @@ t2 :: Monad m => m (m Int) t2 = return (return 10) -- No warning -asdft3 :: Monad m => m (m Int) -asdft3 = do +t3 :: Monad m => m (m Int) +t3 = do return 10 return (return 10) -- Warning -asdft4 :: forall m. Monad m => m Int -asdft4 = do +t4 :: forall m. Monad m => m Int +t4 = do return (return 10 :: m Int) return 10 @@ -41,7 +41,7 @@ t6 = mdo unit :: () unit = () --- -- No warning +-- No warning t7 :: forall m. Monad m => m Int t7 = do return unit ===================================== testsuite/tests/pmcheck/should_compile/DoubleMatch.hs ===================================== @@ -16,27 +16,3 @@ doingThing handler = do Handler1 -> 1 return action return v - --- doingThing123 :: Handler -> IO Int --- doingThing123 handler = (>>=) --- (case handler of --- Default -> return 0 --- _other_handler -> do --- asdf <- return 1 --- let action = case handler of --- Handler1 -> 1 --- return action) --- (\v -> return v) - - --- doingThing123 :: Handler -> IO Int --- doingThing123 handler = (>>=) --- (case handler of --- Default -> return 0 --- _other_handler -> --- (>>=)(return 1) (\asdf -> --- let action = case handler of --- Handler1 -> 1 --- in --- return action)) --- (\v -> return v) ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -160,7 +160,4 @@ test('EmptyCase007', [], compile, [overlapping_incomplete]) test('EmptyCase008', [], compile, [overlapping_incomplete]) test('EmptyCase009', [], compile, [overlapping_incomplete]) test('EmptyCase010', [], compile, [overlapping_incomplete]) -test('T19271', [], compile, [overlapping_incomplete]) -test('T21761', [], compile, [overlapping_incomplete]) -test('T22964', [], compile, [overlapping_incomplete]) test('DoubleMatch', normal, compile, [overlapping_incomplete]) ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -18,6 +18,3 @@ blah x y = return (3::Int) main = do x <- foo1 putStrLn $ show x - - - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ea7be30c2d0c59182c8ba870e957e49fc88b686 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ea7be30c2d0c59182c8ba870e957e49fc88b686 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 19:17:00 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 26 May 2023 15:17:00 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Replace SXTH & SXTB Message-ID: <647105ac1f3db_64cfb3f69fc50704436@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: e1bce7ce by Sven Tennie at 2023-05-26T21:14:48+02:00 Replace SXTH & SXTB Both do not exist on RISCV64. While touching the sign extension code, also fix the integer calling convention in this sense and update the sign extension note. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -413,11 +413,11 @@ opRegWidth W16 = W32 -- w opRegWidth W8 = W32 -- w opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) --- Note [Signed arithmetic on AArch64] +-- Note [Signed arithmetic on RISCV64] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Handling signed arithmetic on sub-word-size values on AArch64 is a bit +-- Handling signed arithmetic on sub-word-size values on RISCV64 is a bit -- tricky as Cmm's type system does not capture signedness. While 32-bit values --- are fairly easy to handle due to AArch64's 32-bit instruction variants +-- are fairly easy to handle due to RISCV64's 32-bit instruction variants -- (denoted by use of %wN registers), 16- and 8-bit values require quite some -- care. -- @@ -447,6 +447,10 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) -- requires no extension and no truncate since we can assume that -- `c` is zero-extended. -- +-- The "RISC-V Sign Extension Optimizations" LLVM tech talk presentation by +-- Craig Topper covers possible future improvements +-- (https://llvm.org/devmtg/2022-11/slides/TechTalk21-RISC-VSignExtensionOptimizations.pdf) +-- -- TODO: -- Don't use Width in Operands -- Instructions should rather carry a RegWidth @@ -655,14 +659,28 @@ getRegister' config plat expr NEG (OpReg w' dst) (OpReg w' reg') `appOL` truncateReg w' w dst - ss_conv from to reg code = - let w' = opRegWidth (max from to) - in return $ Any (intFormat to) $ \dst -> - code `snocOL` - SBFM (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt 0)) (toImm (min from to)) `appOL` - -- At this point an 8- or 16-bit value would be sign-extended - -- to 32-bits. Truncate back down the final width. - truncateReg w' to dst + ss_conv from to reg code | from == to = + pure $ Any (intFormat from) $ \dst -> + code `snocOL` (MOV (OpReg from dst) (OpReg from reg)) + ss_conv from to reg code | from < to = do + pure $ Any (intFormat to) $ \dst -> + code + `appOL` signExtend from to reg dst + `appOL` truncateReg from to dst + ss_conv from to reg code | from > to = + pure $ Any (intFormat to) $ \dst -> + code + `appOL` toOL + [ ann + (text "narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to) + (LSL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt shift))), + -- signed right shift + ASR (OpReg to dst) (OpReg to dst) (OpImm (ImmInt shift)) + ] + `appOL` truncateReg from to dst + where + -- Why -1? We need to shift out one more bit for the sign. + shift = 64 - (widthInBits from - widthInBits to - 1) -- Dyadic machops: -- @@ -944,58 +962,62 @@ getRegister' config plat expr SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y) `snocOL` CSET (OpReg w dst) (OpReg w hi) (OpRegShift w lo SASR 63) NE) do_mul_may_oflo w x y = do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - let tmp_w = case w of - W32 -> W64 - W16 -> W32 - W8 -> W32 - _ -> panic "do_mul_may_oflo: impossible" - -- This will hold the product - tmp <- getNewRegNat (intFormat tmp_w) - let ext_mode = case w of - W32 -> ESXTW - W16 -> ESXTH - W8 -> ESXTB - _ -> panic "do_mul_may_oflo: impossible" - mul = case w of + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + let mul = case w of W32 -> SMULL W16 -> MUL W8 -> MUL _ -> panic "do_mul_may_oflo: impossible" + wx' = max (formatToWidth format_x) w + wy' = max (formatToWidth format_y) w return $ Any (intFormat w) (\dst -> code_x `appOL` - code_y `snocOL` - mul (OpReg tmp_w tmp) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CSET (OpReg w dst) (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) NE) + signExtend (formatToWidth format_x) wx' reg_x reg_x `appOL` + code_y `appOL` + signExtend (formatToWidth format_y) wy' reg_y reg_y `snocOL` + mul (OpReg w dst) (OpReg wx' reg_x) (OpReg wy' reg_y) + ) + -- TODO: Handle overflow + -- `snocOL` + -- CSET (OpReg w dst) (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) NE) --- TODO: Some cases can surely be implemented with shifts and SEXT.W. This would --- save 2 (expensive) memory accesses! -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) signExtendReg w _w' r | w == W64 = pure (r, nilOL) -signExtendReg _w w' _r | w' > W64 = pprPanic "Cannot sign extend to width bigger than register size:" (ppr w') -signExtendReg w _w' r | w > W64 = pprPanic "Unexpected register size (max is 64bit):" $ text (show r) <> char ':' <+> ppr w -signExtendReg w w' r | w == W32 && w' == W64 = - -- `ADDIW r r 0` is the pseudo-op SEXT.W - pure (r, unitOL $ - ann (text "sign-extend register" <+> ppr r <+> ppr w <> text "->" <> ppr w') - (ADD (OpReg w' r) (OpReg w r) (OpImm (ImmInt 0))) - ) signExtendReg w w' r = do r' <- getNewRegNat (intFormat w') - let instrs = toOL [ann (text "sign-extend register" <+> ppr r <+> ppr w <> text "->" <> ppr w') - (SUB sp sp (OpImm (ImmInt (widthInBits w)))) - -- loading (LW, LH, LB) sign extends to 64bit - , STR (intFormat w) (OpReg w r) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , LDR (intFormat w) (OpReg w r) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , ADD sp sp (OpImm (ImmInt (widthInBits w))) - -- ADD to move the result to r', which has the correct width / format - , ADD (OpReg w' r') (OpReg w r) zero - ] + let instrs = signExtend w w' r r' pure (r', instrs) +-- | Sign extends to 64bit, if needed +-- +-- Source `Reg` @r@ stays untouched, while the conversion happens on destination +-- `Reg` @r'@. +signExtend :: Width -> Width -> Reg -> Reg -> OrdList Instr +signExtend w w' _r _r' | w > w' = pprPanic "This is not a sign extension, but a truncation." $ ppr w <> text "->" <+> ppr w' +signExtend w w' _r _r' | w > W64 || w' > W64 = pprPanic "Unexpected width (max is 64bit):" $ ppr w <> text "->" <+> ppr w' +signExtend w w' r r' | w == W64 && w' == W64 && r == r' = nilOL +signExtend w w' r r' | w == W64 && w' == W64 = unitOL $ MOV (OpReg w' r') (OpReg w r) +signExtend w w' r r' + | w == W32 && w' == W64 = + unitOL $ + ann + (text "sign-extend register (SEXT.W)" <+> ppr r <+> ppr w <> text "->" <> ppr w') + -- `ADDIW r r 0` is the pseudo-op SEXT.W + (ADD (OpReg w' r') (OpReg w r) (OpImm (ImmInt 0))) +signExtend w w' r r' = + toOL + [ ann + (text "narrow register signed" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w') + (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))), + -- signed (arithmetic) right shift + ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift)) + ] + where + shift = 64 - widthInBits w + -- | Instructions to truncate the value in the given register from width @w@ -- down to width @w'@. -- N.B.: This ignores signedness! @@ -1155,15 +1177,25 @@ genCondJump bid expr = do _ -> code_x `appOL` code_y `appOL` toOL [ (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] sbcond w cmp = do - -- compute both sides. - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - let x' = OpReg w reg_x - y' = OpReg w reg_y - return $ case w of - W8 -> code_x `appOL` code_y `appOL` toOL [ SXTB x' x', SXTB y' y', (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] - W16 -> code_x `appOL` code_y `appOL` toOL [ SXTH x' x', SXTH y' y', (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] - _ -> code_x `appOL` code_y `appOL` toOL [ (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] + -- compute both sides. + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + let x' = OpReg w reg_x + y' = OpReg w reg_y + return $ case w of + W8 -> + code_x + `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y + `appOL` unitOL (annExpr expr (BCOND cmp x' y' (TBlock bid))) + W16 -> + code_x + `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y + `appOL` unitOL (annExpr expr (BCOND cmp x' y' (TBlock bid))) + _ -> code_x `appOL` code_y `appOL` unitOL (annExpr expr (BCOND cmp x' y' (TBlock bid))) fbcond w cmp = do -- ensure we get float regs @@ -1595,25 +1627,15 @@ genCCall target dest_regs arg_regs bid = do -- -- Still have GP regs, and we want to pass an GP argument. - passArguments pack (gpReg:gpRegs) fpRegs ((r, format, hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format = do platform <- getPlatform + -- RISCV64 Integer Calling Convention: "When passed in registers or on the + -- stack, integer scalars narrower than XLEN bits are widened according to + -- the sign of their type up to 32 bits, then sign-extended to XLEN bits." let w = formatToWidth format - mov - -- Specifically, Darwin/AArch64's ABI requires that the caller - -- sign-extend arguments which are smaller than 32-bits. - | w < W32 - , platformCConvNeedsExtension platform - , SignedHint <- hint - = case w of - W8 -> SXTB (OpReg W64 gpReg) (OpReg w r) - W16 -> SXTH (OpReg W64 gpReg) (OpReg w r) - _ -> panic "impossible" - | otherwise - = MOV (OpReg w gpReg) (OpReg w r) accumCode' = accumCode `appOL` - code_r `snocOL` - ann (text "Pass gp argument: " <> ppr r) mov + code_r `appOL` + signExtend w W64 r gpReg passArguments pack gpRegs fpRegs args stackSpace (gpReg:accumRegs) accumCode' -- Still have FP regs, and we want to pass an FP argument. ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -95,9 +95,7 @@ regUsageOfInstr platform instr = case instr of SBFM dst src _ _ -> usage (regOp src, regOp dst) UBFM dst src _ _ -> usage (regOp src, regOp dst) UBFX dst src _ _ -> usage (regOp src, regOp dst) - SXTB dst src -> usage (regOp src, regOp dst) UXTB dst src -> usage (regOp src, regOp dst) - SXTH dst src -> usage (regOp src, regOp dst) UXTH dst src -> usage (regOp src, regOp dst) -- 3. Logical and Move Instructions ------------------------------------------ AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -234,9 +232,7 @@ patchRegsOfInstr instr env = case instr of SBFM o1 o2 o3 o4 -> SBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) UBFM o1 o2 o3 o4 -> UBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) UBFX o1 o2 o3 o4 -> UBFX (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) - SXTB o1 o2 -> SXTB (patchOp o1) (patchOp o2) UXTB o1 o2 -> UXTB (patchOp o1) (patchOp o2) - SXTH o1 o2 -> SXTH (patchOp o1) (patchOp o2) UXTH o1 o2 -> UXTH (patchOp o1) (patchOp o2) -- 3. Logical and Move Instructions ---------------------------------------- @@ -562,9 +558,7 @@ data Instr | DELTA Int -- 0. Pseudo Instructions -------------------------------------------------- - | SXTB Operand Operand | UXTB Operand Operand - | SXTH Operand Operand | UXTH Operand Operand -- | SXTW Operand Operand -- | SXTX Operand Operand @@ -694,9 +688,7 @@ instrCon i = LDATA{} -> "LDATA" NEWBLOCK{} -> "NEWBLOCK" DELTA{} -> "DELTA" - SXTB{} -> "SXTB" UXTB{} -> "UXTB" - SXTH{} -> "SXTH" UXTH{} -> "UXTH" PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME" POP_STACK_FRAME{} -> "POP_STACK_FRAME" @@ -881,13 +873,6 @@ d29 = OpReg W64 (RegReal (RealRegSingle 61)) d30 = OpReg W64 (RegReal (RealRegSingle 62)) d31 = OpReg W64 (RegReal (RealRegSingle 63)) -opRegUExt :: Width -> Reg -> Operand -opRegUExt W64 r = OpRegExt W64 r EUXTX 0 -opRegUExt W32 r = OpRegExt W32 r EUXTW 0 -opRegUExt W16 r = OpRegExt W16 r EUXTH 0 -opRegUExt W8 r = OpRegExt W8 r EUXTB 0 -opRegUExt w _r = pprPanic "opRegUExt" (ppr w) - opRegSExt :: Width -> Reg -> Operand opRegSExt W64 r = OpRegExt W64 r ESXTX 0 opRegSExt W32 r = OpRegExt W32 r ESXTW 0 ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -456,8 +456,8 @@ pprInstr platform instr = case instr of -- 1. Arithmetic Instructions ------------------------------------------------ ADD o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd") o1 o2 o3 - -- This case is used for sign extension. - | OpReg W64 _ <- o1 , OpReg w _ <- o2, w < W64, isImmOp o3 -> op3 (text "\taddiw") o1 o2 o3 + -- This case is used for sign extension: SEXT.W op + | OpReg W64 _ <- o1 , OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddiw") o1 o2 o3 | otherwise -> op3 (text "\tadd") o1 o2 o3 -- CMN o1 o2 -> op2 (text "\tcmn") o1 o2 -- CMP o1 o2 @@ -490,9 +490,7 @@ pprInstr platform instr = case instr of UBFM o1 o2 o3 o4 -> op4 (text "\tubfm") o1 o2 o3 o4 -- signed and unsigned bitfield extract UBFX o1 o2 o3 o4 -> op4 (text "\tubfx") o1 o2 o3 o4 - SXTB o1 o2 -> op2 (text "\tsxtb") o1 o2 UXTB o1 o2 -> op2 (text "\tuxtb") o1 o2 - SXTH o1 o2 -> op2 (text "\tsxth") o1 o2 UXTH o1 o2 -> op2 (text "\tuxth") o1 o2 -- 3. Logical and Move Instructions ------------------------------------------ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1bce7ce51b61e078d589ae7608f23e240255137 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1bce7ce51b61e078d589ae7608f23e240255137 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 19:26:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 May 2023 15:26:40 -0400 Subject: [Git][ghc/ghc][master] 5 commits: Introduce GHCiMessage to wrap GhcMessage Message-ID: <647107f0699b2_64cfb321f81a070999c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 30 changed files: - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - ghc/GHCi/UI.hs - + ghc/GHCi/UI/Exception.hs - ghc/ghc-bin.cabal.in - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - + testsuite/tests/package/T22884.hs - + testsuite/tests/package/T22884.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbc8e04e5d8fb05ff60568042802ab2fb34e1a70...34b44f7d22883ef89784c727c25f0dae225be8d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbc8e04e5d8fb05ff60568042802ab2fb34e1a70...34b44f7d22883ef89784c727c25f0dae225be8d2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 19:27:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 May 2023 15:27:17 -0400 Subject: [Git][ghc/ghc][master] 8 commits: ghcup-metadata: Don't override existing metadata if version already exists. Message-ID: <64710815ccf65_64cfb3898d6e471315d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -998,8 +998,9 @@ project-version: # Calculate the project version - . ./version.sh - # Download existing ghcup metadata - - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#wget -c wget "https://gitlab.haskell.org/ghc/ghcup-metadata/-/raw/updates/ghcup-0.0.7.yaml" + # Download existing ghcup metadata for the correct year + - PipelineYear="$(date -d $CI_PIPELINE_CREATED_AT +%Y)" + - nix shell nixpkgs#wget -c wget "https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-$PipelineYear-0.0.7.yaml" -O ghcup-0.0.7.yaml - .gitlab/generate_job_metadata @@ -1044,7 +1045,7 @@ ghcup-metadata-nightly: artifacts: false - job: project-version script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: $NIGHTLY @@ -1063,14 +1064,15 @@ ghcup-metadata-nightly-push: artifacts: true script: - git clone https://gitlab.haskell.org/ghc/ghcup-metadata.git - - cp metadata_test.yaml ghcup-metadata/ghcup-0.0.7.yaml + - PipelineYear="$(date -d $CI_PIPELINE_CREATED_AT +%Y)" + - cp metadata_test.yaml "ghcup-metadata/ghcup-nightlies-$PipelineYear-0.0.7.yaml" - cd ghcup-metadata - git config user.email "ghc-ci at gitlab-haskell.org" - git config user.name "GHC GitLab CI" - git remote add gitlab_origin https://oauth2:$PROJECT_PUSH_TOKEN at gitlab.haskell.org/ghc/ghcup-metadata.git - git add . - git commit -m "Update metadata" - - git push gitlab_origin HEAD:updates -o ci.skip + - git push gitlab_origin HEAD:updates rules: # Only run the update on scheduled nightly pipelines, ie once a day - if: $NIGHTLY && $CI_PIPELINE_SOURCE == "schedule" && $CI_COMMIT_BRANCH == "master" @@ -1080,7 +1082,7 @@ ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: '$RELEASE_JOB == "yes"' ===================================== .gitlab/rel_eng/mk-ghcup-metadata/README.mkd ===================================== @@ -18,6 +18,7 @@ options: --release-mode Generate metadata which points to downloads folder --fragment Output the generated fragment rather than whole modified file --version VERSION Version of the GHC compiler + --date DATE Date of the compiler release ``` The script also requires the `.gitlab/jobs-metadata.yaml` file which can be generated ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -63,7 +63,8 @@ eprint(f"Supported platforms: {job_mapping.keys()}") # Artifact precisely specifies a job what the bindist to download is called. class Artifact(NamedTuple): job_name: str - name: str + download_name: str + output_name: str subdir: str # Platform spec provides a specification which is agnostic to Job @@ -72,8 +73,14 @@ class PlatformSpec(NamedTuple): name: str subdir: str -source_artifact = Artifact('source-tarball', 'ghc-{version}-src.tar.xz', 'ghc-{version}' ) -test_artifact = Artifact('source-tarball', 'ghc-{version}-testsuite.tar.xz', 'ghc-{version}' ) +source_artifact = Artifact('source-tarball' + , 'ghc-{version}-src.tar.xz' + , 'ghc-{version}-src.tar.xz' + , 'ghc-{version}' ) +test_artifact = Artifact('source-tarball' + , 'ghc-{version}-testsuite.tar.xz' + , 'ghc-{version}-testsuite.tar.xz' + , 'ghc-{version}' ) def debian(arch, n): return linux_platform(arch, "{arch}-linux-deb{n}".format(arch=arch, n=n)) @@ -104,7 +111,7 @@ def linux_platform(arch, opsys): return PlatformSpec( opsys, 'ghc-{version}-{arch}-unknown-linux'.format(version="{version}", arch=arch) ) -base_url = 'https://gitlab.haskell.org/ghc/ghc/-/jobs/{job_id}/artifacts/raw/{artifact_name}' +base_url = 'https://gitlab.haskell.org/api/v4/projects/1/jobs/{job_id}/artifacts/{artifact_name}' hash_cache = {} @@ -129,7 +136,7 @@ def download_and_hash(url): def mk_one_metadata(release_mode, version, job_map, artifact): job_id = job_map[artifact.job_name].id - url = base_url.format(job_id=job_id, artifact_name=urllib.parse.quote_plus(artifact.name.format(version=version))) + url = base_url.format(job_id=job_id, artifact_name=urllib.parse.quote_plus(artifact.download_name.format(version=version))) # In --release-mode, the URL in the metadata needs to point into the downloads folder # rather then the pipeline. @@ -143,10 +150,13 @@ def mk_one_metadata(release_mode, version, job_map, artifact): eprint(f"Bindist URL: {url}") eprint(f"Download URL: {final_url}") - # Download and hash from the release pipeline, this must not change anyway during upload. + #Download and hash from the release pipeline, this must not change anyway during upload. h = download_and_hash(url) - res = { "dlUri": final_url, "dlSubdir": artifact.subdir.format(version=version), "dlHash" : h } + res = { "dlUri": final_url + , "dlSubdir": artifact.subdir.format(version=version) + , "dlOutput": artifact.output_name.format(version=version) + , "dlHash" : h } eprint(res) return res @@ -155,10 +165,14 @@ def mk_one_metadata(release_mode, version, job_map, artifact): def mk_from_platform(pipeline_type, platform): info = job_mapping[platform.name][pipeline_type] eprint(f"From {platform.name} / {pipeline_type} selecting {info['name']}") - return Artifact(info['name'] , f"{info['jobInfo']['bindistName']}.tar.xz", platform.subdir) + return Artifact(info['name'] + , f"{info['jobInfo']['bindistName']}.tar.xz" + , "ghc-{version}-{pn}.tar.xz".format(version="{version}", pn=platform.name) + , platform.subdir) + # Generate the new metadata for a specific GHC mode etc -def mk_new_yaml(release_mode, version, pipeline_type, job_map): +def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): def mk(platform): eprint("\n=== " + platform.name + " " + ('=' * (75 - len(platform.name)))) return mk_one_metadata(release_mode, version, job_map, mk_from_platform(pipeline_type, platform)) @@ -227,7 +241,14 @@ def mk_new_yaml(release_mode, version, pipeline_type, job_map): else: change_log = "https://gitlab.haskell.org" - return { "viTags": ["Latest", "TODO_base_version"] + if release_mode: + tags = ["Latest", "TODO_base_version"] + else: + tags = ["LatestNightly"] + + + return { "viTags": tags + , "viReleaseDay": date # Check that this link exists , "viChangeLog": change_log , "viSourceDL": source @@ -239,6 +260,15 @@ def mk_new_yaml(release_mode, version, pipeline_type, job_map): } +def setNightlyTags(ghcup_metadata): + for version in ghcup_metadata['ghcupDownloads']['GHC']: + if "LatestNightly" in ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"]: + ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].remove("LatestNightly") + ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly") + + + + def main() -> None: import argparse @@ -249,6 +279,7 @@ def main() -> None: parser.add_argument('--fragment', action='store_true', help='Output the generated fragment rather than whole modified file') # TODO: We could work out the --version from the project-version CI job. parser.add_argument('--version', required=True, type=str, help='Version of the GHC compiler') + parser.add_argument('--date', required=True, type=str, help='Date of the compiler release') args = parser.parse_args() project = gl.projects.get(1, lazy=True) @@ -269,17 +300,21 @@ def main() -> None: eprint(f"Pipeline Type: {pipeline_type}") - new_yaml = mk_new_yaml(args.release_mode, args.version, pipeline_type, job_map) + new_yaml = mk_new_yaml(args.release_mode, args.version, args.date, pipeline_type, job_map) if args.fragment: print(yaml.dump({ args.version : new_yaml })) else: with open(args.metadata, 'r') as file: ghcup_metadata = yaml.safe_load(file) + if args.version in ghcup_metadata['ghcupDownloads']['GHC']: + raise RuntimeError("Refusing to override existing version in metadata") + setNightlyTags(ghcup_metadata) ghcup_metadata['ghcupDownloads']['GHC'][args.version] = new_yaml print(yaml.dump(ghcup_metadata)) + if __name__ == '__main__': main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34b44f7d22883ef89784c727c25f0dae225be8d2...bc478bee6e7e46bcf30212ab94545a83bdeb0203 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34b44f7d22883ef89784c727c25f0dae225be8d2...bc478bee6e7e46bcf30212ab94545a83bdeb0203 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 19:27:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 May 2023 15:27:56 -0400 Subject: [Git][ghc/ghc][master] JS: Convert rendering to use HLine instead of SDoc (#22455) Message-ID: <6471083c8e65_64cfb296177307164a6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - 11 changed files: - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - docs/users_guide/debugging.rst Changes: ===================================== compiler/GHC/Driver/Config/StgToJS.hs ===================================== @@ -20,6 +20,7 @@ initStgToJSConfig dflags = StgToJSConfig , csInlineLoadRegs = False , csInlineEnter = False , csInlineAlloc = False + , csPrettyRender = gopt Opt_DisableJsMinifier dflags , csTraceRts = False , csAssertRts = False , csBoundsCheck = gopt Opt_DoBoundsChecking dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -314,6 +314,9 @@ data GeneralFlag | Opt_WriteInterface -- forces .hi files to be written even with -fno-code | Opt_WriteHie -- generate .hie files + -- JavaScript opts + | Opt_DisableJsMinifier -- ^ render JavaScript pretty-printed instead of minified (compacted) + -- profiling opts | Opt_AutoSccsOnIndividualCafs | Opt_ProfCountEntries ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1861,6 +1861,10 @@ dynamic_flags_deps = [ , (NotDeprecated, customOrUnrecognisedWarning "W" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fwarn-" setCustomWarningFlag) , (Deprecated, customOrUnrecognisedWarning "fno-warn-" unSetCustomWarningFlag) + ] + + ------ JavaScript flags ----------------------------------------------- + ++ [ make_ord_flag defFlag "ddisable-js-minifier" (NoArg (setGeneralFlag Opt_DisableJsMinifier)) ] ------ Language flags ------------------------------------------------- ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -184,7 +184,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv ) <> semi _ -> empty - strlit xs = docToSDoc (pprStringLit xs) + strlit xs = pprStringLit xs -- the target which will form the root of what we ask rts_evalIO to run the_cfun ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TypeApplications #-} -- For Outputable instances for JS syntax {-# OPTIONS_GHC -Wno-orphans #-} @@ -55,12 +56,13 @@ module GHC.JS.Ppr , JsToDoc(..) , defaultRenderJs , RenderJs(..) + , JsRender(..) , jsToDoc , pprStringLit - , braceNest - , hangBrace , interSemi , addSemi + , braceNest + , hangBrace ) where @@ -75,16 +77,15 @@ import Data.List (sortOn) import Numeric(showHex) -import GHC.Utils.Outputable (Outputable (..), docToSDoc) -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map instance Outputable JExpr where - ppr = docToSDoc . renderJs + ppr = renderJs instance Outputable JVal where - ppr = docToSDoc . renderJs + ppr = renderJs -------------------------------------------------------------------------------- -- Top level API @@ -93,87 +94,86 @@ instance Outputable JVal where -- | Render a syntax tree as a pretty-printable document -- (simply showing the resultant doc produces a nice, -- well formatted String). -renderJs :: (JsToDoc a) => a -> Doc +renderJs :: (JsToDoc a) => a -> SDoc renderJs = renderJs' defaultRenderJs -renderJs' :: (JsToDoc a) => RenderJs -> a -> Doc +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs HLine -> a -> HLine #-} +{-# SPECIALISE renderJs' :: JsToDoc a => RenderJs SDoc -> a -> SDoc #-} +renderJs' :: (JsToDoc a, JsRender doc) => RenderJs doc -> a -> doc renderJs' r = jsToDocR r -data RenderJs = RenderJs - { renderJsS :: !(RenderJs -> JStat -> Doc) - , renderJsE :: !(RenderJs -> JExpr -> Doc) - , renderJsV :: !(RenderJs -> JVal -> Doc) - , renderJsI :: !(RenderJs -> Ident -> Doc) +data RenderJs doc = RenderJs + { renderJsS :: !(JsRender doc => RenderJs doc -> JStat -> doc) + , renderJsE :: !(JsRender doc => RenderJs doc -> JExpr -> doc) + , renderJsV :: !(JsRender doc => RenderJs doc -> JVal -> doc) + , renderJsI :: !(JsRender doc => RenderJs doc -> Ident -> doc) } -defaultRenderJs :: RenderJs +defaultRenderJs :: RenderJs doc defaultRenderJs = RenderJs defRenderJsS defRenderJsE defRenderJsV defRenderJsI -jsToDoc :: JsToDoc a => a -> Doc +jsToDoc :: JsToDoc a => a -> SDoc jsToDoc = jsToDocR defaultRenderJs -- | Render a syntax tree as a pretty-printable document, using a given prefix -- to all generated names. Use this with distinct prefixes to ensure distinct -- generated names between independent calls to render(Prefix)Js. -renderPrefixJs :: (JsToDoc a, JMacro a) => a -> Doc +renderPrefixJs :: (JsToDoc a, JMacro a) => a -> SDoc renderPrefixJs = renderPrefixJs' defaultRenderJs -renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc +renderPrefixJs' :: (JsToDoc a, JMacro a, JsRender doc) => RenderJs doc -> a -> doc renderPrefixJs' r = jsToDocR r -------------------------------------------------------------------------------- -- Code Generator -------------------------------------------------------------------------------- -class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc +class JsToDoc a where jsToDocR :: JsRender doc => RenderJs doc -> a -> doc instance JsToDoc JStat where jsToDocR r = renderJsS r r instance JsToDoc JExpr where jsToDocR r = renderJsE r r instance JsToDoc JVal where jsToDocR r = renderJsV r r instance JsToDoc Ident where jsToDocR r = renderJsI r r -instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) -instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r) +instance JsToDoc [JExpr] where jsToDocR r = jcat . map (addSemi . jsToDocR r) +instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) -defRenderJsS :: RenderJs -> JStat -> Doc +defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <> parens (jsToDocR r cond)) - (jsToDocR r x) - $$ mbElse - where mbElse | y == BlockStat [] = PP.empty - | otherwise = hangBrace (text "else") (jsToDocR r y) + IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) + (jnest $ optBlock r x) + <+?> mbElse + where mbElse | y == BlockStat [] = empty + | otherwise = hangBrace (text "else") (jnest $ optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x - DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+> char '=' <+> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <> parens (jsToDocR r p)) (jsToDocR r b) - WhileStat True p b -> (hangBrace (text "do") (jsToDocR r b)) $+$ text "while" <+> parens (jsToDocR r p) - BreakStat l -> maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l - ContinueStat l -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l - LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s + DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) + WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l + ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l + LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s where - printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss + printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) where - forCond = parens $ hcat $ interSemi - [ jsToDocR r init - , jsToDocR r p - , parens (jsToDocR r s1) - ] - ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b) + forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) where txt | each = "for each" | otherwise = "for" - SwitchStat e l d -> hangBrace (text "switch" <+> parens (jsToDocR r e)) cases - where l' = map (\(c,s) -> (text "case" <+> parens (jsToDocR r c) <> char ':') $$$ (jsToDocR r s)) l ++ [text "default:" $$$ (jsToDocR r d)] - cases = vcat l' + SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases + where l' = map (\(c,s) -> (text "case" <+?> parens (jsToDocR r c) <> colon) $$$ jnest (optBlock r s)) l + ++ [(text "default:") $$$ jnest (optBlock r d)] + cases = foldl1 ($$$) l' ReturnStat e -> text "return" <+> jsToDocR r e - ApplStat e es -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es) + ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i - <> parens (fsep . punctuate comma . map (jsToDocR r) $ is)) - (jsToDocR r b) - TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally - where mbCatch | s1 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1) - mbFinally | s2 == BlockStat [] = PP.empty - | otherwise = hangBrace (text "finally") (jsToDocR r s2) + <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) + (jnest $ optBlock r b) + TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally + where mbCatch | s1 == BlockStat [] = empty + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + mbFinally | s2 == BlockStat [] = empty + | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. @@ -183,36 +183,41 @@ defRenderJsS r = \case -- ... -- }); -- - ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"] - _ -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x + ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs -optParens :: RenderJs -> JExpr -> Doc +optBlock :: JsRender doc => RenderJs doc -> JStat -> doc +optBlock r x = case x of + BlockStat{} -> jsToDocR r x + _ -> addSemi $ jsToDocR r x + +optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of UOpExpr _ _ -> parens (jsToDocR r x) _ -> jsToDocR r x -defRenderJsE :: RenderJs -> JExpr -> Doc +defRenderJsE :: JsRender doc => RenderJs doc -> JExpr -> doc defRenderJsE r = \case ValExpr x -> jsToDocR r x SelExpr x y -> jsToDocR r x <> char '.' <> jsToDocR r y IdxExpr x y -> jsToDocR r x <> brackets (jsToDocR r y) - IfExpr x y z -> parens (jsToDocR r x <+> char '?' <+> jsToDocR r y <+> char ':' <+> jsToDocR r z) - InfixExpr op x y -> parens $ hsep [jsToDocR r x, ftext (opText op), jsToDocR r y] + IfExpr x y z -> parens (jsToDocR r x <+?> char '?' <+?> jsToDocR r y <+?> colon <+?> jsToDocR r z) + InfixExpr op x y -> parens $ jsToDocR r x <+?> ftext (opText op) <+?> jsToDocR r y UOpExpr op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x - | isPre op -> ftext (uOpText op) <> optParens r x - | otherwise -> optParens r x <> ftext (uOpText op) - ApplExpr je xs -> jsToDocR r je <> (parens . hsep . punctuate comma $ map (jsToDocR r) xs) + | isPre op -> ftext (uOpText op) <+> optParens r x + | otherwise -> optParens r x <+> ftext (uOpText op) + ApplExpr je xs -> jsToDocR r je <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs) -defRenderJsV :: RenderJs -> JVal -> Doc +defRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc defRenderJsV r = \case JVar i -> jsToDocR r i - JList xs -> brackets . hsep . punctuate comma $ map (jsToDocR r) xs + JList xs -> brackets . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) xs JDouble (SaneDouble d) | d < 0 || isNegativeZero d -> parens (double d) | otherwise -> double d @@ -220,17 +225,17 @@ defRenderJsV r = \case | i < 0 -> parens (integer i) | otherwise -> integer i JStr s -> pprStringLit s - JRegEx s -> hcat [char '/',ftext s, char '/'] + JRegEx s -> char '/' <> ftext s <> char '/' JHash m | isNullUniqMap m -> text "{}" - | otherwise -> braceNest . hsep . punctuate comma . - map (\(x,y) -> squotes (ftext x) <> colon <+> jsToDocR r y) + | otherwise -> braceNest . foldl' (<+?>) empty . punctuate comma . + map (\(x,y) -> char '\'' <> ftext x <> char '\'' <> colon <+?> jsToDocR r y) -- nonDetKeysUniqMap doesn't introduce non-determinism here -- because we sort the elements lexically $ sortOn (LexicalFastString . fst) (nonDetUniqMapToList m) - JFunc is b -> parens $ hangBrace (text "function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) + JFunc is b -> parens $ hangBrace (text "function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b) -defRenderJsI :: RenderJs -> Ident -> Doc +defRenderJsI :: JsRender doc => RenderJs doc -> Ident -> doc defRenderJsI _ (TxtI t) = ftext t aOpText :: AOp -> FastString @@ -298,17 +303,17 @@ isAlphaOp = \case VoidOp -> True _ -> False -pprStringLit :: FastString -> Doc -pprStringLit s = hcat [char '\"',encodeJson s, char '\"'] +pprStringLit :: IsLine doc => FastString -> doc +pprStringLit s = char '\"' <> encodeJson s <> char '\"' -------------------------------------------------------------------------------- -- Utilities -------------------------------------------------------------------------------- -encodeJson :: FastString -> Doc +encodeJson :: IsLine doc => FastString -> doc encodeJson xs = hcat (map encodeJsonChar (unpackFS xs)) -encodeJsonChar :: Char -> Doc +encodeJsonChar :: IsLine doc => Char -> doc encodeJsonChar = \case '/' -> text "\\/" '\b' -> text "\\b" @@ -329,24 +334,54 @@ encodeJsonChar = \case let h = showHex cp "" in text (prefix ++ replicate (pad - length h) '0' ++ h) -braceNest :: Doc -> Doc -braceNest x = char '{' <+> nest 2 x $$ char '}' - -interSemi :: [Doc] -> [Doc] -interSemi [] = [] -interSemi [s] = [s] -interSemi (x:xs) = x <> text ";" : interSemi xs -addSemi :: Doc -> Doc -addSemi x = x <> text ";" - --- | Hang with braces: --- --- hdr { --- body --- } -hangBrace :: Doc -> Doc -> Doc -hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ] - -($$$) :: Doc -> Doc -> Doc -x $$$ y = nest 2 $ x $+$ y +interSemi :: JsRender doc => [doc] -> doc +interSemi = foldl ($$$) empty . punctuateFinal semi semi + +addSemi :: IsLine doc => doc -> doc +addSemi x = x <> semi <> char '\n' + +-- | The structure `{body}`, optionally indented over multiple lines +{-# INLINE braceNest #-} +braceNest :: JsRender doc => doc -> doc +braceNest x = lbrace $$$ jnest x $$$ rbrace + +-- | The structure `hdr {body}`, optionally indented over multiple lines +{-# INLINE hangBrace #-} +hangBrace :: JsRender doc => doc -> doc -> doc +hangBrace hdr body = hdr <+?> braceNest body + +-- | JsRender controls the differences in whitespace between HLine and SDoc. +-- Generally, this involves the indentation and newlines in the human-readable +-- SDoc implementation being replaced in the HLine version by the minimal +-- whitespace required for valid JavaScript syntax. +class IsLine doc => JsRender doc where + + -- | Concatenate with an optional single space + (<+?>) :: doc -> doc -> doc + -- | Concatenate with an optional newline + ($$$) :: doc -> doc -> doc + -- | Concatenate these `doc`s, either vertically (SDoc) or horizontally (HLine) + jcat :: [doc] -> doc + -- | Optionally indent the following + jnest :: doc -> doc + +instance JsRender SDoc where + (<+?>) = (<+>) + {-# INLINE (<+?>) #-} + ($$$) = ($$) + {-# INLINE ($$$) #-} + jcat = vcat + {-# INLINE jcat #-} + jnest = nest 2 + {-# INLINE jnest #-} + +instance JsRender HLine where + (<+?>) = (<>) + {-# INLINE (<+?>) #-} + ($$$) = (<>) + {-# INLINE ($$$) #-} + jcat = hcat + {-# INLINE jcat #-} + jnest = id + {-# INLINE jnest #-} ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -91,7 +91,7 @@ stgToJS logger config stg_binds0 this_mod spt_entries foreign_stubs cccs output_ -- Doc to dump when -ddump-js is enabled when (logHasDumpFlag logger Opt_D_dump_js) $ do putDumpFileMaybe logger Opt_D_dump_js "JavaScript code" FormatJS - $ vcat (fmap (docToSDoc . jsToDoc . oiStat . luObjUnit) lus) + $ vcat (fmap (jsToDoc . oiStat . luObjUnit) lus) -- Write the object file bh <- openBinMem (4 * 1024 * 1000) -- a bit less than 4kB ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Unit.Types import GHC.Unit.Module (moduleStableString) import GHC.Utils.Outputable hiding ((<>)) +import GHC.Utils.BufHandle import GHC.Utils.Panic import GHC.Utils.Error import GHC.Utils.Logger (Logger, logVerbAtLeast) @@ -80,7 +81,6 @@ import Control.Monad import Data.Array import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import Data.Function (on) @@ -118,6 +118,9 @@ newtype ArchiveState = ArchiveState { loadedArchives :: IORef (Map FilePath Ar.A emptyArchiveState :: IO ArchiveState emptyArchiveState = ArchiveState <$> newIORef M.empty +defaultJsContext :: SDocContext +defaultJsContext = defaultSDocContext{sdocStyle = PprCode} + jsLinkBinary :: JSLinkConfig -> StgToJSConfig @@ -173,7 +176,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- LTO + rendering of JS code link_stats <- withBinaryFile (out "out.js") WriteMode $ \h -> - renderLinker h mods jsFiles + renderLinker h (csPrettyRender cfg) mods jsFiles ------------------------------------------------------------- @@ -194,8 +197,13 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do - BL.writeFile (out "rts.js") ( BLC.pack rtsDeclsText - <> BLC.pack (rtsText cfg)) + withFile (out "rts.js") WriteMode $ \h -> do + if csPrettyRender cfg + then printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) + bFlush bh -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -302,10 +310,11 @@ data CompactedModuleCode = CompactedModuleCode -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle + -> Bool -- ^ should we render readable JS for debugging? -> [ModuleCode] -- ^ linked code per module -> [FilePath] -- ^ additional JS files -> IO LinkerStats -renderLinker h mods jsFiles = do +renderLinker h render_pretty mods jsFiles = do -- link modules let (compacted_mods, meta) = linkModules mods @@ -314,8 +323,14 @@ renderLinker h mods jsFiles = do putBS = B.hPut h putJS x = do before <- hTell h - Ppr.printLeftRender h (pretty x) - hPutChar h '\n' + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) + else do + bh <- newBufHandle h + -- Append an empty line to correctly end the file in a newline + bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) + bFlush bh after <- hTell h pure $! (after - before) ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -31,7 +31,7 @@ import GHC.Exts import GHC.JS.Syntax import GHC.JS.Ppr -import GHC.Utils.Ppr as PP +import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map @@ -39,10 +39,10 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JStat -> Doc +pretty :: JsRender doc => JStat -> doc pretty = jsToDocR ghcjsRenderJs -ghcjsRenderJs :: RenderJs +ghcjsRenderJs :: RenderJs doc ghcjsRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS @@ -52,7 +52,7 @@ ghcjsRenderJs = defaultRenderJs hdd :: SBS.ShortByteString hdd = SBS.pack (map (fromIntegral . ord) "h$$") -ghcjsRenderJsI :: RenderJs -> Ident -> Doc +ghcjsRenderJsI :: IsLine doc => RenderJs doc -> Ident -> doc ghcjsRenderJsI _ (TxtI fs) -- Fresh symbols are prefixed with "h$$". They aren't explicitly referred by -- name in user code, only in compiled code. Hence we can rename them if we do @@ -75,7 +75,7 @@ ghcjsRenderJsI _ (TxtI fs) -- | Render as an hexadecimal number in reversed order (because it's faster and we -- don't care about the actual value). -hexDoc :: Word -> Doc +hexDoc :: IsLine doc => Word -> doc hexDoc 0 = char '0' hexDoc v = text $ go v where @@ -91,23 +91,23 @@ hexDoc v = text $ go v -- attempt to resugar some of the common constructs -ghcjsRenderJsS :: RenderJs -> JStat -> Doc +ghcjsRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc ghcjsRenderJsS r s = renderJsS defaultRenderJs r s -- don't quote keys in our object literals, so closure compiler works -ghcjsRenderJsV :: RenderJs -> JVal -> Doc +ghcjsRenderJsV :: JsRender doc => RenderJs doc -> JVal -> doc ghcjsRenderJsV r (JHash m) | isNullUniqMap m = text "{}" - | otherwise = braceNest . PP.fsep . punctuate comma . - map (\(x,y) -> quoteIfRequired x <> PP.colon <+> jsToDocR r y) + | otherwise = braceNest . fsep . punctuate comma . + map (\(x,y) -> quoteIfRequired x <> colon <+> jsToDocR r y) -- nonDetEltsUniqMap doesn't introduce non-determinism here because -- we sort the elements lexically . sortOn (LexicalFastString . fst) $ nonDetUniqMapToList m where - quoteIfRequired :: FastString -> Doc + quoteIfRequired :: IsLine doc => FastString -> doc quoteIfRequired x | isUnquotedKey x = ftext x - | otherwise = PP.squotes (ftext x) + | otherwise = char '\'' <> ftext x <> char '\'' isUnquotedKey :: FastString -> Bool isUnquotedKey fs = case unpackFS fs of ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -O0 #-} @@ -45,6 +46,7 @@ import GHC.StgToJS.Linker.Opt import GHC.Data.FastString import GHC.Types.Unique.Map +import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -314,12 +316,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRets] -- | print the embedded RTS to a String -rtsText :: StgToJSConfig -> String -rtsText = show . pretty . jsOptimize . rts +rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc +rtsText = pretty @doc . jsOptimize . rts -- | print the RTS declarations to a String. -rtsDeclsText :: String -rtsDeclsText = show . pretty . jsOptimize $ rtsDecls +rtsDeclsText :: forall doc. JsRender doc => doc +rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' rts :: StgToJSConfig -> Sat.JStat ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -86,6 +86,7 @@ data StgToJSConfig = StgToJSConfig , csInlineLoadRegs :: !Bool , csInlineEnter :: !Bool , csInlineAlloc :: !Bool + , csPrettyRender :: !Bool , csTraceRts :: !Bool , csAssertRts :: !Bool , csBoundsCheck :: !Bool ===================================== docs/users_guide/debugging.rst ===================================== @@ -723,6 +723,16 @@ assembler. Dump the final JavaScript code produced by the JavaScript code generator. +JavaScript code generator +~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. ghc-flag:: -ddisable-js-minifier + :shortdesc: Generate pretty-printed JavaScript code instead of minified (compacted) code. + :type: dynamic + + Include human-readable spacing and indentation when generating JavaScript. + + Miscellaneous backend dumps ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bdbd9da5a3a43a40743df3bf31b861c5c926a85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bdbd9da5a3a43a40743df3bf31b861c5c926a85 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 19:28:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 May 2023 15:28:28 -0400 Subject: [Git][ghc/ghc][master] testsuite: add WasmControlFlow test Message-ID: <6471085c6b20e_64cfb41c79b107199da@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 30 changed files: - compiler/GHC/Wasm/ControlFlow/FromCmm.hs - + testsuite/tests/wasm/should_run/control-flow/ActionsAndObservations.hs - + testsuite/tests/wasm/should_run/control-flow/BitConsumer.hs - + testsuite/tests/wasm/should_run/control-flow/CmmPaths.hs - + testsuite/tests/wasm/should_run/control-flow/ControlTestMonad.hs - + testsuite/tests/wasm/should_run/control-flow/EntropyTransducer.hs - + testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs - + testsuite/tests/wasm/should_run/control-flow/README.md - + testsuite/tests/wasm/should_run/control-flow/RunCmm.hs - + testsuite/tests/wasm/should_run/control-flow/RunWasm.hs - + testsuite/tests/wasm/should_run/control-flow/WasmControlFlow.hs - + testsuite/tests/wasm/should_run/control-flow/WasmControlFlow.stdout - + testsuite/tests/wasm/should_run/control-flow/all.T - + testsuite/tests/wasm/should_run/control-flow/src/Church.hs - + testsuite/tests/wasm/should_run/control-flow/src/Closure.hs - + testsuite/tests/wasm/should_run/control-flow/src/FailingLint.hs - + testsuite/tests/wasm/should_run/control-flow/src/Irr.hs - + testsuite/tests/wasm/should_run/control-flow/src/Irr2.hs - + testsuite/tests/wasm/should_run/control-flow/src/Irr3.hs - + testsuite/tests/wasm/should_run/control-flow/src/Irr4.hs - + testsuite/tests/wasm/should_run/control-flow/src/Length.hs - + testsuite/tests/wasm/should_run/control-flow/src/Map.hs - + testsuite/tests/wasm/should_run/control-flow/src/Max.hs - + testsuite/tests/wasm/should_run/control-flow/src/PJIf.hs - + testsuite/tests/wasm/should_run/control-flow/src/dec.cmm - + testsuite/tests/wasm/should_run/control-flow/src/dloop.cmm - + testsuite/tests/wasm/should_run/control-flow/src/ex10.cmm - + testsuite/tests/wasm/should_run/control-flow/src/ex9.cmm - + testsuite/tests/wasm/should_run/control-flow/src/fig1b.cmm - + testsuite/tests/wasm/should_run/control-flow/src/hardswitch.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abd9e37ced25bd5c20d11934e937b92c00f62f6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abd9e37ced25bd5c20d11934e937b92c00f62f6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 19:29:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 26 May 2023 15:29:34 -0400 Subject: [Git][ghc/ghc][master] Factorize getLinkDeps Message-ID: <6471089e8abf8_64cfb41d03cd47230d1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - 6 changed files: - compiler/GHC/Iface/Load.hs - + compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Tc/Types.hs - compiler/ghc.cabal.in - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -30,6 +30,8 @@ module GHC.Iface.Load ( moduleFreeHolesPrecise, needWiredInHomeIface, loadWiredInHomeIface, + WhereFrom(..), + pprModIfaceSimple, ifaceStats, pprModIface, showIface, @@ -1222,3 +1224,20 @@ pprExtensibleFields :: ExtensibleFields -> SDoc pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ toList fs where pprField (name, (BinData size _data)) = text name <+> text "-" <+> ppr size <+> text "bytes" + + +-- | Reason for loading an interface file +-- +-- Used to figure out whether we want to consider loading hi-boot files or not. +data WhereFrom + = ImportByUser IsBootInterface -- Ordinary user import (perhaps {-# SOURCE #-}) + | ImportBySystem -- Non user import. + | ImportByPlugin -- Importing a plugin. + +instance Outputable WhereFrom where + ppr (ImportByUser IsBoot) = text "{- SOURCE -}" + ppr (ImportByUser NotBoot) = empty + ppr ImportBySystem = text "{- SYSTEM -}" + ppr ImportByPlugin = text "{- PLUGIN -}" + + ===================================== compiler/GHC/Linker/Deps.hs ===================================== @@ -0,0 +1,411 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections, RecordWildCards #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} + +module GHC.Linker.Deps + ( LinkDepsOpts (..) + , LinkDeps (..) + , getLinkDeps + ) +where + +import GHC.Prelude + +import GHC.Platform.Ways + +import GHC.Runtime.Interpreter + +import GHC.Linker.Types + +import GHC.Types.SourceFile +import GHC.Types.SrcLoc +import GHC.Types.Unique.DSet +import GHC.Types.Unique.DFM + +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Panic.Plain +import GHC.Utils.Error + +import GHC.Unit.Env +import GHC.Unit.Finder +import GHC.Unit.Module +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.WholeCoreBindings +import GHC.Unit.Module.Deps +import GHC.Unit.Module.Graph +import GHC.Unit.Home.ModInfo + +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr + +import GHC.Utils.Misc +import GHC.Unit.Home +import GHC.Data.Maybe + +import Control.Monad +import Control.Applicative + +import qualified Data.Set as Set +import qualified Data.Map as M +import Data.List (isSuffixOf) +import Data.Either + +import System.FilePath +import System.Directory + + +data LinkDepsOpts = LinkDepsOpts + { ldObjSuffix :: !String -- ^ Suffix of .o files + , ldOneShotMode :: !Bool -- ^ Is the driver in one-shot mode? + , ldModuleGraph :: !ModuleGraph -- ^ Module graph + , ldUnitEnv :: !UnitEnv -- ^ Unit environment + , ldPprOpts :: !SDocContext -- ^ Rendering options for error messages + , ldFinderCache :: !FinderCache -- ^ Finder cache + , ldFinderOpts :: !FinderOpts -- ^ Finder options + , ldUseByteCode :: !Bool -- ^ Use bytecode rather than objects + , ldMsgOpts :: !(DiagnosticOpts IfaceMessage) -- ^ Options for diagnostics + , ldWays :: !Ways -- ^ Enabled ways + , ldLoadIface :: SDoc -> Module -> IO (MaybeErr MissingInterfaceError ModIface) + -- ^ Interface loader function + } + +data LinkDeps = LinkDeps + { ldNeededLinkables :: [Linkable] + , ldAllLinkables :: [Linkable] + , ldUnits :: [UnitId] + , ldNeededUnits :: UniqDSet UnitId + } + +-- | Find all the packages and linkables that a set of modules depends on +-- +-- Return the module and package dependencies for the needed modules. +-- See Note [Object File Dependencies] +-- +-- Fails with an IO exception if it can't find enough files +-- +getLinkDeps + :: LinkDepsOpts + -> Interp + -> LoaderState + -> SrcSpan -- for error messages + -> [Module] -- If you need these + -> IO LinkDeps -- ... then link these first +getLinkDeps opts interp pls span mods = do + -- The interpreter and dynamic linker can only handle object code built + -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky. + -- So here we check the build tag: if we're building a non-standard way + -- then we need to find & link object files built the "normal" way. + maybe_normal_osuf <- checkNonStdWay opts interp span + + get_link_deps opts pls maybe_normal_osuf span mods + + +get_link_deps + :: LinkDepsOpts + -> LoaderState + -> Maybe FilePath -- replace object suffixes? + -> SrcSpan + -> [Module] + -> IO LinkDeps +get_link_deps opts pls maybe_normal_osuf span mods = do + -- 1. Find the dependent home-pkg-modules/packages from each iface + -- (omitting modules from the interactive package, which is already linked) + (mods_s, pkgs_s) <- + -- Why two code paths here? There is a significant amount of repeated work + -- performed calculating transitive dependencies + -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests) + if ldOneShotMode opts + then follow_deps (filterOut isInteractiveModule mods) + emptyUniqDSet emptyUniqDSet; + else do + (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods + return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs)) + + let + -- 2. Exclude ones already linked + -- Main reason: avoid findModule calls in get_linkable + (mods_needed, links_got) = partitionEithers (map split_mods mods_s) + pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls + + split_mods mod = + let is_linked = lookupModuleEnv (objs_loaded pls) mod + <|> lookupModuleEnv (bcos_loaded pls) mod + in case is_linked of + Just linkable -> Right linkable + Nothing -> Left mod + + -- 3. For each dependent module, find its linkable + -- This will either be in the HPT or (in the case of one-shot + -- compilation) we may need to use maybe_getFileLinkable + lnks_needed <- mapM (get_linkable (ldObjSuffix opts)) mods_needed + + return $ LinkDeps + { ldNeededLinkables = lnks_needed + , ldAllLinkables = links_got ++ lnks_needed + , ldUnits = pkgs_needed + , ldNeededUnits = pkgs_s + } + where + mod_graph = ldModuleGraph opts + unit_env = ldUnitEnv opts + + -- This code is used in `--make` mode to calculate the home package and unit dependencies + -- for a set of modules. + -- + -- It is significantly more efficient to use the shared transitive dependency + -- calculation than to compute the transitive dependency set in the same manner as oneShot mode. + + -- It is also a matter of correctness to use the module graph so that dependencies between home units + -- is resolved correctly. + make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) + make_deps_loop found [] = found + make_deps_loop found@(found_units, found_mods) (nk:nexts) + | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts + | otherwise = + case M.lookup (NodeKey_Module nk) (mgTransDeps mod_graph) of + Just trans_deps -> + let deps = Set.insert (NodeKey_Module nk) trans_deps + -- See #936 and the ghci.prog007 test for why we have to continue traversing through + -- boot modules. + todo_boot_mods = [ModNodeKeyWithUid (GWIB mn NotBoot) uid | NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid) <- Set.toList trans_deps] + in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts) + Nothing -> + let (ModNodeKeyWithUid _ uid) = nk + in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts + + mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) + (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) + + all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps] + + get_mod_info (ModNodeKeyWithUid gwib uid) = + case lookupHug (ue_home_unit_graph unit_env) uid (gwib_mod gwib) of + Just hmi -> + let iface = (hm_iface hmi) + mmod = case mi_hsc_src iface of + HsBootFile -> link_boot_mod_error (mi_module iface) + _ -> return $ Just (mi_module iface) + + in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod + Nothing -> throwProgramError opts $ + text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid + + + -- This code is used in one-shot mode to traverse downwards through the HPT + -- to find all link dependencies. + -- The ModIface contains the transitive closure of the module dependencies + -- within the current package, *except* for boot modules: if we encounter + -- a boot module, we have to find its real interface and discover the + -- dependencies of that. Hence we need to traverse the dependency + -- tree recursively. See bug #936, testcase ghci/prog007. + follow_deps :: [Module] -- modules to follow + -> UniqDSet Module -- accum. module dependencies + -> UniqDSet UnitId -- accum. package dependencies + -> IO ([Module], UniqDSet UnitId) -- result + follow_deps [] acc_mods acc_pkgs + = return (uniqDSetToList acc_mods, acc_pkgs) + follow_deps (mod:mods) acc_mods acc_pkgs + = do + mb_iface <- ldLoadIface opts msg mod + iface <- case mb_iface of + Failed err -> throwProgramError opts $ + missingInterfaceErrorDiagnostic (ldMsgOpts opts) err + Succeeded iface -> return iface + + when (mi_boot iface == IsBoot) $ link_boot_mod_error mod + + let + pkg = moduleUnit mod + deps = mi_deps iface + + pkg_deps = dep_direct_pkgs deps + (boot_deps, mod_deps) = flip partitionWith (Set.toList (dep_direct_mods deps)) $ + \case + (_, GWIB m IsBoot) -> Left m + (_, GWIB m NotBoot) -> Right m + + mod_deps' = case ue_homeUnit unit_env of + Nothing -> [] + Just home_unit -> filter (not . (`elementOfUniqDSet` acc_mods)) (map (mkHomeModule home_unit) $ (boot_deps ++ mod_deps)) + acc_mods' = case ue_homeUnit unit_env of + Nothing -> acc_mods + Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) + acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) + + case ue_homeUnit unit_env of + Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) + acc_mods' acc_pkgs' + _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg)) + where + msg = text "need to link module" <+> ppr mod <+> + text "due to use of Template Haskell" + + + + link_boot_mod_error :: Module -> IO a + link_boot_mod_error mod = throwProgramError opts $ + text "module" <+> ppr mod <+> + text "cannot be linked; it is only available as a boot module" + + no_obj :: Outputable a => a -> IO b + no_obj mod = dieWith opts span $ + text "cannot find object file for module " <> + quotes (ppr mod) $$ + while_linking_expr + + while_linking_expr = text "while linking an interpreted expression" + + + -- See Note [Using Byte Code rather than Object Code for Template Haskell] + homeModLinkable :: HomeModInfo -> Maybe Linkable + homeModLinkable hmi = + if ldUseByteCode opts + then homeModInfoByteCode hmi <|> homeModInfoObject hmi + else homeModInfoObject hmi <|> homeModInfoByteCode hmi + + get_linkable osuf mod -- A home-package module + | Just mod_info <- lookupHugByModule mod (ue_home_unit_graph unit_env) + = adjust_linkable (expectJust "getLinkDeps" (homeModLinkable mod_info)) + | otherwise + = do -- It's not in the HPT because we are in one shot mode, + -- so use the Finder to get a ModLocation... + case ue_homeUnit unit_env of + Nothing -> no_obj mod + Just home_unit -> do + + let fc = ldFinderCache opts + let fopts = ldFinderOpts opts + mb_stuff <- findHomeModule fc fopts home_unit (moduleName mod) + case mb_stuff of + Found loc mod -> found loc mod + _ -> no_obj (moduleName mod) + where + found loc mod = do { + -- ...and then find the linkable for it + mb_lnk <- findObjectLinkableMaybe mod loc ; + case mb_lnk of { + Nothing -> no_obj mod ; + Just lnk -> adjust_linkable lnk + }} + + adjust_linkable lnk + | Just new_osuf <- maybe_normal_osuf = do + new_uls <- mapM (adjust_ul new_osuf) + (linkableUnlinked lnk) + return lnk{ linkableUnlinked=new_uls } + | otherwise = + return lnk + + adjust_ul new_osuf (DotO file) = do + massert (osuf `isSuffixOf` file) + let file_base = fromJust (stripExtension osuf file) + new_file = file_base <.> new_osuf + ok <- doesFileExist new_file + if (not ok) + then dieWith opts span $ + text "cannot find object file " + <> quotes (text new_file) $$ while_linking_expr + else return (DotO new_file) + adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp) + adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp) + adjust_ul _ l@(BCOs {}) = return l + adjust_ul _ l at LoadedBCOs{} = return l + adjust_ul _ (CoreBindings (WholeCoreBindings _ mod _)) = pprPanic "Unhydrated core bindings" (ppr mod) + +{- +Note [Using Byte Code rather than Object Code for Template Haskell] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The `-fprefer-byte-code` flag allows a user to specify that they want to use +byte code (if availble) rather than object code for home module dependenices +when executing Template Haskell splices. + +Why might you want to use byte code rather than object code? + +* Producing object code is much slower than producing byte code (for example if you're using -fno-code) +* Linking many large object files, which happens once per splice, is quite expensive. (#21700) + +So we allow the user to choose to use byte code rather than object files if they want to avoid these +two pitfalls. + +When using `-fprefer-byte-code` you have to arrange to have the byte code availble. +In normal --make mode it will not be produced unless you enable `-fbyte-code-and-object-code`. +See Note [Home module build products] for some more information about that. + +The only other place where the flag is consulted is when enabling code generation +with `-fno-code`, which does so to anticipate what decision we will make at the +splice point about what we would prefer. + +-} + +dieWith :: LinkDepsOpts -> SrcSpan -> SDoc -> IO a +dieWith opts span msg = throwProgramError opts (mkLocMessage MCFatal span msg) + +throwProgramError :: LinkDepsOpts -> SDoc -> IO a +throwProgramError opts doc = throwGhcExceptionIO (ProgramError (renderWithContext (ldPprOpts opts) doc)) + +checkNonStdWay :: LinkDepsOpts -> Interp -> SrcSpan -> IO (Maybe FilePath) +checkNonStdWay _opts interp _srcspan + | ExternalInterp {} <- interpInstance interp = return Nothing + -- with -fexternal-interpreter we load the .o files, whatever way + -- they were built. If they were built for a non-std way, then + -- we will use the appropriate variant of the iserv binary to load them. + +-- #if-guard the following equations otherwise the pattern match checker will +-- complain that they are redundant. +#if defined(HAVE_INTERNAL_INTERPRETER) +checkNonStdWay opts _interp srcspan + | hostFullWays == targetFullWays = return Nothing + -- Only if we are compiling with the same ways as GHC is built + -- with, can we dynamically load those object files. (see #3604) + + | ldObjSuffix opts == normalObjectSuffix && not (null targetFullWays) + = failNonStd opts srcspan + + | otherwise = return (Just (hostWayTag ++ "o")) + where + targetFullWays = fullWays (ldWays opts) + hostWayTag = case waysTag hostFullWays of + "" -> "" + tag -> tag ++ "_" + + normalObjectSuffix :: String + normalObjectSuffix = "o" + +data Way' = Normal | Prof | Dyn + +failNonStd :: LinkDepsOpts -> SrcSpan -> IO (Maybe FilePath) +failNonStd opts srcspan = dieWith opts srcspan $ + text "Cannot load" <+> pprWay' compWay <+> + text "objects when GHC is built" <+> pprWay' ghciWay $$ + text "To fix this, either:" $$ + text " (1) Use -fexternal-interpreter, or" $$ + buildTwiceMsg + where compWay + | ldWays opts `hasWay` WayDyn = Dyn + | ldWays opts `hasWay` WayProf = Prof + | otherwise = Normal + ghciWay + | hostIsDynamic = Dyn + | hostIsProfiled = Prof + | otherwise = Normal + buildTwiceMsg = case (ghciWay, compWay) of + (Normal, Dyn) -> dynamicTooMsg + (Dyn, Normal) -> dynamicTooMsg + _ -> + text " (2) Build the program twice: once" <+> + pprWay' ghciWay <> text ", and then" $$ + text " " <> pprWay' compWay <+> + text "using -osuf to set a different object file suffix." + dynamicTooMsg = text " (2) Use -dynamic-too," <+> + text "and use -osuf and -dynosuf to set object file suffixes as needed." + pprWay' :: Way' -> SDoc + pprWay' way = text $ case way of + Normal -> "the normal way" + Prof -> "with -prof" + Dyn -> "with -dynamic" +#endif + ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -50,7 +50,7 @@ import GHC.Tc.Utils.Monad import GHC.Runtime.Interpreter import GHCi.RemoteTypes - +import GHC.Iface.Load import GHC.ByteCode.Linker import GHC.ByteCode.Asm @@ -67,24 +67,18 @@ import GHC.Types.Unique.DFM import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import GHC.Utils.Error import GHC.Utils.Logger import GHC.Utils.TmpFs import GHC.Unit.Env -import GHC.Unit.Finder import GHC.Unit.Module -import GHC.Unit.Module.ModIface -import GHC.Unit.Module.WholeCoreBindings -import GHC.Unit.Module.Deps -import GHC.Unit.Home.ModInfo import GHC.Unit.State as Packages import qualified GHC.Data.ShortText as ST -import qualified GHC.Data.Maybe as Maybes import GHC.Data.FastString +import GHC.Linker.Deps import GHC.Linker.MacOS import GHC.Linker.Dynamic import GHC.Linker.Types @@ -93,10 +87,9 @@ import GHC.Linker.Types import Control.Monad import qualified Data.Set as Set -import qualified Data.Map as M import Data.Char (isSpace) import Data.IORef -import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition) +import Data.List (intercalate, isPrefixOf, nub, partition) import Data.Maybe import Control.Concurrent.MVar import qualified Control.Monad.Catch as MC @@ -112,15 +105,6 @@ import System.Win32.Info (getSystemDirectory) import GHC.Utils.Exception -import GHC.Unit.Module.Graph -import GHC.Types.SourceFile -import GHC.Utils.Misc -import GHC.Iface.Load -import GHC.Unit.Home -import Data.Either -import Control.Applicative -import GHC.Iface.Errors.Ppr - uninitialised :: a uninitialised = panic "Loader not initialised" @@ -207,28 +191,23 @@ loadDependencies -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required loadDependencies interp hsc_env pls span needed_mods = do -- initLoaderState (hsc_dflags hsc_env) dl - let dflags = hsc_dflags hsc_env - -- The interpreter and dynamic linker can only handle object code built - -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky. - -- So here we check the build tag: if we're building a non-standard way - -- then we need to find & link object files built the "normal" way. - maybe_normal_osuf <- checkNonStdWay dflags interp span + let opts = initLinkDepsOpts hsc_env -- Find what packages and linkables are required - (lnks, all_lnks, pkgs, this_pkgs_needed) - <- getLinkDeps hsc_env pls - maybe_normal_osuf span needed_mods + deps <- getLinkDeps opts interp pls span needed_mods + + let this_pkgs_needed = ldNeededUnits deps -- Link the packages and modules required - pls1 <- loadPackages' interp hsc_env pkgs pls - (pls2, succ) <- loadModuleLinkables interp hsc_env pls1 lnks + pls1 <- loadPackages' interp hsc_env (ldUnits deps) pls + (pls2, succ) <- loadModuleLinkables interp hsc_env pls1 (ldNeededLinkables deps) let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed all_pkgs_loaded = pkgs_loaded pls2 trans_pkgs_needed = unionManyUniqDSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg | pkg_id <- uniqDSetToList this_pkgs_needed , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id] ]) - return (pls2, succ, all_lnks, this_pkgs_loaded) + return (pls2, succ, ldAllLinkables deps, this_pkgs_loaded) -- | Temporarily extend the loaded env. @@ -614,315 +593,27 @@ loadExpr interp hsc_env span root_ul_bco = do -- All wired-in names are in the base package, which we link -- by default, so we can safely ignore them here. -dieWith :: DynFlags -> SrcSpan -> SDoc -> IO a -dieWith dflags span msg = throwGhcExceptionIO (ProgramError (showSDoc dflags (mkLocMessage MCFatal span msg))) - - -checkNonStdWay :: DynFlags -> Interp -> SrcSpan -> IO (Maybe FilePath) -checkNonStdWay _dflags interp _srcspan - | ExternalInterp {} <- interpInstance interp = return Nothing - -- with -fexternal-interpreter we load the .o files, whatever way - -- they were built. If they were built for a non-std way, then - -- we will use the appropriate variant of the iserv binary to load them. - --- #if-guard the following equations otherwise the pattern match checker will --- complain that they are redundant. -#if defined(HAVE_INTERNAL_INTERPRETER) -checkNonStdWay dflags _interp srcspan - | hostFullWays == targetFullWays = return Nothing - -- Only if we are compiling with the same ways as GHC is built - -- with, can we dynamically load those object files. (see #3604) - - | objectSuf_ dflags == normalObjectSuffix && not (null targetFullWays) - = failNonStd dflags srcspan - - | otherwise = return (Just (hostWayTag ++ "o")) - where - targetFullWays = fullWays (ways dflags) - hostWayTag = case waysTag hostFullWays of - "" -> "" - tag -> tag ++ "_" - - normalObjectSuffix :: String - normalObjectSuffix = phaseInputExt StopLn - -data Way' = Normal | Prof | Dyn - -failNonStd :: DynFlags -> SrcSpan -> IO (Maybe FilePath) -failNonStd dflags srcspan = dieWith dflags srcspan $ - text "Cannot load" <+> pprWay' compWay <+> - text "objects when GHC is built" <+> pprWay' ghciWay $$ - text "To fix this, either:" $$ - text " (1) Use -fexternal-interpreter, or" $$ - buildTwiceMsg - where compWay - | ways dflags `hasWay` WayDyn = Dyn - | ways dflags `hasWay` WayProf = Prof - | otherwise = Normal - ghciWay - | hostIsDynamic = Dyn - | hostIsProfiled = Prof - | otherwise = Normal - buildTwiceMsg = case (ghciWay, compWay) of - (Normal, Dyn) -> dynamicTooMsg - (Dyn, Normal) -> dynamicTooMsg - _ -> - text " (2) Build the program twice: once" <+> - pprWay' ghciWay <> text ", and then" $$ - text " " <> pprWay' compWay <+> - text "using -osuf to set a different object file suffix." - dynamicTooMsg = text " (2) Use -dynamic-too," <+> - text "and use -osuf and -dynosuf to set object file suffixes as needed." - pprWay' :: Way' -> SDoc - pprWay' way = text $ case way of - Normal -> "the normal way" - Prof -> "with -prof" - Dyn -> "with -dynamic" -#endif - -getLinkDeps :: HscEnv - -> LoaderState - -> Maybe FilePath -- replace object suffixes? - -> SrcSpan -- for error messages - -> [Module] -- If you need these - -> IO ([Linkable], [Linkable], [UnitId], UniqDSet UnitId) -- ... then link these first - -- The module and package dependencies for the needed modules are returned. - -- See Note [Object File Dependencies] --- Fails with an IO exception if it can't find enough files - -getLinkDeps hsc_env pls replace_osuf span mods --- Find all the packages and linkables that a set of modules depends on - = do { - -- 1. Find the dependent home-pkg-modules/packages from each iface - -- (omitting modules from the interactive package, which is already linked) - ; (mods_s, pkgs_s) <- - -- Why two code paths here? There is a significant amount of repeated work - -- performed calculating transitive dependencies - -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests) - if isOneShot (ghcMode dflags) - then follow_deps (filterOut isInteractiveModule mods) - emptyUniqDSet emptyUniqDSet; - else do - (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods - return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs)) - - ; let - -- 2. Exclude ones already linked - -- Main reason: avoid findModule calls in get_linkable - (mods_needed, links_got) = partitionEithers (map split_mods mods_s) - pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls - - split_mods mod = - let is_linked = findModuleLinkable_maybe (objs_loaded pls) mod <|> findModuleLinkable_maybe (bcos_loaded pls) mod - in case is_linked of - Just linkable -> Right linkable - Nothing -> Left mod - - -- 3. For each dependent module, find its linkable - -- This will either be in the HPT or (in the case of one-shot - -- compilation) we may need to use maybe_getFileLinkable - ; let { osuf = objectSuf dflags } - ; lnks_needed <- mapM (get_linkable osuf) mods_needed - - ; return (lnks_needed, links_got ++ lnks_needed, pkgs_needed, pkgs_s) } +initLinkDepsOpts :: HscEnv -> LinkDepsOpts +initLinkDepsOpts hsc_env = opts where + opts = LinkDepsOpts + { ldObjSuffix = objectSuf dflags + , ldOneShotMode = isOneShot (ghcMode dflags) + , ldModuleGraph = hsc_mod_graph hsc_env + , ldUnitEnv = hsc_unit_env hsc_env + , ldLoadIface = load_iface + , ldPprOpts = initSDocContext dflags defaultUserStyle + , ldFinderCache = hsc_FC hsc_env + , ldFinderOpts = initFinderOpts dflags + , ldUseByteCode = gopt Opt_UseBytecodeRatherThanObjects dflags + , ldMsgOpts = initIfaceMessageOpts dflags + , ldWays = ways dflags + } dflags = hsc_dflags hsc_env - mod_graph = hsc_mod_graph hsc_env + load_iface msg mod = initIfaceCheck (text "loader") hsc_env + $ loadInterface msg mod (ImportByUser NotBoot) - -- This code is used in `--make` mode to calculate the home package and unit dependencies - -- for a set of modules. - -- - -- It is significantly more efficient to use the shared transitive dependency - -- calculation than to compute the transitive dependency set in the same manner as oneShot mode. - - -- It is also a matter of correctness to use the module graph so that dependencies between home units - -- is resolved correctly. - make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) - make_deps_loop found [] = found - make_deps_loop found@(found_units, found_mods) (nk:nexts) - | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts - | otherwise = - case M.lookup (NodeKey_Module nk) (mgTransDeps mod_graph) of - Just trans_deps -> - let deps = Set.insert (NodeKey_Module nk) trans_deps - -- See #936 and the ghci.prog007 test for why we have to continue traversing through - -- boot modules. - todo_boot_mods = [ModNodeKeyWithUid (GWIB mn NotBoot) uid | NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid) <- Set.toList trans_deps] - in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts) - Nothing -> - let (ModNodeKeyWithUid _ uid) = nk - in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts - - mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) - (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) - - all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps] - - get_mod_info (ModNodeKeyWithUid gwib uid) = - case lookupHug (hsc_HUG hsc_env) uid (gwib_mod gwib) of - Just hmi -> - let iface = (hm_iface hmi) - mmod = case mi_hsc_src iface of - HsBootFile -> link_boot_mod_error (mi_module iface) - _ -> return $ Just (mi_module iface) - - in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod - Nothing -> - let err = text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid - in throwGhcExceptionIO (ProgramError (showSDoc dflags err)) - - - -- This code is used in one-shot mode to traverse downwards through the HPT - -- to find all link dependencies. - -- The ModIface contains the transitive closure of the module dependencies - -- within the current package, *except* for boot modules: if we encounter - -- a boot module, we have to find its real interface and discover the - -- dependencies of that. Hence we need to traverse the dependency - -- tree recursively. See bug #936, testcase ghci/prog007. - follow_deps :: [Module] -- modules to follow - -> UniqDSet Module -- accum. module dependencies - -> UniqDSet UnitId -- accum. package dependencies - -> IO ([Module], UniqDSet UnitId) -- result - follow_deps [] acc_mods acc_pkgs - = return (uniqDSetToList acc_mods, acc_pkgs) - follow_deps (mod:mods) acc_mods acc_pkgs - = do - mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ - loadInterface msg mod (ImportByUser NotBoot) - iface <- case mb_iface of - Maybes.Failed err -> - let opts = initIfaceMessageOpts dflags - err_txt = missingInterfaceErrorDiagnostic opts err - in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) - Maybes.Succeeded iface -> return iface - - when (mi_boot iface == IsBoot) $ link_boot_mod_error mod - - let - pkg = moduleUnit mod - deps = mi_deps iface - - pkg_deps = dep_direct_pkgs deps - (boot_deps, mod_deps) = flip partitionWith (Set.toList (dep_direct_mods deps)) $ - \case - (_, GWIB m IsBoot) -> Left m - (_, GWIB m NotBoot) -> Right m - - mod_deps' = case hsc_home_unit_maybe hsc_env of - Nothing -> [] - Just home_unit -> filter (not . (`elementOfUniqDSet` acc_mods)) (map (mkHomeModule home_unit) $ (boot_deps ++ mod_deps)) - acc_mods' = case hsc_home_unit_maybe hsc_env of - Nothing -> acc_mods - Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) - - case hsc_home_unit_maybe hsc_env of - Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) - acc_mods' acc_pkgs' - _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg)) - where - msg = text "need to link module" <+> ppr mod <+> - text "due to use of Template Haskell" - - - - link_boot_mod_error :: Module -> IO a - link_boot_mod_error mod = - throwGhcExceptionIO (ProgramError (showSDoc dflags ( - text "module" <+> ppr mod <+> - text "cannot be linked; it is only available as a boot module"))) - - no_obj :: Outputable a => a -> IO b - no_obj mod = dieWith dflags span $ - text "cannot find object file for module " <> - quotes (ppr mod) $$ - while_linking_expr - - while_linking_expr = text "while linking an interpreted expression" - - - -- See Note [Using Byte Code rather than Object Code for Template Haskell] - homeModLinkable :: DynFlags -> HomeModInfo -> Maybe Linkable - homeModLinkable dflags hmi = - if gopt Opt_UseBytecodeRatherThanObjects dflags - then homeModInfoByteCode hmi <|> homeModInfoObject hmi - else homeModInfoObject hmi <|> homeModInfoByteCode hmi - - get_linkable osuf mod -- A home-package module - | Just mod_info <- lookupHugByModule mod (hsc_HUG hsc_env) - = adjust_linkable (Maybes.expectJust "getLinkDeps" (homeModLinkable dflags mod_info)) - | otherwise - = do -- It's not in the HPT because we are in one shot mode, - -- so use the Finder to get a ModLocation... - case hsc_home_unit_maybe hsc_env of - Nothing -> no_obj mod - Just home_unit -> do - - let fc = hsc_FC hsc_env - let dflags = hsc_dflags hsc_env - let fopts = initFinderOpts dflags - mb_stuff <- findHomeModule fc fopts home_unit (moduleName mod) - case mb_stuff of - Found loc mod -> found loc mod - _ -> no_obj (moduleName mod) - where - found loc mod = do { - -- ...and then find the linkable for it - mb_lnk <- findObjectLinkableMaybe mod loc ; - case mb_lnk of { - Nothing -> no_obj mod ; - Just lnk -> adjust_linkable lnk - }} - - adjust_linkable lnk - | Just new_osuf <- replace_osuf = do - new_uls <- mapM (adjust_ul new_osuf) - (linkableUnlinked lnk) - return lnk{ linkableUnlinked=new_uls } - | otherwise = - return lnk - - adjust_ul new_osuf (DotO file) = do - massert (osuf `isSuffixOf` file) - let file_base = fromJust (stripExtension osuf file) - new_file = file_base <.> new_osuf - ok <- doesFileExist new_file - if (not ok) - then dieWith dflags span $ - text "cannot find object file " - <> quotes (text new_file) $$ while_linking_expr - else return (DotO new_file) - adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp) - adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp) - adjust_ul _ l@(BCOs {}) = return l - adjust_ul _ l at LoadedBCOs{} = return l - adjust_ul _ (CoreBindings (WholeCoreBindings _ mod _)) = pprPanic "Unhydrated core bindings" (ppr mod) - -{- -Note [Using Byte Code rather than Object Code for Template Haskell] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The `-fprefer-byte-code` flag allows a user to specify that they want to use -byte code (if availble) rather than object code for home module dependenices -when executing Template Haskell splices. - -Why might you want to use byte code rather than object code? -* Producing object code is much slower than producing byte code (for example if you're using -fno-code) -* Linking many large object files, which happens once per splice, is quite expensive. (#21700) - -So we allow the user to choose to use byte code rather than object files if they want to avoid these -two pitfalls. - -When using `-fprefer-byte-code` you have to arrange to have the byte code availble. -In normal --make mode it will not be produced unless you enable `-fbyte-code-and-object-code`. -See Note [Home module build products] for some more information about that. - -The only other place where the flag is consulted is when enabling code generation -with `-fno-code`, which does so to anticipate what decision we will make at the -splice point about what we would prefer. - --} {- ********************************************************************** @@ -1019,12 +710,9 @@ partitionLinkable li li {linkableUnlinked=li_uls_bco}] _ -> [li] -findModuleLinkable_maybe :: LinkableSet -> Module -> Maybe Linkable -findModuleLinkable_maybe = lookupModuleEnv - linkableInSet :: Linkable -> LinkableSet -> Bool linkableInSet l objs_loaded = - case findModuleLinkable_maybe objs_loaded (linkableModule l) of + case lookupModuleEnv objs_loaded (linkableModule l) of Nothing -> False Just m -> linkableTime l == linkableTime m ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -42,7 +42,7 @@ module GHC.Tc.Types( -- Renamer types ErrCtxt, pushErrCtxt, pushErrCtxtSameOrigin, ImportAvails(..), emptyImportAvails, plusImportAvails, - WhereFrom(..), mkModDeps, + mkModDeps, -- Typechecker types TcTypeEnv, TcBinderStack, TcBinder(..), @@ -1407,29 +1407,6 @@ plusImportAvails imp_orphs = unionListsOrd orphs1 orphs2, imp_finsts = unionListsOrd finsts1 finsts2 } -{- -************************************************************************ -* * -\subsection{Where from} -* * -************************************************************************ - -The @WhereFrom@ type controls where the renamer looks for an interface file --} - -data WhereFrom - = ImportByUser IsBootInterface -- Ordinary user import (perhaps {-# SOURCE #-}) - | ImportBySystem -- Non user import. - | ImportByPlugin -- Importing a plugin; - -- See Note [Care with plugin imports] in GHC.Iface.Load - -instance Outputable WhereFrom where - ppr (ImportByUser IsBoot) = text "{- SOURCE -}" - ppr (ImportByUser NotBoot) = empty - ppr ImportBySystem = text "{- SYSTEM -}" - ppr ImportByPlugin = text "{- PLUGIN -}" - - {- ********************************************************************* * * Type signatures ===================================== compiler/ghc.cabal.in ===================================== @@ -541,6 +541,7 @@ Library GHC.JS.Unsat.Syntax GHC.Linker GHC.Linker.Config + GHC.Linker.Deps GHC.Linker.Dynamic GHC.Linker.ExtraObj GHC.Linker.Loader ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -37,7 +37,6 @@ ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fres ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Types.hs:1423:47: Note [Care with plugin imports] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07f858eb1ff419b5190f6999f0d4dd5ba275b40c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07f858eb1ff419b5190f6999f0d4dd5ba275b40c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 20:20:09 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 26 May 2023 16:20:09 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Allow truncation to from smaller to larger Width Message-ID: <64711479814e7_64cfb422609fc7251f1@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 9c83e459 by Sven Tennie at 2023-05-26T22:18:42+02:00 Allow truncation to from smaller to larger Width This is used as inverse of sign extension to 64bit at many places. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -1019,21 +1019,24 @@ signExtend w w' r r' = shift = 64 - widthInBits w -- | Instructions to truncate the value in the given register from width @w@ --- down to width @w'@. --- N.B.: This ignores signedness! +-- to width @w'@. +-- +-- In other words, it just cuts the width out of the register. N.B.: This +-- ignores signedness (no sign extension takes place)! truncateReg :: Width -> Width -> Reg -> OrdList Instr truncateReg _w w' _r | w' == W64 = nilOL truncateReg _w w' r | w' > W64 = pprPanic "Cannot truncate to width bigger than register size (max is 64bit):" $ text (show r) <> char ':' <+> ppr w' truncateReg w _w' r | w > W64 = pprPanic "Unexpected register size (max is 64bit):" $ text (show r) <> char ':' <+> ppr w -truncateReg w w' _r | w < w' = pprPanic "This is not a truncation." $ ppr w <+> char '<' <+> ppr w' -truncateReg w w' _r | w == w' = nilOL -truncateReg w w' r = toOL [ann (text "truncate register" <+> ppr r <+> ppr w <> text "->" <> ppr w') - (LSL (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift))) - -- SHL ignores signedness! - , LSR (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift)) - ] +truncateReg w w' r = + toOL + [ ann + (text "truncate register" <+> ppr r <+> ppr w <> text "->" <> ppr w') + (LSL (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift))), + -- SHL ignores signedness! + LSR (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift)) + ] where - shift = 64 - (widthInBits w - widthInBits w') + shift = 64 - widthInBits w' -- ----------------------------------------------------------------------------- -- The 'Amode' type: Memory addressing modes passed up the tree. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c83e4594209311c94df63e65add552a76194dba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c83e4594209311c94df63e65add552a76194dba You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 23:16:04 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 26 May 2023 19:16:04 -0400 Subject: [Git][ghc/ghc][wip/expand-do] PopSrcSpan should be followed by tcApp Message-ID: <64713db469620_64cfb42baced4734115@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 1ec58564 by Apoorv Ingle at 2023-05-26T18:15:54-05:00 PopSrcSpan should be followed by tcApp - - - - - 9 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - testsuite/tests/rebindable/all.T - + testsuite/tests/rebindable/pattern-fails - testsuite/tests/rebindable/T18324.hs → testsuite/tests/typecheck/should_compile/T18324.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_run/Typeable1 Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -465,14 +465,10 @@ data XXExprGhcRn -- Should not presist post typechecking -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match - +-- | Wrap a located expression with a PopSrcExpr mkPopSrcSpanExpr :: LHsExpr GhcRn -> HsExpr GhcRn mkPopSrcSpanExpr a = XExpr (PopSrcSpan a) --- | Generated location for PopSrcExpr -genPopSrcSpanExpr :: LHsExpr GhcRn -> LHsExpr GhcRn -genPopSrcSpanExpr = noLocA . mkPopSrcSpanExpr - -- | Build a 'HsExpansion' out of an extension constructor, -- and the two components of the expansion: original and -- desugared expressions. @@ -488,12 +484,6 @@ mkExpandedStmt -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedStmt a b = XExpr (ExpandedStmt (HsExpanded a b)) -mkExpandedStmtLExpr - :: ExprLStmt GhcRn -- ^ source statement - -> LHsExpr GhcRn -- ^ expanded expression - -> LHsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedStmtLExpr a b = noLocA $ mkExpandedStmt a b - data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions {-# UNPACK #-} !(HsWrap HsExpr) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,7 +858,6 @@ warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg@(L loc _) arg_ty | Just (l, f) <- fish_var fun , f `hasKey` thenMClassOpKey -- it is a (>>) - , isGeneratedSrcSpan l -- it is compiler generated (>>) = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun , text "loc" <+> ppr l , text "locGen?" <+> ppr (isGeneratedSrcSpan l) @@ -866,7 +865,9 @@ warnUnusedBindValue fun arg@(L loc _) arg_ty , text "arg" <+> ppr arg , text "arg_loc" <+> ppr loc ]) - putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty + when (isGeneratedSrcSpan l || isNoSrcSpan l -- it is compiler generated (>>) + ) $ + putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty where -- Retrieve the location info and the head of the application -- It is important that we /do not/ look through HsApp to avoid ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -208,6 +208,7 @@ tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty tcExpr e@(XExpr (ExpandedExpr {})) res_ty = tcApp e res_ty +tcExpr (XExpr (PopSrcSpan e)) res_ty = popErrCtxt $ tcApp (unLoc e) res_ty tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty @@ -409,8 +410,6 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr (XExpr (PopSrcSpan expr)) res_ty = popErrCtxt $ tcExpr (unLoc expr) res_ty - tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt , text "expr:" <+> ppr expr ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1181,6 +1181,18 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) }) * * ************************************************************************ -} + + +-- | Generated location for PopSrcExpr +genPopSrcSpanExpr :: LHsExpr GhcRn -> LHsExpr GhcRn +genPopSrcSpanExpr = wrapGenSpan . mkPopSrcSpanExpr + +mkExpandedStmtLExpr + :: ExprLStmt GhcRn -- ^ source statement + -> LHsExpr GhcRn -- ^ expanded expression + -> LHsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +mkExpandedStmtLExpr a b = noLocA $ mkExpandedStmt a b + expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) expandDoStmts = expand_do_stmts @@ -1206,18 +1218,27 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return $ mkExpandedStmtLExpr stmt - (genPopSrcSpanExpr body) + = return $ mkExpandedStmtLExpr stmt body | SyntaxExprRn ret <- ret_expr -- -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ genPopSrcSpanExpr $ L loc $ mkExpandedStmt stmt - (genPopSrcSpanExpr (L loc (genHsApp ret body))) + = return $ L loc (mkExpandedStmt stmt + ((L loc (genHsApp ret body)))) +expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bnds)) : lstmts) = +-- stmts ~~> stmts' +-- ------------------------------------------------ +-- let x = e ; stmts ~~> let x = e in stmts' + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ L loc $ mkExpandedStmt stmt + (wrapGenSpan (HsLet noExtField + noHsTok bnds + noHsTok (genPopSrcSpanExpr expand_stmts))) + expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = @@ -1229,33 +1250,22 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ L loc (mkExpandedStmt stmt $ (genPopSrcSpanExpr e)) - , genPopSrcSpanExpr expr - ]) + return $ mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ genPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e) + , expr + ] | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) -expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bnds)) : lstmts) = --- stmts ~~> stmts' --- ------------------------------------------------ --- let x = e ; stmts ~~> let x = e in stmts' - do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ mkExpandedStmtLExpr stmt - (wrapGenSpan (HsLet noExtField - noHsTok bnds - noHsTok (genPopSrcSpanExpr expand_stmts))) - - expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ (genPopSrcSpanExpr $ (mkHsApps (wrapGenSpan f) -- (>>) - [ L loc (mkExpandedStmt stmt $ (genPopSrcSpanExpr e)) -- e - , genPopSrcSpanExpr expand_stmts ])) -- stmts' + return $ (mkHsApps (wrapGenSpan f) -- (>>) + [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) -- e + , genPopSrcSpanExpr expand_stmts ]) -- stmts' expand_do_stmts do_or_lc ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts @@ -1287,7 +1297,7 @@ expand_do_stmts do_or_lc all_ids = local_only_ids ++ later_ids -- put local ids before return ids return_stmt :: ExprLStmt GhcRn - return_stmt = noLocA $ LastStmt noExtField + return_stmt = wrapGenSpan $ LastStmt noExtField (mkBigLHsTup (map nlHsVar all_ids) noExtField) Nothing (SyntaxExprRn return_fun) @@ -1300,7 +1310,7 @@ expand_do_stmts do_or_lc -- LazyPat becuase we do not want to eagerly evaluate the pattern -- and potentially loop forever -expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = +expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = -- See Note [Applicative BodyStmt] -- -- stmts ~~> stmts' @@ -1318,30 +1328,29 @@ expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = ; body_with_fails <- foldrM match_args expr' pats_can_fail -- builds (body <$> e1 <*> e2 ...) - ; let expand_ado_expr = genPopSrcSpanExpr $ foldl mk_apps body_with_fails (zip (map fst args) rhss) + ; let expand_ado_expr = foldl mk_apps body_with_fails (zip (map fst args) rhss) -- wrap the expanded expression with a `join` if needed ; case mb_join of - Nothing -> return $ mkExpandedStmtLExpr stmt expand_ado_expr - Just NoSyntaxExprRn -> return $ mkExpandedStmtLExpr stmt expand_ado_expr -- why can this happen? + Nothing -> return $ expand_ado_expr + Just NoSyntaxExprRn -> return $ expand_ado_expr -- why can this happen? Just (SyntaxExprRn join_op) -> - return $ mkExpandedStmtLExpr stmt - ( mkHsApp (wrapGenSpan join_op) expand_ado_expr) + return $ mkHsApp (wrapGenSpan join_op) (genPopSrcSpanExpr $ expand_ado_expr) } where do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) do_arg (ApplicativeArgOne mb_fail_op pat expr _) = return ((pat, mb_fail_op), expr) do_arg (ApplicativeArgMany _ stmts ret pat _) = - do { expr <- expand_do_stmts do_or_lc $ stmts ++ [noLocA $ mkLastStmt (wrapGenSpan ret)] + do { expr <- expand_do_stmts do_or_lc $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] ; return ((pat, Nothing), expr) } match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) - match_args (pat, fail_op) body = genPopSrcSpanExpr <$> mk_failable_lexpr_tcm pat body fail_op + match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op mk_apps l_expr (op, r_expr) = case op of - SyntaxExprRn op -> mkHsApps (wrapGenSpan op) [genPopSrcSpanExpr l_expr, genPopSrcSpanExpr r_expr] + SyntaxExprRn op -> mkHsApps (wrapGenSpan op) [l_expr, r_expr] NoSyntaxExprRn -> pprPanic "expand_do_stmts op:" (ppr op) expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) @@ -1375,10 +1384,10 @@ mk_failable_lexpr_tcm pat lexpr fail_op = mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ - (noLocA [ mkHsCaseAlt pat (genPopSrcSpanExpr lexpr) -- pat -> expr + return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ + (wrapGenSpan [ mkHsCaseAlt pat (genPopSrcSpanExpr lexpr) -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" - (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) + (wrapGenSpan $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) ])) where mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -42,8 +42,7 @@ test('T14670', expect_broken(14670), compile, ['']) test('T19167', normal, compile, ['']) test('T19918', normal, compile_and_run, ['']) test('T20126', normal, compile_fail, ['']) -# Tests for desugaring do before typechecking -test('T18324', normal, compile, ['']) +# Tests for expanding do before typechecking test('T23147', normal, compile, ['']) test('pattern-fails', normal, compile_and_run, ['']) test('simple-rec', normal, compile_and_run, ['']) ===================================== testsuite/tests/rebindable/pattern-fails ===================================== Binary files /dev/null and b/testsuite/tests/rebindable/pattern-fails differ ===================================== testsuite/tests/rebindable/T18324.hs → testsuite/tests/typecheck/should_compile/T18324.hs ===================================== ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -875,3 +875,5 @@ test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) test('T23156', normal, compile, ['']) +# Tests for expanding do before typechecking (Impredicative) +test('T18324', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_run/Typeable1 ===================================== Binary files /dev/null and b/testsuite/tests/typecheck/should_run/Typeable1 differ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ec5856450094529ea4e10cddefd645ac3902017 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ec5856450094529ea4e10cddefd645ac3902017 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri May 26 23:18:10 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 26 May 2023 19:18:10 -0400 Subject: [Git][ghc/ghc][wip/expand-do] PopSrcSpan should be followed by tcApp Message-ID: <64713e32a8304_64cfb429bec44734639@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: fc434c12 by Apoorv Ingle at 2023-05-26T18:18:01-05:00 PopSrcSpan should be followed by tcApp - - - - - 9 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - testsuite/tests/rebindable/all.T - + testsuite/tests/rebindable/pattern-fails - testsuite/tests/rebindable/T18324.hs → testsuite/tests/typecheck/should_compile/T18324.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_run/Typeable1 Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -465,14 +465,10 @@ data XXExprGhcRn -- Should not presist post typechecking -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match - +-- | Wrap a located expression with a PopSrcExpr mkPopSrcSpanExpr :: LHsExpr GhcRn -> HsExpr GhcRn mkPopSrcSpanExpr a = XExpr (PopSrcSpan a) --- | Generated location for PopSrcExpr -genPopSrcSpanExpr :: LHsExpr GhcRn -> LHsExpr GhcRn -genPopSrcSpanExpr = noLocA . mkPopSrcSpanExpr - -- | Build a 'HsExpansion' out of an extension constructor, -- and the two components of the expansion: original and -- desugared expressions. @@ -488,12 +484,6 @@ mkExpandedStmt -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedStmt a b = XExpr (ExpandedStmt (HsExpanded a b)) -mkExpandedStmtLExpr - :: ExprLStmt GhcRn -- ^ source statement - -> LHsExpr GhcRn -- ^ expanded expression - -> LHsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedStmtLExpr a b = noLocA $ mkExpandedStmt a b - data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions {-# UNPACK #-} !(HsWrap HsExpr) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -858,7 +858,6 @@ warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () warnUnusedBindValue fun arg@(L loc _) arg_ty | Just (l, f) <- fish_var fun , f `hasKey` thenMClassOpKey -- it is a (>>) - , isGeneratedSrcSpan l -- it is compiler generated (>>) = do tracePm "warnUnusedBindValue" (vcat [ text "fun" <+> ppr fun , text "loc" <+> ppr l , text "locGen?" <+> ppr (isGeneratedSrcSpan l) @@ -866,7 +865,9 @@ warnUnusedBindValue fun arg@(L loc _) arg_ty , text "arg" <+> ppr arg , text "arg_loc" <+> ppr loc ]) - putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty + when (isGeneratedSrcSpan l || isNoSrcSpan l -- it is compiler generated (>>) + ) $ + putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty where -- Retrieve the location info and the head of the application -- It is important that we /do not/ look through HsApp to avoid ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -208,6 +208,7 @@ tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty tcExpr e@(XExpr (ExpandedExpr {})) res_ty = tcApp e res_ty +tcExpr (XExpr (PopSrcSpan e)) res_ty = popErrCtxt $ tcApp (unLoc e) res_ty tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty @@ -409,8 +410,6 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr (XExpr (PopSrcSpan expr)) res_ty = popErrCtxt $ tcExpr (unLoc expr) res_ty - tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt , text "expr:" <+> ppr expr ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1181,6 +1181,18 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) }) * * ************************************************************************ -} + + +-- | Generated location for PopSrcExpr +genPopSrcSpanExpr :: LHsExpr GhcRn -> LHsExpr GhcRn +genPopSrcSpanExpr = wrapGenSpan . mkPopSrcSpanExpr + +mkExpandedStmtLExpr + :: ExprLStmt GhcRn -- ^ source statement + -> LHsExpr GhcRn -- ^ expanded expression + -> LHsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +mkExpandedStmtLExpr a b = noLocA $ mkExpandedStmt a b + expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) expandDoStmts = expand_do_stmts @@ -1206,18 +1218,27 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return $ mkExpandedStmtLExpr stmt - (genPopSrcSpanExpr body) + = return $ mkExpandedStmtLExpr stmt body | SyntaxExprRn ret <- ret_expr -- -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ genPopSrcSpanExpr $ L loc $ mkExpandedStmt stmt - (genPopSrcSpanExpr (L loc (genHsApp ret body))) + = return $ L loc (mkExpandedStmt stmt + ((L loc (genHsApp ret body)))) +expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bnds)) : lstmts) = +-- stmts ~~> stmts' +-- ------------------------------------------------ +-- let x = e ; stmts ~~> let x = e in stmts' + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ L loc $ mkExpandedStmt stmt + (wrapGenSpan (HsLet noExtField + noHsTok bnds + noHsTok (genPopSrcSpanExpr expand_stmts))) + expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = @@ -1229,33 +1250,22 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ L loc (mkExpandedStmt stmt $ (genPopSrcSpanExpr e)) - , genPopSrcSpanExpr expr - ]) + return $ mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ genPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e) + , expr + ] | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) -expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bnds)) : lstmts) = --- stmts ~~> stmts' --- ------------------------------------------------ --- let x = e ; stmts ~~> let x = e in stmts' - do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ mkExpandedStmtLExpr stmt - (wrapGenSpan (HsLet noExtField - noHsTok bnds - noHsTok (genPopSrcSpanExpr expand_stmts))) - - expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ (genPopSrcSpanExpr $ (mkHsApps (wrapGenSpan f) -- (>>) - [ L loc (mkExpandedStmt stmt $ (genPopSrcSpanExpr e)) -- e - , genPopSrcSpanExpr expand_stmts ])) -- stmts' + return $ (mkHsApps (wrapGenSpan f) -- (>>) + [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) -- e + , expand_stmts ]) -- stmts' expand_do_stmts do_or_lc ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts @@ -1287,7 +1297,7 @@ expand_do_stmts do_or_lc all_ids = local_only_ids ++ later_ids -- put local ids before return ids return_stmt :: ExprLStmt GhcRn - return_stmt = noLocA $ LastStmt noExtField + return_stmt = wrapGenSpan $ LastStmt noExtField (mkBigLHsTup (map nlHsVar all_ids) noExtField) Nothing (SyntaxExprRn return_fun) @@ -1300,7 +1310,7 @@ expand_do_stmts do_or_lc -- LazyPat becuase we do not want to eagerly evaluate the pattern -- and potentially loop forever -expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = +expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = -- See Note [Applicative BodyStmt] -- -- stmts ~~> stmts' @@ -1318,30 +1328,29 @@ expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = ; body_with_fails <- foldrM match_args expr' pats_can_fail -- builds (body <$> e1 <*> e2 ...) - ; let expand_ado_expr = genPopSrcSpanExpr $ foldl mk_apps body_with_fails (zip (map fst args) rhss) + ; let expand_ado_expr = foldl mk_apps body_with_fails (zip (map fst args) rhss) -- wrap the expanded expression with a `join` if needed ; case mb_join of - Nothing -> return $ mkExpandedStmtLExpr stmt expand_ado_expr - Just NoSyntaxExprRn -> return $ mkExpandedStmtLExpr stmt expand_ado_expr -- why can this happen? + Nothing -> return $ expand_ado_expr + Just NoSyntaxExprRn -> return $ expand_ado_expr -- why can this happen? Just (SyntaxExprRn join_op) -> - return $ mkExpandedStmtLExpr stmt - ( mkHsApp (wrapGenSpan join_op) expand_ado_expr) + return $ mkHsApp (wrapGenSpan join_op) (genPopSrcSpanExpr $ expand_ado_expr) } where do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) do_arg (ApplicativeArgOne mb_fail_op pat expr _) = return ((pat, mb_fail_op), expr) do_arg (ApplicativeArgMany _ stmts ret pat _) = - do { expr <- expand_do_stmts do_or_lc $ stmts ++ [noLocA $ mkLastStmt (wrapGenSpan ret)] + do { expr <- expand_do_stmts do_or_lc $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] ; return ((pat, Nothing), expr) } match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) - match_args (pat, fail_op) body = genPopSrcSpanExpr <$> mk_failable_lexpr_tcm pat body fail_op + match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op mk_apps l_expr (op, r_expr) = case op of - SyntaxExprRn op -> mkHsApps (wrapGenSpan op) [genPopSrcSpanExpr l_expr, genPopSrcSpanExpr r_expr] + SyntaxExprRn op -> mkHsApps (wrapGenSpan op) [l_expr, r_expr] NoSyntaxExprRn -> pprPanic "expand_do_stmts op:" (ppr op) expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) @@ -1375,10 +1384,10 @@ mk_failable_lexpr_tcm pat lexpr fail_op = mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ noLocA (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ - (noLocA [ mkHsCaseAlt pat (genPopSrcSpanExpr lexpr) -- pat -> expr + return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ + (wrapGenSpan [ mkHsCaseAlt pat (genPopSrcSpanExpr lexpr) -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" - (noLocA $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) + (wrapGenSpan $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) ])) where mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -42,8 +42,7 @@ test('T14670', expect_broken(14670), compile, ['']) test('T19167', normal, compile, ['']) test('T19918', normal, compile_and_run, ['']) test('T20126', normal, compile_fail, ['']) -# Tests for desugaring do before typechecking -test('T18324', normal, compile, ['']) +# Tests for expanding do before typechecking test('T23147', normal, compile, ['']) test('pattern-fails', normal, compile_and_run, ['']) test('simple-rec', normal, compile_and_run, ['']) ===================================== testsuite/tests/rebindable/pattern-fails ===================================== Binary files /dev/null and b/testsuite/tests/rebindable/pattern-fails differ ===================================== testsuite/tests/rebindable/T18324.hs → testsuite/tests/typecheck/should_compile/T18324.hs ===================================== ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -875,3 +875,5 @@ test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) test('T23156', normal, compile, ['']) +# Tests for expanding do before typechecking (Impredicative) +test('T18324', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_run/Typeable1 ===================================== Binary files /dev/null and b/testsuite/tests/typecheck/should_run/Typeable1 differ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc434c1208b30f26381d965f074933dd811d012f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc434c1208b30f26381d965f074933dd811d012f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 00:08:15 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 26 May 2023 20:08:15 -0400 Subject: [Git][ghc/ghc][wip/expand-do] change the match ctxt while type checking HsLam if the lambda match is due to... Message-ID: <647149ef80386_64cfb429bec58735477@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 7ff1c26d by Apoorv Ingle at 2023-05-26T19:08:07-05:00 change the match ctxt while type checking HsLam if the lambda match is due to an expression generated from a do block - - - - - 1 changed file: - compiler/GHC/Tc/Gen/Expr.hs Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -267,7 +267,10 @@ tcExpr (HsLam _ match) res_ty = do { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty ; return (mkHsWrap wrap (HsLam noExtField match')) } where - match_ctxt = MC { mc_what = LambdaExpr, mc_body = tcBody } + match_ctxt = MC { mc_what = case mg_ext match of + Generated DoExpansion -> StmtCtxt (HsDoStmt (DoExpr Nothing)) + _ -> LambdaExpr + , mc_body = tcBody } herald = ExpectedFunTyLam match tcExpr e@(HsLamCase x lc_variant matches) res_ty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ff1c26dafd53b1c836df8f7d0db1b6c265ee6c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ff1c26dafd53b1c836df8f7d0db1b6c265ee6c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 07:23:32 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 27 May 2023 03:23:32 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement MO_NOT: Replace MVN Message-ID: <6471aff4777a8_64cfb429bec58755933@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 6418dd82 by Sven Tennie at 2023-05-27T09:21:41+02:00 Implement MO_NOT: Replace MVN MVN does not exist in RV64. Replace it by pseudo-instr not's effective assembly. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -614,8 +614,9 @@ getRegister' config plat expr MO_Not w -> return $ Any (intFormat w) $ \dst -> let w' = opRegWidth w in code `snocOL` - MVN (OpReg w' dst) (OpReg w' reg) `appOL` - truncateReg w' w dst -- See Note [Signed arithmetic on AArch64] + -- pseudo instruction `not` is `xori rd, rs, -1` + ann (text "not") (XORI (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt (-1)))) `appOL` + truncateReg w' w dst -- See Note [Signed arithmetic on RISCV64] MO_S_Neg w -> negate code w reg MO_F_Neg w -> return $ Any (floatFormat w) (\dst -> code `snocOL` NEG (OpReg w dst) (OpReg w reg)) ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -109,9 +109,9 @@ regUsageOfInstr platform instr = case instr of LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) MOVK dst src -> usage (regOp src, regOp dst) - MVN dst src -> usage (regOp src, regOp dst) -- ORI's third operand is always an immediate ORI dst src1 _ -> usage (regOp src1, regOp dst) + XORI dst src1 _ -> usage (regOp src1, regOp dst) ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) TST src1 src2 -> usage (regOp src1 ++ regOp src2, []) -- 4. Branch Instructions ---------------------------------------------------- @@ -248,9 +248,9 @@ patchRegsOfInstr instr env = case instr of LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2) - MVN o1 o2 -> MVN (patchOp o1) (patchOp o2) -- o3 cannot be a register for ORI (always an immediate) ORI o1 o2 o3 -> ORI (patchOp o1) (patchOp o2) (patchOp o3) + XORI o1 o2 o3 -> XORI (patchOp o1) (patchOp o2) (patchOp o3) ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3) TST o1 o2 -> TST (patchOp o1) (patchOp o2) @@ -640,9 +640,9 @@ data Instr | MOVK Operand Operand -- | MOVN Operand Operand -- | MOVZ Operand Operand - | MVN Operand Operand -- rd = ~rn | ORN Operand Operand Operand -- rd = rn | ~op2 | ORI Operand Operand Operand -- rd = rn | op2 + | XORI Operand Operand Operand -- rd = rn `xor` imm | ROR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits | TST Operand Operand -- rn & op2 -- Load and stores. @@ -718,9 +718,9 @@ instrCon i = LSR{} -> "LSR" MOV{} -> "MOV" MOVK{} -> "MOVK" - MVN{} -> "MVN" ORN{} -> "ORN" ORI{} -> "ORI" + XORI{} -> "ORI" ROR{} -> "ROR" TST{} -> "TST" STR{} -> "STR" ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -521,9 +521,9 @@ pprInstr platform instr = case instr of -> lines_ [ text "\tli" <+> pprOp platform o1 <> comma <+> pprOp platform o2 ] | otherwise -> op3 (text "\taddi") o1 o2 (OpImm (ImmInt 0)) MOVK o1 o2 -> op2 (text "\tmovk") o1 o2 - MVN o1 o2 -> op2 (text "\tmvn") o1 o2 ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 ORI o1 o2 o3 -> op3 (text "\tori") o1 o2 o3 + XORI o1 o2 o3 -> op3 (text "\txori") o1 o2 o3 ROR o1 o2 o3 -> op3 (text "\tror") o1 o2 o3 TST o1 o2 -> op2 (text "\ttst") o1 o2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6418dd82005f9b84fbb490756493f57cfb350f34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6418dd82005f9b84fbb490756493f57cfb350f34 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 08:30:35 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 27 May 2023 04:30:35 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Replace UXTB & UXTH, Fix UDIV Message-ID: <6471bfab5583f_64cfb4275b164763953@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 63358eb4 by Sven Tennie at 2023-05-27T10:29:00+02:00 Replace UXTB & UXTH, Fix UDIV Replace UXTB and UXTB with truncateReg as these instructions do not exist in RISCV64. UDIV is named DIVU in RISCV64. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -709,14 +709,14 @@ getRegister' config plat expr where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_U_Quot w) [x, y] | w == W8 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - CmmMachOp (MO_U_Quot w) [x, y] | w == W16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + CmmMachOp (MO_U_Quot w) [x, y] | w == W8 || w == W16 -> do + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> code_x `appOL` + truncateReg (formatToWidth format_x) w reg_x `appOL` + code_y `appOL` + truncateReg (formatToWidth format_y) w reg_y `snocOL` + annExpr expr (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) -- 2. Shifts. x << n, x >> n. CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do @@ -745,18 +745,14 @@ getRegister' config plat expr CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n))))) - CmmMachOp (MO_U_Shr w) [x, y] | w == W8 -> do - (reg_x, _format_x, code_x) <- getSomeReg x + CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || w == W16 -> do + (reg_x, format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n))))) - CmmMachOp (MO_U_Shr w) [x, y] | w == W16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do (reg_x, _format_x, code_x) <- getSomeReg x @@ -1171,14 +1167,18 @@ genCondJump bid expr = do let ubcond w cmp = do -- compute both sides. - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y let x' = OpReg w reg_x y' = OpReg w reg_y return $ case w of - W8 -> code_x `appOL` code_y `appOL` toOL [ UXTB x' x', UXTB y' y', (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] - W16 -> code_x `appOL` code_y `appOL` toOL [ UXTH x' x', UXTH y' y', (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] - _ -> code_x `appOL` code_y `appOL` toOL [ (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] + w | w == W8 || w == W16 -> code_x `appOL` + truncateReg (formatToWidth format_x) w reg_x `appOL` + code_y `appOL` + truncateReg (formatToWidth format_y) w reg_y `appOL` + code_y `snocOL` + annExpr expr (BCOND cmp x' y' (TBlock bid)) + _ -> code_x `appOL` code_y `snocOL` annExpr expr (BCOND cmp x' y' (TBlock bid)) sbcond w cmp = do -- compute both sides. ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -95,8 +95,6 @@ regUsageOfInstr platform instr = case instr of SBFM dst src _ _ -> usage (regOp src, regOp dst) UBFM dst src _ _ -> usage (regOp src, regOp dst) UBFX dst src _ _ -> usage (regOp src, regOp dst) - UXTB dst src -> usage (regOp src, regOp dst) - UXTH dst src -> usage (regOp src, regOp dst) -- 3. Logical and Move Instructions ------------------------------------------ AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) OR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -232,8 +230,6 @@ patchRegsOfInstr instr env = case instr of SBFM o1 o2 o3 o4 -> SBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) UBFM o1 o2 o3 o4 -> UBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) UBFX o1 o2 o3 o4 -> UBFX (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) - UXTB o1 o2 -> UXTB (patchOp o1) (patchOp o2) - UXTH o1 o2 -> UXTH (patchOp o1) (patchOp o2) -- 3. Logical and Move Instructions ---------------------------------------- AND o1 o2 o3 -> AND (patchOp o1) (patchOp o2) (patchOp o3) @@ -558,8 +554,6 @@ data Instr | DELTA Int -- 0. Pseudo Instructions -------------------------------------------------- - | UXTB Operand Operand - | UXTH Operand Operand -- | SXTW Operand Operand -- | SXTX Operand Operand | PUSH_STACK_FRAME @@ -617,12 +611,7 @@ data Instr -- 2. Bit Manipulation Instructions ---------------------------------------- | SBFM Operand Operand Operand Operand -- rd = rn[i,j] - -- SXTB = SBFM , , #0, #7 - -- SXTH = SBFM , , #0, #15 - -- SXTW = SBFM , , #0, #31 | UBFM Operand Operand Operand Operand -- rd = rn[i,j] - -- UXTB = UBFM , , #0, #7 - -- UXTH = UBFM , , #0, #15 -- Signed/Unsigned bitfield extract | UBFX Operand Operand Operand Operand -- rd = rn[i,j] @@ -688,8 +677,6 @@ instrCon i = LDATA{} -> "LDATA" NEWBLOCK{} -> "NEWBLOCK" DELTA{} -> "DELTA" - UXTB{} -> "UXTB" - UXTH{} -> "UXTH" PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME" POP_STACK_FRAME{} -> "POP_STACK_FRAME" ADD{} -> "ADD" ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -483,15 +483,13 @@ pprInstr platform instr = case instr of | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub") o1 o2 o3 | isImmOp o3 -> op3 (text "\taddi") o1 o2 (negOp o3) | otherwise -> op3 (text "\tsub") o1 o2 o3 - UDIV o1 o2 o3 -> op3 (text "\tudiv") o1 o2 o3 + UDIV o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3 -- 2. Bit Manipulation Instructions ------------------------------------------ SBFM o1 o2 o3 o4 -> op4 (text "\tsbfm") o1 o2 o3 o4 UBFM o1 o2 o3 o4 -> op4 (text "\tubfm") o1 o2 o3 o4 -- signed and unsigned bitfield extract UBFX o1 o2 o3 o4 -> op4 (text "\tubfx") o1 o2 o3 o4 - UXTB o1 o2 -> op2 (text "\tuxtb") o1 o2 - UXTH o1 o2 -> op2 (text "\tuxth") o1 o2 -- 3. Logical and Move Instructions ------------------------------------------ AND o1 o2 o3 -> op3 (text "\tand") o1 o2 o3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63358eb49f1e6e4c14027cfe35ae7af26f369d8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63358eb49f1e6e4c14027cfe35ae7af26f369d8f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 09:03:33 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 27 May 2023 05:03:33 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement XOR Message-ID: <6471c76522c54_64cfb429bec4476454@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: b1489bbd by Sven Tennie at 2023-05-27T11:02:58+02:00 Implement XOR Delete EOR which does not exist on RISCV64. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -931,7 +931,7 @@ getRegister' config plat expr -- Bitwise operations MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) MO_Or w -> bitOp w (\d x y -> unitOL $ OR d x y) - MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y) + MO_Xor w -> bitOp w (\d x y -> unitOL $ XOR d x y) MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -89,6 +89,7 @@ regUsageOfInstr platform instr = case instr of DIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) REM dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) SUB dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- TODO: It's named DIVU in RISCV64 -> rename UDIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- 2. Bit Manipulation Instructions ------------------------------------------ @@ -101,8 +102,9 @@ regUsageOfInstr platform instr = case instr of ASR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BIC dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BICS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- TODO: Unused and does not exist in RISCV64 EON dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - EOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + XOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) LSL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) @@ -239,7 +241,7 @@ patchRegsOfInstr instr env = case instr of BIC o1 o2 o3 -> BIC (patchOp o1) (patchOp o2) (patchOp o3) BICS o1 o2 o3 -> BICS (patchOp o1) (patchOp o2) (patchOp o3) EON o1 o2 o3 -> EON (patchOp o1) (patchOp o2) (patchOp o3) - EOR o1 o2 o3 -> EOR (patchOp o1) (patchOp o2) (patchOp o3) + XOR o1 o2 o3 -> XOR (patchOp o1) (patchOp o2) (patchOp o3) LSL o1 o2 o3 -> LSL (patchOp o1) (patchOp o2) (patchOp o3) LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) @@ -622,7 +624,7 @@ data Instr | BIC Operand Operand Operand -- rd = rn & ~op2 | BICS Operand Operand Operand -- rd = rn & ~op2 | EON Operand Operand Operand -- rd = rn ⊕ ~op2 - | EOR Operand Operand Operand -- rd = rn ⊕ op2 + | XOR Operand Operand Operand -- rd = rn ⊕ op2 -- | LSL Operand Operand Operand -- rd = rn ≪ rm or rd = rn ≪ #i, i is 6 bits -- | LSR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits | MOV Operand Operand -- rd = rn or rd = #i @@ -700,7 +702,7 @@ instrCon i = BIC{} -> "BIC" BICS{} -> "BICS" EON{} -> "EON" - EOR{} -> "EOR" + XOR{} -> "XOR" LSL{} -> "LSL" LSR{} -> "LSR" MOV{} -> "MOV" ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -500,7 +500,7 @@ pprInstr platform instr = case instr of BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3 BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3 EON o1 o2 o3 -> op3 (text "\teon") o1 o2 o3 - EOR o1 o2 o3 -> op3 (text "\teor") o1 o2 o3 + XOR o1 o2 o3 -> op3 (text "\txor") o1 o2 o3 LSL o1 o2 o3 -> op3 (text "\tsll") o1 o2 o3 LSR o1 o2 o3 -> op3 (text "\tsrl") o1 o2 o3 MOV o1 o2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1489bbd71b228e5296c98c6f365c44678790ccc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1489bbd71b228e5296c98c6f365c44678790ccc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 09:25:50 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 27 May 2023 05:25:50 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] 2 commits: Rename UDIV -> DIVU Message-ID: <6471cc9e5b5c3_64cfb4275b13c767332@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 3ba71edc by Sven Tennie at 2023-05-27T11:14:05+02:00 Rename UDIV -> DIVU That's how unsigned div is called on RISCV64. This should avoid confusion. - - - - - 1f737e0a by Sven Tennie at 2023-05-27T11:24:04+02:00 Delete unused EON It does not exist on RISCV64. - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -716,7 +716,7 @@ getRegister' config plat expr truncateReg (formatToWidth format_x) w reg_x `appOL` code_y `appOL` truncateReg (formatToWidth format_y) w reg_y `snocOL` - annExpr expr (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + annExpr expr (DIVU (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) -- 2. Shifts. x << n, x >> n. CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do @@ -893,7 +893,7 @@ getRegister' config plat expr MO_S_Rem w -> intOp True w (\d x y -> unitOL $ REM d x y) -- Unsigned multiply/divide - MO_U_Quot w -> intOp False w (\d x y -> unitOL $ UDIV d x y) + MO_U_Quot w -> intOp False w (\d x y -> unitOL $ DIVU d x y) MO_U_Rem w -> intOp False w (\d x y -> unitOL $ REM d x y) -- Signed comparisons -- see Note [CSET] ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -89,8 +89,7 @@ regUsageOfInstr platform instr = case instr of DIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) REM dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) SUB dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - -- TODO: It's named DIVU in RISCV64 -> rename - UDIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + DIVU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- 2. Bit Manipulation Instructions ------------------------------------------ SBFM dst src _ _ -> usage (regOp src, regOp dst) @@ -102,8 +101,6 @@ regUsageOfInstr platform instr = case instr of ASR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BIC dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BICS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - -- TODO: Unused and does not exist in RISCV64 - EON dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) XOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) LSL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -226,7 +223,7 @@ patchRegsOfInstr instr env = case instr of DIV o1 o2 o3 -> DIV (patchOp o1) (patchOp o2) (patchOp o3) REM o1 o2 o3 -> REM (patchOp o1) (patchOp o2) (patchOp o3) SUB o1 o2 o3 -> SUB (patchOp o1) (patchOp o2) (patchOp o3) - UDIV o1 o2 o3 -> UDIV (patchOp o1) (patchOp o2) (patchOp o3) + DIVU o1 o2 o3 -> DIVU (patchOp o1) (patchOp o2) (patchOp o3) -- 2. Bit Manipulation Instructions ---------------------------------------- SBFM o1 o2 o3 o4 -> SBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) @@ -240,7 +237,6 @@ patchRegsOfInstr instr env = case instr of ASR o1 o2 o3 -> ASR (patchOp o1) (patchOp o2) (patchOp o3) BIC o1 o2 o3 -> BIC (patchOp o1) (patchOp o2) (patchOp o3) BICS o1 o2 o3 -> BICS (patchOp o1) (patchOp o2) (patchOp o3) - EON o1 o2 o3 -> EON (patchOp o1) (patchOp o2) (patchOp o3) XOR o1 o2 o3 -> XOR (patchOp o1) (patchOp o2) (patchOp o3) LSL o1 o2 o3 -> LSL (patchOp o1) (patchOp o2) (patchOp o3) LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) @@ -609,7 +605,7 @@ data Instr | SMULH Operand Operand Operand | SMULL Operand Operand Operand - | UDIV Operand Operand Operand -- rd = rn ÷ rm + | DIVU Operand Operand Operand -- rd = rn ÷ rm -- 2. Bit Manipulation Instructions ---------------------------------------- | SBFM Operand Operand Operand Operand -- rd = rn[i,j] @@ -623,7 +619,6 @@ data Instr -- | ASR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits | BIC Operand Operand Operand -- rd = rn & ~op2 | BICS Operand Operand Operand -- rd = rn & ~op2 - | EON Operand Operand Operand -- rd = rn ⊕ ~op2 | XOR Operand Operand Operand -- rd = rn ⊕ op2 -- | LSL Operand Operand Operand -- rd = rn ≪ rm or rd = rn ≪ #i, i is 6 bits -- | LSR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits @@ -692,7 +687,7 @@ instrCon i = SMULH{} -> "SMULH" SMULL{} -> "SMULL" SUB{} -> "SUB" - UDIV{} -> "UDIV" + DIVU{} -> "DIVU" SBFM{} -> "SBFM" UBFM{} -> "UBFM" UBFX{} -> "UBFX" @@ -701,7 +696,6 @@ instrCon i = ASR{} -> "ASR" BIC{} -> "BIC" BICS{} -> "BICS" - EON{} -> "EON" XOR{} -> "XOR" LSL{} -> "LSL" LSR{} -> "LSR" ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -483,7 +483,7 @@ pprInstr platform instr = case instr of | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub") o1 o2 o3 | isImmOp o3 -> op3 (text "\taddi") o1 o2 (negOp o3) | otherwise -> op3 (text "\tsub") o1 o2 o3 - UDIV o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3 + DIVU o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3 -- 2. Bit Manipulation Instructions ------------------------------------------ SBFM o1 o2 o3 o4 -> op4 (text "\tsbfm") o1 o2 o3 o4 @@ -499,7 +499,6 @@ pprInstr platform instr = case instr of ASR o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3 BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3 BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3 - EON o1 o2 o3 -> op3 (text "\teon") o1 o2 o3 XOR o1 o2 o3 -> op3 (text "\txor") o1 o2 o3 LSL o1 o2 o3 -> op3 (text "\tsll") o1 o2 o3 LSR o1 o2 o3 -> op3 (text "\tsrl") o1 o2 o3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1489bbd71b228e5296c98c6f365c44678790ccc...1f737e0a4d502070a11cc47e1ea24cd737b45093 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1489bbd71b228e5296c98c6f365c44678790ccc...1f737e0a4d502070a11cc47e1ea24cd737b45093 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 15:08:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 27 May 2023 11:08:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 18 commits: Introduce GHCiMessage to wrap GhcMessage Message-ID: <64721cd798ac2_64cfb4275b164794140@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - 4191596a by Oleg Grenrus at 2023-05-27T11:08:01-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 24821bd7 by Alan Zimmerman at 2023-05-27T11:08:02-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Config/HsToCore.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78b24be76d4601ebc2ae918f654827dbff1cd656...24821bd7da1d2922c709567d07a3d66b58c90f8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78b24be76d4601ebc2ae918f654827dbff1cd656...24821bd7da1d2922c709567d07a3d66b58c90f8d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 16:53:20 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sat, 27 May 2023 12:53:20 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] 2 commits: Progress Message-ID: <6472358044e5f_64cfb4275b13c7997e6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 6ec83341 by Rodrigo Mesquita at 2023-05-26T11:50:06+01:00 Progress - - - - - c92538e7 by Rodrigo Mesquita at 2023-05-27T17:53:03+01:00 Multiple further fixes of IdBindings... - - - - - 8 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Types/Evidence.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -12,7 +12,7 @@ -- | GHC.Core holds all the main data types for use by for the Glasgow Haskell Compiler midsection module GHC.Core ( -- * Main data types - Expr(..,Let,Lam), Alt(..), Bind(..), AltCon(..), Arg, + Expr(..,Let,Lam), Alt(..), Bind(..,Rec,NonRec), AltCon(..), Arg, CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr, TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr, @@ -338,8 +338,28 @@ instance Ord AltCon where -- If you edit this type, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint -data Bind b = HasCallStack => NonRec b (Expr b) - | HasCallStack => Rec [(b, (Expr b))] +data Bind b = HasCallStack => NonRec' b (Expr b) + | HasCallStack => Rec' [(b, (Expr b))] + +{-# COMPLETE NonRec, Rec #-} + +pattern NonRec :: forall b. (HasCallStack, Typeable b) => b -> Expr b -> Bind b +pattern NonRec b e <- NonRec' b e where + NonRec b e + | Just Refl <- eqT @b @Id + , not (isLetBinding b) + = pprPanic "NonRec" (pprIdWithBinding b) + | otherwise + = NonRec' b e + +pattern Rec :: forall b. (HasCallStack, Typeable b) => [(b, Expr b)] -> Bind b +pattern Rec bs <- Rec' bs where + Rec bs + | Just Refl <- eqT @b @Id + , any (not . isLetBinding . fst) bs + = pprPanic "Rec" (ppr bs) + | otherwise + = Rec' bs deriving instance Data b => Data (Bind b) @@ -2035,32 +2055,32 @@ exprToType _bad = pprPanic "exprToType" empty -} -- | Extract every variable by this group -bindersOf :: Bind b -> [b] +bindersOf :: Typeable b => Bind b -> [b] -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint bindersOf (NonRec binder _) = [binder] bindersOf (Rec pairs) = [binder | (binder, _) <- pairs] -- | 'bindersOf' applied to a list of binding groups -bindersOfBinds :: [Bind b] -> [b] +bindersOfBinds :: Typeable b => [Bind b] -> [b] bindersOfBinds binds = foldr ((++) . bindersOf) [] binds -- We inline this to avoid unknown function calls. {-# INLINE foldBindersOfBindStrict #-} -foldBindersOfBindStrict :: (a -> b -> a) -> a -> Bind b -> a +foldBindersOfBindStrict :: Typeable b => (a -> b -> a) -> a -> Bind b -> a foldBindersOfBindStrict f = \z bind -> case bind of NonRec b _rhs -> f z b Rec pairs -> foldl' f z $ map fst pairs {-# INLINE foldBindersOfBindsStrict #-} -foldBindersOfBindsStrict :: (a -> b -> a) -> a -> [Bind b] -> a +foldBindersOfBindsStrict :: Typeable b => (a -> b -> a) -> a -> [Bind b] -> a foldBindersOfBindsStrict f = \z binds -> foldl' fold_bind z binds where fold_bind = (foldBindersOfBindStrict f) -rhssOfBind :: Bind b -> [Expr b] +rhssOfBind :: Typeable b => Bind b -> [Expr b] rhssOfBind (NonRec _ rhs) = [rhs] rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs] @@ -2073,7 +2093,7 @@ rhssOfAlts alts = [e | Alt _ _ e <- alts] -- | Collapse all the bindings in the supplied groups into a single -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group -flattenBinds :: [Bind b] -> [(b, Expr b)] +flattenBinds :: Typeable b => [Bind b] -> [(b, Expr b)] flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds flattenBinds [] = [] ===================================== compiler/GHC/Core/Opt/CSE.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Core.Opt.CSE (cseProgram, cseOneExpr) where import GHC.Prelude import GHC.Core.Subst -import GHC.Types.Var ( Var ) +import GHC.Types.Var ( Var, setIdBinding, IdBinding(..) ) import GHC.Types.Var.Env ( mkInScopeSet ) import GHC.Types.Id ( Id, idType, idHasRules, zapStableUnfolding , idInlineActivation, setInlineActivation @@ -20,12 +20,13 @@ import GHC.Core.Utils ( mkAltExpr , stripTicksE, stripTicksT, mkTicks ) import GHC.Core.FVs ( exprFreeVars ) import GHC.Core.Type ( tyConAppArgs ) +import GHC.Core.Multiplicity import GHC.Core import GHC.Utils.Outputable import GHC.Types.Basic import GHC.Types.Tickish import GHC.Core.Map.Expr -import GHC.Utils.Misc ( filterOut, equalLength ) +import GHC.Utils.Misc ( filterOut, equalLength, HasCallStack ) import GHC.Utils.Panic import Data.Functor.Identity ( Identity (..) ) import Data.List ( mapAccumL ) @@ -880,15 +881,19 @@ extendCSEnv cse expr triv_expr where sexpr = stripTicksE tickishFloatable expr -extendCSRecEnv :: CSEnv -> OutId -> OutExpr -> OutExpr -> CSEnv +extendCSRecEnv :: HasCallStack => CSEnv -> OutId -> OutExpr -> OutExpr -> CSEnv -- See Note [CSE for recursive bindings] extendCSRecEnv cse bndr expr triv_expr - = cse { cs_rec_map = extendCoreMap (cs_rec_map cse) (Lam bndr expr) triv_expr } + = cse { cs_rec_map = extendCoreMap (cs_rec_map cse) (Lam (bndr `setIdBinding` LambdaBound ManyTy) expr) triv_expr } + -- Set binding as below -lookupCSRecEnv :: CSEnv -> OutId -> OutExpr -> Maybe OutExpr +lookupCSRecEnv :: HasCallStack => CSEnv -> OutId -> OutExpr -> Maybe OutExpr -- See Note [CSE for recursive bindings] lookupCSRecEnv (CS { cs_rec_map = csmap }) bndr expr - = lookupCoreMap csmap (Lam bndr expr) + = lookupCoreMap csmap (Lam (bndr `setIdBinding` LambdaBound ManyTy) expr) + -- See Note [Keeping the IdBinding up to date] + -- We look up recursive let-bindings as explained in + -- Note [CSE for recursive bindings] csEnvSubst :: CSEnv -> Subst csEnvSubst = cs_subst ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1876,19 +1876,10 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs Nothing -> return (nullUsage, spec_info) ---------------------- -spec_one :: ScEnv - -> OutId -- Function - -> [InVar] -- Lambda-binders of RHS; should match patterns - -> InExpr -- Body of the original function - -> (CallPat, Int) - -> UniqSM (ScUsage, OneSpec) -- Rule and binding +{- | @'spec_one'@ creates a specialised copy of the function, + together with a rule for using it. I'm very proud of how short this + function is, considering what it does :-). --- spec_one creates a specialised copy of the function, together --- with a rule for using it. I'm very proud of how short this --- function is, considering what it does :-). - -{- Example In-scope: a, x::a @@ -1905,12 +1896,16 @@ spec_one :: ScEnv f (b,c) ((:) (a,(b,c)) (x,v) hw) = f_spec b c v hw -} - +spec_one :: ScEnv + -> OutId -- ^ Function + -> [InVar] -- ^ Lambda-binders of RHS; should match patterns + -> InExpr -- ^ Body of the original function + -> (CallPat, Int) + -> UniqSM (ScUsage, OneSpec) -- ^ Rule and binding spec_one env fn arg_bndrs body (call_pat, rule_number) | CP { cp_qvars = qvars, cp_args = pats, cp_strict_args = cbv_args } <- call_pat - = do { -- pprTraceM "spec_one {" (ppr fn <+> ppr pats) - - ; spec_uniq <- getUniqueM + = do { + spec_uniq <- getUniqueM ; let env1 = extendScSubstList (extendScInScope env qvars) (arg_bndrs `zip` pats) (body_env, extra_bndrs) = extendBndrs env1 (dropList pats arg_bndrs) @@ -1933,10 +1928,9 @@ spec_one env fn arg_bndrs body (call_pat, rule_number) spec_name = mkInternalName spec_uniq spec_occ fn_loc -- Specialise the body - -- ; pprTraceM "body_subst_for" $ ppr (spec_occ) $$ ppr (sc_subst body_env) ; (spec_usg, spec_body) <- scExpr body_env body - -- And build the results + -- And build the results ; (qvars', pats') <- generaliseDictPats qvars pats ; let spec_body_ty = exprType spec_body (spec_lam_args, spec_call_args, spec_sig) @@ -1946,7 +1940,7 @@ spec_one env fn arg_bndrs body (call_pat, rule_number) spec_join_arity | isJoinId fn = Just (length spec_call_args) | otherwise = Nothing spec_id = asWorkerLikeId $ - mkLocalId spec_name (LambdaBound ManyTy) + mkLocalId spec_name (LetBound zeroUE) -- Specialized bindings are let-bound (mkLamTypes spec_lam_args spec_body_ty) -- See Note [Transfer strictness] `setIdDmdSig` spec_sig @@ -1984,7 +1978,7 @@ spec_one env fn arg_bndrs body (call_pat, rule_number) , os_id = spec_id , os_rhs = spec_rhs }) } -generaliseDictPats :: [Var] -> [CoreExpr] -- Quantified vars and pats +generaliseDictPats :: [Var] -> [CoreExpr] -- Quantified vars and pats -> UniqSM ([Var], [CoreExpr]) -- New quantified vars and pats -- See Note [generaliseDictPats] generaliseDictPats qvars pats ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1847,7 +1847,8 @@ deFloatTop (Floats _ floats) = foldrOL get [] floats where get (FloatLet b) bs = get_bind b : bs - get (FloatCase body var _ _ _) bs = get_bind (NonRec var body) : bs + get (FloatCase body var _ _ _) bs = get_bind (NonRec (var `setIdBinding` LetBound zeroUE) body) : bs + -- See Note [Keeping the IdBinding up to date] get b _ = pprPanic "corePrepPgm" (ppr b) -- See Note [Dead code in CorePrep] ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -187,6 +187,7 @@ deSugar hsc_env ; core_prs <- patchMagicDefns core_prs ; (spec_prs, spec_rules) <- dsImpSpecs imp_specs ; (ds_fords, foreign_prs) <- dsForeigns fords + ; pprTraceM "foreign_prs" (ppr foreign_prs) ; ds_rules <- mapMaybeM dsRule rules ; let hpc_init | gopt Opt_Hpc dflags = hpcInitCode (targetPlatform $ hsc_dflags hsc_env) mod ds_hpc_info @@ -299,7 +300,7 @@ dsImpSpecs imp_specs ; let (spec_binds, spec_rules) = unzip spec_prs ; return (concatOL spec_binds, spec_rules) } -combineEvBinds :: [CoreBind] -> [(Id,CoreExpr)] -> [CoreBind] +combineEvBinds :: HasCallStack => [CoreBind] -> [(Id,CoreExpr)] -> [CoreBind] -- Top-level bindings can include coercion bindings, but not via superclasses -- See Note [Top-level evidence] combineEvBinds [] val_prs ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -896,7 +896,7 @@ decomposeRuleLhs dflags orig_bndrs orig_lhs rhs_fvs where extra_tvs = [ v | v <- extra_vars, isTyVar v ] extra_dicts = - [ mkLocalId (localiseName (idName d)) (LambdaBound ManyTy) (idType d) -- ROMES:TODO: Dicts lambda bound here? + [ mkLocalId (localiseName (idName d)) (LetBound zeroUE) (idType d) | d <- extra_vars, isDictId d ] extra_vars = [ v ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -52,6 +52,7 @@ import GHC.Core.Coercion import GHC.Core.Reduction import GHC.Core.Type import GHC.Core.Multiplicity +import GHC.Core.UsageEnv (zeroUE) import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk @@ -264,7 +265,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty -- for overloaded functions, but doesn't seem worth it (arg_tys, res_ty) = splitFunTys (dropForAlls norm_sig_ty) - id = mkLocalId nm (LambdaBound ManyTy) sig_ty -- ROMES:TODO: how bound? + id = mkLocalId nm (LetBound zeroUE) sig_ty -- Let bound top-level foreign import -- Use a LocalId to obey the invariant that locally-defined -- things are LocalIds. However, it does not need zonking, -- (so GHC.Tc.Utils.Zonk.zonkForeignExports ignores it). ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -2,13 +2,13 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ExistentialQuantification, PatternSynonyms #-} {-# LANGUAGE StandaloneDeriving #-} module GHC.Tc.Types.Evidence ( -- * HsWrapper - HsWrapper(..), + HsWrapper(.., WpLet), (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpEvLams, mkWpLet, mkWpFun, mkWpCastN, mkWpCastR, mkWpEta, collectHsWrapBinders, @@ -171,14 +171,26 @@ data HsWrapper | WpTyApp KindOrType -- [] t the 't' is a type (not coercion) - | HasCallStack => WpLet TcEvBinds -- Non-empty (or possibly non-empty) evidence bindings, + | HasCallStack => WpLet' TcEvBinds -- Non-empty (or possibly non-empty) evidence bindings, -- so that the identity coercion is always exactly WpHole | WpMultCoercion Coercion -- Require that a Coercion be reflexive; otherwise, -- error in the desugarer. See GHC.Tc.Utils.Unify -- Note [Wrapper returned from tcSubMult] + +{-# COMPLETE WpHole, WpCompose, WpFun, WpCast, WpEvLam, WpEvApp, WpTyLam, WpTyApp, WpLet, WpMultCoercion #-} + deriving instance Data.Data HsWrapper +pattern WpLet :: HasCallStack => TcEvBinds -> HsWrapper +pattern WpLet x <- WpLet' x where + WpLet x + | EvBinds zs <- x + , anyBag (not . isLetBinding . evBindVar) zs + = pprPanic "pattern WpLet!" (ppr zs) + | otherwise + = WpLet' x + -- | The Semigroup instance is a bit fishy, since @WpCompose@, as a data -- constructor, is "syntactic" and not associative. Concretely, if @a@, @b@, -- and @c@ aren't @WpHole@: @@ -464,7 +476,7 @@ data EvBindInfo ----------------- -- All evidence is bound by EvBinds; no side effects data EvBind - = EvBind { eb_lhs :: EvVar + = HasCallStack => EvBind { eb_lhs :: EvVar , eb_rhs :: EvTerm , eb_info :: EvBindInfo } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/59005e70473f1725fae1384d5825a3cbfb9da09e...c92538e73e6688edee0f59a4ff17ffbd4ae65349 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/59005e70473f1725fae1384d5825a3cbfb9da09e...c92538e73e6688edee0f59a4ff17ffbd4ae65349 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 17:38:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 27 May 2023 13:38:24 -0400 Subject: [Git][ghc/ghc][master] Change GHC.Driver.Session import to .DynFlags Message-ID: <6472401046544_64cfb422609d48055d2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 30 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Config/HsToCore.hs - compiler/GHC/Driver/Config/Linker.hs - compiler/GHC/Driver/Config/Stg/Debug.hs - compiler/GHC/Driver/Config/Stg/Lift.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Config/Tidy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fad9d092b8a81fe3661db3d18a1a02fda3dd2fe1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fad9d092b8a81fe3661db3d18a1a02fda3dd2fe1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 17:39:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 27 May 2023 13:39:04 -0400 Subject: [Git][ghc/ghc][master] EPA: Better fix for #22919 Message-ID: <64724038d2c69_64cfb4275b16480929f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 5 changed files: - compiler/GHC/Parser/Lexer.x - testsuite/tests/ghc-api/exactprint/Test20239.hs - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -3816,14 +3816,19 @@ splitPriorComments -> ([LEpaComment], [LEpaComment]) splitPriorComments ss prior_comments = let - -- True if there is only one line between the earlier and later span - cmp later earlier - = srcSpanStartLine later - srcSpanEndLine earlier == 1 - - go decl _ [] = ([],decl) - go decl r (c@(L l _):cs) = if cmp r (anchor l) - then go (c:decl) (anchor l) cs - else (reverse (c:cs), decl) + -- True if there is only one line between the earlier and later span, + -- And the token preceding the comment is on a different line + cmp :: RealSrcSpan -> LEpaComment -> Bool + cmp later (L l c) + = srcSpanStartLine later - srcSpanEndLine (anchor l) == 1 + && srcSpanEndLine (ac_prior_tok c) /= srcSpanStartLine (anchor l) + + go :: [LEpaComment] -> RealSrcSpan -> [LEpaComment] + -> ([LEpaComment], [LEpaComment]) + go decl_comments _ [] = ([],decl_comments) + go decl_comments r (c@(L l _):cs) = if cmp r c + then go (c:decl_comments) (anchor l) cs + else (reverse (c:cs), decl_comments) in go [] ss prior_comments @@ -3837,10 +3842,7 @@ allocatePriorComments ss comment_q mheader_comments = cmp (L l _) = anchor l <= ss (newAnns,after) = partition cmp comment_q comment_q'= after - (prior_comments, decl_comments) - = case mheader_comments of - Strict.Nothing -> (reverse newAnns, []) - _ -> splitPriorComments ss newAnns + (prior_comments, decl_comments) = splitPriorComments ss newAnns in case mheader_comments of Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments) ===================================== testsuite/tests/ghc-api/exactprint/Test20239.hs ===================================== @@ -1,6 +1,7 @@ module Test20239 where -- | Leading Haddock Comment +-- Running over two lines data instance Method PGMigration = MigrationQuery Query -- ^ Run a query against the database | MigrationCode (Connection -> IO (Either String ())) ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -15,25 +15,18 @@ [] (Just ((,) - { Test20239.hs:8:1 } - { Test20239.hs:7:34-63 }))) + { Test20239.hs:9:1 } + { Test20239.hs:8:34-63 }))) (EpaCommentsBalanced + [] [(L (Anchor - { Test20239.hs:3:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- | Leading Haddock Comment") - { Test20239.hs:1:18-22 }))] - [(L - (Anchor - { Test20239.hs:7:34-63 } + { Test20239.hs:8:34-63 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- ^ Run any arbitrary IO code") - { Test20239.hs:6:86 }))])) + { Test20239.hs:7:86 }))])) (VirtualBraces (1)) (Nothing) @@ -47,12 +40,27 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { Test20239.hs:(4,1)-(6,86) } + { Test20239.hs:(5,1)-(7,86) } (UnchangedAnchor)) (AnnListItem []) (EpaComments - [])) { Test20239.hs:(4,1)-(6,86) }) + [(L + (Anchor + { Test20239.hs:3:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- | Leading Haddock Comment") + { Test20239.hs:1:18-22 })) + ,(L + (Anchor + { Test20239.hs:4:1-25 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Running over two lines") + { Test20239.hs:3:1-28 }))])) { Test20239.hs:(5,1)-(7,86) }) (InstD (NoExtField) (DataFamInstD @@ -61,40 +69,40 @@ (FamEqn (EpAnn (Anchor - { Test20239.hs:(4,1)-(6,86) } + { Test20239.hs:(5,1)-(7,86) } (UnchangedAnchor)) - [(AddEpAnn AnnData (EpaSpan { Test20239.hs:4:1-4 })) - ,(AddEpAnn AnnInstance (EpaSpan { Test20239.hs:4:6-13 })) - ,(AddEpAnn AnnEqual (EpaSpan { Test20239.hs:4:34 }))] + [(AddEpAnn AnnData (EpaSpan { Test20239.hs:5:1-4 })) + ,(AddEpAnn AnnInstance (EpaSpan { Test20239.hs:5:6-13 })) + ,(AddEpAnn AnnEqual (EpaSpan { Test20239.hs:5:34 }))] (EpaComments [(L (Anchor - { Test20239.hs:5:34-70 } + { Test20239.hs:6:34-70 } (UnchangedAnchor)) (EpaComment (EpaLineComment "-- ^ Run a query against the database") - { Test20239.hs:4:51-55 }))])) + { Test20239.hs:5:51-55 }))])) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:15-20 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:5:15-20 }) (Unqual {OccName: Method})) (HsOuterImplicit (NoExtField)) [(HsValArg (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:22-32 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:5:22-32 }) (HsTyVar (EpAnn (Anchor - { Test20239.hs:4:22-32 } + { Test20239.hs:5:22-32 } (UnchangedAnchor)) [] (EpaComments [])) (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:22-32 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:5:22-32 }) (Unqual {OccName: PGMigration})))))] (Prefix) @@ -108,23 +116,23 @@ [(L (SrcSpanAnn (EpAnn (Anchor - { Test20239.hs:4:36-55 } + { Test20239.hs:5:36-55 } (UnchangedAnchor)) (AnnListItem [(AddVbarAnn - (EpaSpan { Test20239.hs:6:34 }))]) + (EpaSpan { Test20239.hs:7:34 }))]) (EpaComments - [])) { Test20239.hs:4:36-55 }) + [])) { Test20239.hs:5:36-55 }) (ConDeclH98 (EpAnn (Anchor - { Test20239.hs:4:36-55 } + { Test20239.hs:5:36-55 } (UnchangedAnchor)) [] (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:36-49 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:5:36-49 }) (Unqual {OccName: MigrationQuery})) (False) @@ -142,33 +150,33 @@ (NoTokenLoc) (HsNormalTok)))) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:51-55 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:5:51-55 }) (HsTyVar (EpAnn (Anchor - { Test20239.hs:4:51-55 } + { Test20239.hs:5:51-55 } (UnchangedAnchor)) [] (EpaComments [])) (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:4:51-55 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:5:51-55 }) (Unqual {OccName: Query})))))]) (Nothing))) ,(L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:36-86 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:36-86 }) (ConDeclH98 (EpAnn (Anchor - { Test20239.hs:6:36-86 } + { Test20239.hs:7:36-86 } (UnchangedAnchor)) [] (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:36-48 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:36-48 }) (Unqual {OccName: MigrationCode})) (False) @@ -186,24 +194,24 @@ (NoTokenLoc) (HsNormalTok)))) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:50-86 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:50-86 }) (HsParTy (EpAnn (Anchor - { Test20239.hs:6:50 } + { Test20239.hs:7:50 } (UnchangedAnchor)) (AnnParen (AnnParens) - (EpaSpan { Test20239.hs:6:50 }) - (EpaSpan { Test20239.hs:6:86 })) + (EpaSpan { Test20239.hs:7:50 }) + (EpaSpan { Test20239.hs:7:86 })) (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-85 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:51-85 }) (HsFunTy (EpAnn (Anchor - { Test20239.hs:6:51-60 } + { Test20239.hs:7:51-60 } (UnchangedAnchor)) (NoEpAnns) (EpaComments @@ -211,104 +219,104 @@ (HsUnrestrictedArrow (L (TokenLoc - (EpaSpan { Test20239.hs:6:62-63 })) + (EpaSpan { Test20239.hs:7:62-63 })) (HsNormalTok))) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-60 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:51-60 }) (HsTyVar (EpAnn (Anchor - { Test20239.hs:6:51-60 } + { Test20239.hs:7:51-60 } (UnchangedAnchor)) [] (EpaComments [])) (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:51-60 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:51-60 }) (Unqual {OccName: Connection})))) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-85 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:65-85 }) (HsAppTy (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-66 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:65-66 }) (HsTyVar (EpAnn (Anchor - { Test20239.hs:6:65-66 } + { Test20239.hs:7:65-66 } (UnchangedAnchor)) [] (EpaComments [])) (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:65-66 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:65-66 }) (Unqual {OccName: IO})))) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:68-85 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:68-85 }) (HsParTy (EpAnn (Anchor - { Test20239.hs:6:68 } + { Test20239.hs:7:68 } (UnchangedAnchor)) (AnnParen (AnnParens) - (EpaSpan { Test20239.hs:6:68 }) - (EpaSpan { Test20239.hs:6:85 })) + (EpaSpan { Test20239.hs:7:68 }) + (EpaSpan { Test20239.hs:7:85 })) (EpaComments [])) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-84 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:69-84 }) (HsAppTy (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-81 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:69-81 }) (HsAppTy (NoExtField) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-74 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:69-74 }) (HsTyVar (EpAnn (Anchor - { Test20239.hs:6:69-74 } + { Test20239.hs:7:69-74 } (UnchangedAnchor)) [] (EpaComments [])) (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:69-74 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:69-74 }) (Unqual {OccName: Either})))) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:76-81 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:76-81 }) (HsTyVar (EpAnn (Anchor - { Test20239.hs:6:76-81 } + { Test20239.hs:7:76-81 } (UnchangedAnchor)) [] (EpaComments [])) (NotPromoted) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:76-81 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:76-81 }) (Unqual {OccName: String})))))) (L - (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:6:83-84 }) + (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:7:83-84 }) (HsTupleTy (EpAnn (Anchor - { Test20239.hs:6:83 } + { Test20239.hs:7:83 } (UnchangedAnchor)) (AnnParen (AnnParens) - (EpaSpan { Test20239.hs:6:83 }) - (EpaSpan { Test20239.hs:6:84 })) + (EpaSpan { Test20239.hs:7:83 }) + (EpaSpan { Test20239.hs:7:84 })) (EpaComments [])) (HsBoxedOrConstraintTuple) @@ -318,5 +326,5 @@ -Test20239.hs:4:15: [GHC-76037] +Test20239.hs:5:15: [GHC-76037] Not in scope: type constructor or class ‘Method’ ===================================== testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr ===================================== @@ -25,15 +25,7 @@ (EpaComment (EpaLineComment "-- leading comments") - { ZeroWidthSemi.hs:1:22-26 })) - ,(L - (Anchor - { ZeroWidthSemi.hs:5:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- Function comment") - { ZeroWidthSemi.hs:3:1-19 }))] + { ZeroWidthSemi.hs:1:22-26 }))] [(L (Anchor { ZeroWidthSemi.hs:8:1-58 } @@ -60,7 +52,14 @@ (AnnListItem []) (EpaComments - [])) { ZeroWidthSemi.hs:6:1-5 }) + [(L + (Anchor + { ZeroWidthSemi.hs:5:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- Function comment") + { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 }) (ValD (NoExtField) (FunBind ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -34,23 +34,7 @@ (EpaComment (EpaBlockComment "{-/n Block comment at the beginning/n -}") - { DumpParsedAstComments.hs:1:1-28 })) - ,(L - (Anchor - { DumpParsedAstComments.hs:7:1-20 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- comment 1 for bar") - { DumpParsedAstComments.hs:5:30-34 })) - ,(L - (Anchor - { DumpParsedAstComments.hs:8:1-20 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- comment 2 for bar") - { DumpParsedAstComments.hs:7:1-20 }))] + { DumpParsedAstComments.hs:1:1-28 }))] [])) (VirtualBraces (1)) @@ -70,7 +54,23 @@ (AnnListItem []) (EpaComments - [])) { DumpParsedAstComments.hs:9:1-7 }) + [(L + (Anchor + { DumpParsedAstComments.hs:7:1-20 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment 1 for bar") + { DumpParsedAstComments.hs:5:30-34 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:8:1-20 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment 2 for bar") + { DumpParsedAstComments.hs:7:1-20 + }))])) { DumpParsedAstComments.hs:9:1-7 }) (ValD (NoExtField) (FunBind View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69fdbece5f6ca0a718bb9f1fef7b0ab57cf6b664 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69fdbece5f6ca0a718bb9f1fef7b0ab57cf6b664 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat May 27 21:00:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sat, 27 May 2023 17:00:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/splitting-id Message-ID: <64726f7830c97_64cfb4275b164819484@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/splitting-id at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/splitting-id You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 28 00:20:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sat, 27 May 2023 20:20:49 -0400 Subject: [Git][ghc/ghc][wip/romes/splitting-id] Compile TyCo.FVs and more Message-ID: <64729e6172019_292e25c997895657@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/splitting-id at Glasgow Haskell Compiler / GHC Commits: c7b752c3 by Rodrigo Mesquita at 2023-05-28T01:20:37+01:00 Compile TyCo.FVs and more - - - - - 8 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Types/Var/Env.hs - compiler/GHC/Types/Var/Set.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -591,11 +591,6 @@ coVarKindsTypesRole cv = pprPanic "coVarKindsTypesRole, non coercion variable" (ppr cv $$ ppr (varType cv)) -coVarKind :: CoVar -> Type -coVarKind cv - = assert (isCoVar cv ) - varType cv - coVarRole :: CoVar -> Role coVarRole cv = eqTyConRole (case tyConAppTyCon_maybe (varType cv) of ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} module GHC.Core.TyCo.FVs ( shallowTyCoVarsOfType, shallowTyCoVarsOfTypes, @@ -51,6 +52,7 @@ module GHC.Core.TyCo.FVs Endo(..), runTyCoVars ) where +import Data.Either import GHC.Prelude import {-# SOURCE #-} GHC.Core.Type( partitionInvisibleTypes, coreView, rewriterView ) @@ -102,7 +104,7 @@ Examples: Type Shallow Deep --------------------------------- (a : (k:Type)) {a} {a,k} - forall (a:(k:Type)). a {k} {k} + forall (a:(k:Type)). a { } {k} (a:k->Type) (b:k) {a,b} {a,b,k} -} @@ -317,18 +319,27 @@ deep_cos :: [Coercion] -> Endo TyCoVarSet deepTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet) deepTcvFolder = TyCoFolder { tcf_view = noView - , tcf_tyvar = do_tcv, tcf_covar = do_tcv + , tcf_tyvar = do_tv, tcf_covar = do_cv , tcf_hole = do_hole, tcf_tycobinder = do_bndr } where - do_tcv is v = Endo do_it + do_tv :: TyCoVarSet -> TyVar -> Endo TyCoVarSet + do_tv is v = Endo do_it where - do_it acc | v `elemVarSet` is = acc - | v `elemVarSet` acc = acc - | otherwise = appEndo (deep_ty (varType v)) $ - acc `extendVarSet` v + do_it acc | Left v `elemVarSet` is = acc + | Left v `elemVarSet` acc = acc + | otherwise = appEndo (deep_ty (varTypeTyVar v)) $ + acc `extendVarSet` Left v + + do_cv :: TyCoVarSet -> CoVar -> Endo TyCoVarSet + do_cv is v = Endo do_it + where + do_it acc | Right v `elemVarSet` is = acc + | Right v `elemVarSet` acc = acc + | otherwise = appEndo (deep_ty (varTypeId v)) $ + acc `extendVarSet` Right v do_bndr is tcv _ = extendVarSet is tcv - do_hole is hole = do_tcv is (coHoleCoVar hole) + do_hole is hole = do_cv is (coHoleCoVar hole) -- See Note [CoercionHoles and coercion free variables] -- in GHC.Core.TyCo.Rep @@ -375,14 +386,22 @@ shallow_cos :: [Coercion] -> Endo TyCoVarSet shallowTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet) shallowTcvFolder = TyCoFolder { tcf_view = noView - , tcf_tyvar = do_tcv, tcf_covar = do_tcv + , tcf_tyvar = do_tv, tcf_covar = do_cv , tcf_hole = do_hole, tcf_tycobinder = do_bndr } where - do_tcv is v = Endo do_it + do_tv :: TyCoVarSet -> TyVar -> Endo TyCoVarSet + do_tv is v = Endo do_it where - do_it acc | v `elemVarSet` is = acc - | v `elemVarSet` acc = acc - | otherwise = acc `extendVarSet` v + do_it acc | Left v `elemVarSet` is = acc + | Left v `elemVarSet` acc = acc + | otherwise = acc `extendVarSet` Left v + + do_cv :: TyCoVarSet -> CoVar -> Endo TyCoVarSet + do_cv is v = Endo do_it + where + do_it acc | Right v `elemVarSet` is = acc + | Right v `elemVarSet` acc = acc + | otherwise = acc `extendVarSet` Right v do_bndr is tcv _ = extendVarSet is tcv do_hole _ _ = mempty -- Ignore coercion holes @@ -411,10 +430,10 @@ coVarsOfTypes :: [Type] -> CoVarSet coVarsOfCo :: Coercion -> CoVarSet coVarsOfCos :: [Coercion] -> CoVarSet -coVarsOfType ty = runTyCoVars (deep_cv_ty ty) -coVarsOfTypes tys = runTyCoVars (deep_cv_tys tys) -coVarsOfCo co = runTyCoVars (deep_cv_co co) -coVarsOfCos cos = runTyCoVars (deep_cv_cos cos) +coVarsOfType ty = rightsVarSet $ runTyCoVars (mapVarSet Right <$> deep_cv_ty ty) +coVarsOfTypes tys = rightsVarSet $ runTyCoVars (mapVarSet Right <$> deep_cv_tys tys) +coVarsOfCo co = rightsVarSet $ runTyCoVars (mapVarSet Right <$> deep_cv_co co) +coVarsOfCos cos = rightsVarSet $ runTyCoVars (mapVarSet Right <$> deep_cv_cos cos) deep_cv_ty :: Type -> Endo CoVarSet deep_cv_tys :: [Type] -> Endo CoVarSet @@ -436,9 +455,9 @@ deepCoVarFolder = TyCoFolder { tcf_view = noView do_covar is v = Endo do_it where - do_it acc | v `elemVarSet` is = acc + do_it acc | Right v `elemVarSet` is = acc | v `elemVarSet` acc = acc - | otherwise = appEndo (deep_cv_ty (varType v)) $ + | otherwise = appEndo (deep_cv_ty (varTypeId v)) $ acc `extendVarSet` v do_bndr is tcv _ = extendVarSet is tcv @@ -459,7 +478,7 @@ closeOverKinds :: TyCoVarSet -> TyCoVarSet -- add the deep free variables of its kind closeOverKinds vs = nonDetStrictFoldVarSet do_one vs vs where - do_one v acc = appEndo (deep_ty (varType v)) acc + do_one v acc = appEndo (deep_ty (varTypeTyCoVar v)) acc {- --------------- Alternative version 1 (using FV) ------------ closeOverKinds = fvVarSet . closeOverKindsFV . nonDetEltsUniqSet @@ -520,50 +539,60 @@ close_over_kinds wl acc * * ********************************************************************* -} +-- ROMES:TODO: In the following functions, the right thing to do is parametrize FV rather than converting to and from Var (the last being unsafe...) +unsafeVarToTyVar :: [Var] -> [TyVar] +unsafeVarToTyVar = map (\case TV v -> v; _ -> panic "unsafeVarToTyVar") +unsafeVarToTyCoVar :: [Var] -> [TyCoVar] +unsafeVarToTyCoVar = map (\case TV v -> Left v; I i -> Right i; _ -> panic "unsafeVarToTyCoVar") +unsafeVarSetToTyVarSet :: DVarSet -> DTyVarSet +unsafeVarSetToTyVarSet = mapDVarSet (\case TV v -> v; _ -> panic "unsafeVarSetToTyVarSet") +unsafeVarSetToTyCoVarSet :: DVarSet -> DTyCoVarSet +unsafeVarSetToTyCoVarSet = mapDVarSet (\case TV v -> Left v; I i -> Right i; _ -> panic "unsafeVarSetToTyCoVarSet") + -- | Given a list of tyvars returns a deterministic FV computation that -- returns the given tyvars with the kind variables free in the kinds of the -- given tyvars. closeOverKindsFV :: [TyVar] -> FV closeOverKindsFV tvs = - mapUnionFV (tyCoFVsOfType . tyVarKind) tvs `unionFV` mkFVs tvs + mapUnionFV (tyCoFVsOfType . tyVarKind) tvs `unionFV` mkFVs (map TV tvs) -- | Add the kind variables free in the kinds of the tyvars in the given set. -- Returns a deterministically ordered list. closeOverKindsList :: [TyVar] -> [TyVar] -closeOverKindsList tvs = fvVarList $ closeOverKindsFV tvs +closeOverKindsList tvs = unsafeVarToTyVar $ fvVarList $ closeOverKindsFV tvs -- | Add the kind variables free in the kinds of the tyvars in the given set. -- Returns a deterministic set. closeOverKindsDSet :: DTyVarSet -> DTyVarSet -closeOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems +closeOverKindsDSet = unsafeVarSetToTyVarSet . fvDVarSet . closeOverKindsFV . dVarSetElems -- | `tyCoFVsOfType` that returns free variables of a type in a deterministic -- set. For explanation of why using `VarSet` is not deterministic see -- Note [Deterministic FV] in "GHC.Utils.FV". tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfTypeDSet ty = fvDVarSet $ tyCoFVsOfType ty +tyCoVarsOfTypeDSet ty = unsafeVarSetToTyCoVarSet $ fvDVarSet $ tyCoFVsOfType ty -- | `tyCoFVsOfType` that returns free variables of a type in deterministic -- order. For explanation of why using `VarSet` is not deterministic see -- Note [Deterministic FV] in "GHC.Utils.FV". tyCoVarsOfTypeList :: Type -> [TyCoVar] -- See Note [Free variables of types] -tyCoVarsOfTypeList ty = fvVarList $ tyCoFVsOfType ty +tyCoVarsOfTypeList ty = unsafeVarToTyCoVar $ fvVarList $ tyCoFVsOfType ty -- | Returns free variables of types, including kind variables as -- a deterministic set. For type synonyms it does /not/ expand the -- synonym. tyCoVarsOfTypesDSet :: [Type] -> DTyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfTypesDSet tys = fvDVarSet $ tyCoFVsOfTypes tys +tyCoVarsOfTypesDSet tys = unsafeVarSetToTyCoVarSet $ fvDVarSet $ tyCoFVsOfTypes tys -- | Returns free variables of types, including kind variables as -- a deterministically ordered list. For type synonyms it does /not/ expand the -- synonym. tyCoVarsOfTypesList :: [Type] -> [TyCoVar] -- See Note [Free variables of types] -tyCoVarsOfTypesList tys = fvVarList $ tyCoFVsOfTypes tys +tyCoVarsOfTypesList tys = unsafeVarToTyCoVar $ fvVarList $ tyCoFVsOfTypes tys -- | The worker for `tyCoFVsOfType` and `tyCoFVsOfTypeList`. -- The previous implementation used `unionVarSet` which is O(n+m) and can @@ -577,12 +606,12 @@ tyCoVarsOfTypesList tys = fvVarList $ tyCoFVsOfTypes tys tyCoFVsOfType :: Type -> FV -- See Note [Free variables of types] tyCoFVsOfType (TyVarTy v) f bound_vars (acc_list, acc_set) - | not (f v) = (acc_list, acc_set) - | v `elemVarSet` bound_vars = (acc_list, acc_set) - | v `elemVarSet` acc_set = (acc_list, acc_set) + | not (f (TV v)) = (acc_list, acc_set) + | TV v `elemVarSet` bound_vars = (acc_list, acc_set) + | TV v `elemVarSet` acc_set = (acc_list, acc_set) | otherwise = tyCoFVsOfType (tyVarKind v) f emptyVarSet -- See Note [Closing over free variable kinds] - (v:acc_list, extendVarSet acc_set v) + (TV v:acc_list, extendVarSet acc_set (TV v)) tyCoFVsOfType (TyConApp _ tys) f bound_vars acc = tyCoFVsOfTypes tys f bound_vars acc tyCoFVsOfType (LitTy {}) f bound_vars acc = emptyFV f bound_vars acc tyCoFVsOfType (AppTy fun arg) f bound_vars acc = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) f bound_vars acc @@ -595,13 +624,13 @@ tyCoFVsBndr :: ForAllTyBinder -> FV -> FV -- Free vars of (forall b. ) tyCoFVsBndr (Bndr tv _) fvs = tyCoFVsVarBndr tv fvs -tyCoFVsVarBndrs :: [Var] -> FV -> FV +tyCoFVsVarBndrs :: [TyCoVar] -> FV -> FV tyCoFVsVarBndrs vars fvs = foldr tyCoFVsVarBndr fvs vars -tyCoFVsVarBndr :: Var -> FV -> FV -tyCoFVsVarBndr var fvs - = tyCoFVsOfType (varType var) -- Free vars of its type/kind - `unionFV` delFV var fvs -- Delete it from the thing-inside +tyCoFVsVarBndr :: TyCoVar -> FV -> FV +tyCoFVsVarBndr tycov fvs + = tyCoFVsOfType (varTypeTyCoVar tycov) -- Free vars of its type/kind + `unionFV` delFV (tyCoVarToVar tycov) fvs -- Delete it from the thing-inside tyCoFVsOfTypes :: [Type] -> FV -- See Note [Free variables of types] @@ -611,11 +640,11 @@ tyCoFVsOfTypes [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc -- | Get a deterministic set of the vars free in a coercion tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfCoDSet co = fvDVarSet $ tyCoFVsOfCo co +tyCoVarsOfCoDSet co = unsafeVarSetToTyCoVarSet $ fvDVarSet $ tyCoFVsOfCo co tyCoVarsOfCoList :: Coercion -> [TyCoVar] -- See Note [Free variables of types] -tyCoVarsOfCoList co = fvVarList $ tyCoFVsOfCo co +tyCoVarsOfCoList co = unsafeVarToTyCoVar $ fvVarList $ tyCoFVsOfCo co tyCoFVsOfMCo :: MCoercion -> FV tyCoFVsOfMCo MRefl = emptyFV @@ -655,7 +684,7 @@ tyCoFVsOfCo (AxiomRuleCo _ cs) fv_cand in_scope acc = tyCoFVsOfCos cs fv_cand i tyCoFVsOfCoVar :: CoVar -> FV tyCoFVsOfCoVar v fv_cand in_scope acc - = (unitFV v `unionFV` tyCoFVsOfType (varType v)) fv_cand in_scope acc + = (unitFV (I v) `unionFV` tyCoFVsOfType (varTypeId v)) fv_cand in_scope acc tyCoFVsOfProv :: UnivCoProvenance -> FV tyCoFVsOfProv (PhantomProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc @@ -688,7 +717,7 @@ almost_devoid_co_var_of_co (AppCo co arg) cv && almost_devoid_co_var_of_co arg cv almost_devoid_co_var_of_co (ForAllCo v kind_co co) cv = almost_devoid_co_var_of_co kind_co cv - && (v == cv || almost_devoid_co_var_of_co co cv) + && (v == Right cv || almost_devoid_co_var_of_co co cv) almost_devoid_co_var_of_co (FunCo { fco_mult = w, fco_arg = co1, fco_res = co2 }) cv = almost_devoid_co_var_of_co w cv && almost_devoid_co_var_of_co co1 cv @@ -747,8 +776,8 @@ almost_devoid_co_var_of_type (FunTy _ w arg res) cv && almost_devoid_co_var_of_type arg cv && almost_devoid_co_var_of_type res cv almost_devoid_co_var_of_type (ForAllTy (Bndr v _) ty) cv - = almost_devoid_co_var_of_type (varType v) cv - && (v == cv || almost_devoid_co_var_of_type ty cv) + = almost_devoid_co_var_of_type (varTypeTyCoVar v) cv + && (v == (Right cv) || almost_devoid_co_var_of_type ty cv) almost_devoid_co_var_of_type (CastTy ty co) cv = almost_devoid_co_var_of_type ty cv && almost_devoid_co_var_of_co co cv @@ -780,13 +809,13 @@ visVarsOfType orig_ty = Pair invis_vars vis_vars Pair invis_vars1 vis_vars = go orig_ty invis_vars = invis_vars1 `minusVarSet` vis_vars - go (TyVarTy tv) = Pair (tyCoVarsOfType $ tyVarKind tv) (unitVarSet tv) + go (TyVarTy tv) = Pair (tyCoVarsOfType $ tyVarKind tv) (unitVarSet (Left tv)) go (AppTy t1 t2) = go t1 `mappend` go t2 go (TyConApp tc tys) = go_tc tc tys go (FunTy _ w t1 t2) = go w `mappend` go t1 `mappend` go t2 go (ForAllTy (Bndr tv _) ty) = ((`delVarSet` tv) <$> go ty) `mappend` - (invisible (tyCoVarsOfType $ varType tv)) + invisible (tyCoVarsOfType $ varTypeTyCoVar tv) go (LitTy {}) = mempty go (CastTy ty co) = go ty `mappend` invisible (tyCoVarsOfCo co) go (CoercionTy co) = invisible $ tyCoVarsOfCo co @@ -819,8 +848,10 @@ isInjectiveInType tv ty go (AppTy f a) = go f || go a go (FunTy _ w ty1 ty2) = go w || go ty1 || go ty2 go (TyConApp tc tys) = go_tc tc tys - go (ForAllTy (Bndr tv' _) ty) = go (tyVarKind tv') - || (tv /= tv' && go ty) + go (ForAllTy (Bndr (Left tv') _) ty) = go (tyVarKind tv') + || (tv /= tv' && go ty) + go (ForAllTy (Bndr (Right cv') _) ty) = go (coVarKind cv') + -- || (tv /= cv' && go ty) ROMES:TODO: Can never happen, right? How can a tyVar be == to a coVar go LitTy{} = False go (CastTy ty _) = go ty go CoercionTy{} = False @@ -859,11 +890,12 @@ injectiveVarsOfType :: Bool -- ^ Should we look under injective type families? injectiveVarsOfType look_under_tfs = go where go ty | Just ty' <- rewriterView ty = go ty' - go (TyVarTy v) = unitFV v `unionFV` go (tyVarKind v) + go (TyVarTy v) = unitFV (TV v) `unionFV` go (tyVarKind v) go (AppTy f a) = go f `unionFV` go a go (FunTy _ w ty1 ty2) = go w `unionFV` go ty1 `unionFV` go ty2 go (TyConApp tc tys) = go_tc tc tys - go (ForAllTy (Bndr tv _) ty) = go (tyVarKind tv) `unionFV` delFV tv (go ty) + go (ForAllTy (Bndr (Left tv) _) ty) = go (tyVarKind tv) `unionFV` delFV (TV tv) (go ty) + go (ForAllTy (Bndr (Right tv) _) ty) = go (coVarKind tv) `unionFV` delFV (I tv) (go ty) go LitTy{} = emptyFV go (CastTy ty _) = go ty go CoercionTy{} = emptyFV @@ -944,10 +976,11 @@ invisibleVarsOfTypes = mapUnionFV invisibleVarsOfType {-# INLINE afvFolder #-} -- so that specialization to (const True) works afvFolder :: (TyCoVar -> Bool) -> TyCoFolder TyCoVarSet DM.Any afvFolder check_fv = TyCoFolder { tcf_view = noView - , tcf_tyvar = do_tcv, tcf_covar = do_tcv + , tcf_tyvar = do_tv, tcf_covar = do_cv , tcf_hole = do_hole, tcf_tycobinder = do_bndr } where - do_tcv is tv = Any (not (tv `elemVarSet` is) && check_fv tv) + do_tv is tv = Any (not (Left tv `elemVarSet` is) && check_fv (Left tv)) + do_cv is cv = Any (not (Right cv `elemVarSet` is) && check_fv (Right cv)) do_hole _ _ = Any False -- I'm unsure; probably never happens do_bndr is tv _ = is `extendVarSet` tv @@ -1055,7 +1088,7 @@ scopedSort = go [] [] -> [TyCoVar] -- sorted list, in reverse order -> [TyCoVarSet] -- list of fvs, as above -> ([TyCoVar], [TyCoVarSet]) -- augmented lists - insert tv [] [] = ([tv], [tyCoVarsOfType (tyVarKind tv)]) + insert tv [] [] = ([tv], [tyCoVarsOfType (tyCoVarKind tv)]) insert tv (a:as) (fvs:fvss) | tv `elemVarSet` fvs , (as', fvss') <- insert tv as fvss @@ -1064,18 +1097,18 @@ scopedSort = go [] [] | otherwise = (tv:a:as, fvs `unionVarSet` fv_tv : fvs : fvss) where - fv_tv = tyCoVarsOfType (tyVarKind tv) + fv_tv = tyCoVarsOfType (tyCoVarKind tv) -- lists not in correspondence insert _ _ _ = panic "scopedSort" -- | Get the free vars of a type in scoped order tyCoVarsOfTypeWellScoped :: Type -> [TyVar] -tyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList +tyCoVarsOfTypeWellScoped = lefts . scopedSort . tyCoVarsOfTypeList -- | Get the free vars of types in scoped order tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar] -tyCoVarsOfTypesWellScoped = scopedSort . tyCoVarsOfTypesList +tyCoVarsOfTypesWellScoped = lefts . scopedSort . tyCoVarsOfTypesList {- ************************************************************************ @@ -1101,7 +1134,7 @@ tyConsOfType ty go (FunTy af w a b) = go w `unionUniqSets` go a `unionUniqSets` go b `unionUniqSets` go_tc (funTyFlagTyCon af) - go (ForAllTy (Bndr tv _) ty) = go ty `unionUniqSets` go (varType tv) + go (ForAllTy (Bndr tv _) ty) = go ty `unionUniqSets` go (varTypeTyCoVar tv) go (CastTy ty co) = go ty `unionUniqSets` go_co co go (CoercionTy co) = go_co co @@ -1212,7 +1245,7 @@ of occurrences. See bad_var_occ in occCheckExpand. And see #18451 for more debate. -} -occCheckExpand :: [Var] -> Type -> Maybe Type +occCheckExpand :: [TyCoVar] -> Type -> Maybe Type -- See Note [Occurs check expansion] -- We may have needed to do some type synonym unfolding in order to -- get rid of the variable (or forall), so we also return the unfolded @@ -1226,14 +1259,14 @@ occCheckExpand vs_to_avoid ty | otherwise = go (mkVarSet vs_to_avoid, emptyVarEnv) ty where - go :: (VarSet, VarEnv TyCoVar) -> Type -> Maybe Type + go :: (TyCoVarSet, TyCoVarEnv TyCoVar) -> Type -> Maybe Type -- The VarSet is the set of variables we are trying to avoid -- The VarEnv carries mappings necessary -- because of kind expansion go (as, env) ty@(TyVarTy tv) - | Just tv' <- lookupVarEnv env tv = return (mkTyVarTy tv') - | bad_var_occ as tv = Nothing - | otherwise = return ty + | Just (Left tv') <- lookupVarEnv env (Left tv) = return (mkTyVarTy tv') + | bad_var_occ as (Left tv) = Nothing + | otherwise = return ty go _ ty@(LitTy {}) = return ty go cxt (AppTy ty1 ty2) = do { ty1' <- go cxt ty1 @@ -1245,8 +1278,8 @@ occCheckExpand vs_to_avoid ty ; ty2' <- go cxt ty2 ; return (ty { ft_mult = w', ft_arg = ty1', ft_res = ty2' }) } go cxt@(as, env) (ForAllTy (Bndr tv vis) body_ty) - = do { ki' <- go cxt (varType tv) - ; let tv' = setVarType tv ki' + = do { ki' <- go cxt (varTypeTyCoVar tv) + ; let tv' = setTyCoVarType tv ki' env' = extendVarEnv env tv tv' as' = as `delVarSet` tv ; body' <- go (as', env') body_ty @@ -1270,12 +1303,12 @@ occCheckExpand vs_to_avoid ty ; return (CoercionTy co') } ------------------ - bad_var_occ :: VarSet -> Var -> Bool + bad_var_occ :: TyCoVarSet -> TyCoVar -> Bool -- Works for TyVar and CoVar -- See Note [Occurrence checking: look inside kinds] bad_var_occ vs_to_avoid v = v `elemVarSet` vs_to_avoid - || tyCoVarsOfType (varType v) `intersectsVarSet` vs_to_avoid + || tyCoVarsOfType (varTypeTyCoVar v) `intersectsVarSet` vs_to_avoid ------------------ go_mco _ MRefl = return MRefl @@ -1295,7 +1328,7 @@ occCheckExpand vs_to_avoid ty ; return (AppCo co' arg') } go_co cxt@(as, env) (ForAllCo tv kind_co body_co) = do { kind_co' <- go_co cxt kind_co - ; let tv' = setVarType tv $ + ; let tv' = setTyCoVarType tv $ coercionLKind kind_co' env' = extendVarEnv env tv tv' as' = as `delVarSet` tv @@ -1308,13 +1341,13 @@ occCheckExpand vs_to_avoid ty ; return (co { fco_mult = w', fco_arg = co1', fco_res = co2' })} go_co (as,env) co@(CoVarCo c) - | Just c' <- lookupVarEnv env c = return (CoVarCo c') - | bad_var_occ as c = Nothing - | otherwise = return co + | Just (Right c') <- lookupVarEnv env (Right c) = return (CoVarCo c') + | bad_var_occ as (Right c) = Nothing + | otherwise = return co go_co (as,_) co@(HoleCo h) - | bad_var_occ as (ch_co_var h) = Nothing - | otherwise = return co + | bad_var_occ as (Right (ch_co_var h)) = Nothing + | otherwise = return co go_co cxt (AxiomInstCo ax ind args) = do { args' <- mapM (go_co cxt) args ; return (AxiomInstCo ax ind args') } ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_HADDOCK not-home #-} @@ -122,7 +123,7 @@ type FRRType = Type -- See Note [GHC Formalism] in GHC.Core.Lint data Type -- See Note [Non-trivial definitional equality] - = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable) + = TyVarTy TyVar -- ^ Vanilla type or kind variable (*never* a coercion variable) | AppTy Type @@ -674,18 +675,15 @@ which in turn is imported by Type -} mkTyVarTy :: TyVar -> Type -mkTyVarTy v = assertPpr (isTyVar v) (ppr v <+> dcolon <+> ppr (tyVarKind v)) $ - TyVarTy v +mkTyVarTy v = TyVarTy v mkTyVarTys :: [TyVar] -> [Type] mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy mkTyCoVarTy :: TyCoVar -> Type -mkTyCoVarTy v - | isTyVar v - = TyVarTy v - | otherwise - = CoercionTy (CoVarCo v) +mkTyCoVarTy = \case + Left v -> TyVarTy v + Right v -> CoercionTy (CoVarCo v) mkTyCoVarTys :: [TyCoVar] -> [Type] mkTyCoVarTys = map mkTyCoVarTy @@ -783,7 +781,7 @@ mkForAllTys tyvars ty = foldr ForAllTy ty tyvars -- | Wraps foralls over the type using the provided 'InvisTVBinder's from left to right mkInvisForAllTys :: [InvisTVBinder] -> Type -> Type -mkInvisForAllTys tyvars = mkForAllTys (tyVarSpecToBinders tyvars) +mkInvisForAllTys tyvars = mkForAllTys $ mapVarBndrs Left (tyVarSpecToBinders tyvars) mkPiTy :: PiTyBinder -> Type -> Type mkPiTy (Anon ty1 af) ty2 = mkScaledFunTy af ty1 ty2 @@ -1727,7 +1725,7 @@ foldTyCo (TyCoFolder { tcf_view = view go_ty env (TyConApp _ tys) = go_tys env tys go_ty env (ForAllTy (Bndr tv vis) inner) = let !env' = tycobinder env tv vis -- Avoid building a thunk here - in go_ty env (varType tv) `mappend` go_ty env' inner + in go_ty env (varTypeTyCoVar tv) `mappend` go_ty env' inner -- Explicit recursion because using foldr builds a local -- loop (with env free) and I'm not confident it'll be @@ -1761,7 +1759,7 @@ foldTyCo (TyCoFolder { tcf_view = view = go_co env cw `mappend` go_co env c1 `mappend` go_co env c2 go_co env (ForAllCo tv kind_co co) - = go_co env kind_co `mappend` go_ty env (varType tv) + = go_co env kind_co `mappend` go_ty env (varTypeTyCoVar tv) `mappend` go_co env' co where env' = tycobinder env tv Inferred @@ -1801,7 +1799,7 @@ typeSize (LitTy {}) = 1 typeSize (TyVarTy {}) = 1 typeSize (AppTy t1 t2) = typeSize t1 + typeSize t2 typeSize (FunTy _ _ t1 t2) = typeSize t1 + typeSize t2 -typeSize (ForAllTy (Bndr tv _) t) = typeSize (varType tv) + typeSize t +typeSize (ForAllTy (Bndr tv _) t) = typeSize (varTypeTyCoVar tv) + typeSize t typeSize (TyConApp _ ts) = 1 + typesSize ts typeSize (CastTy ty co) = typeSize ty + coercionSize co typeSize (CoercionTy co) = coercionSize co ===================================== compiler/GHC/Core/TyCo/Rep.hs-boot ===================================== @@ -3,7 +3,7 @@ module GHC.Core.TyCo.Rep where import GHC.Utils.Outputable ( Outputable ) import Data.Data ( Data ) -import {-# SOURCE #-} GHC.Types.Var( Var, VarBndr, ForAllTyFlag, FunTyFlag ) +import {-# SOURCE #-} GHC.Types.Var( TyCoVar, VarBndr, ForAllTyFlag, FunTyFlag ) import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) data Type @@ -26,7 +26,7 @@ type ThetaType = [PredType] type CoercionN = Coercion type MCoercionN = MCoercion -mkForAllTy :: VarBndr Var ForAllTyFlag -> Type -> Type +mkForAllTy :: VarBndr TyCoVar ForAllTyFlag -> Type -> Type mkNakedTyConTy :: TyCon -> Type mkNakedFunTy :: FunTyFlag -> Type -> Type -> Type ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -192,6 +192,9 @@ instance Uniquable Int where instance Uniquable ModuleName where getUnique (ModuleName nm) = getUnique nm +instance (Uniquable a, Uniquable b) => Uniquable (Either a b) where + getUnique (Left x) = getUnique x + getUnique (Right x) = getUnique x {- ************************************************************************ @@ -323,3 +326,4 @@ iToBase62 n_ {-# INLINE chooseChar62 #-} chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n) chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"# + ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -48,9 +48,13 @@ module GHC.Types.Var ( varMult, varMultMaybe, varNameTyVar, varNameTcTyVar, varNameId, varTypeTyVar, varTypeTcTyVar, varTypeId, + + varTypeTyCoVar, tyCoVarToVar, + coVarKind, tyCoVarKind, + -- ** Modifying 'Var's - setVarName, setVarUnique, setVarType, + setVarName, setVarUnique, setVarType, setTyCoVarType, updateVarType, updateVarTypeM, -- ** Constructing, taking apart, modifying 'Id's @@ -273,6 +277,16 @@ data Id id_details :: IdDetails, -- Stable, doesn't change id_info :: IdInfo } -- Unstable, updated by simplifier +varTypeTyCoVar :: TyCoVar -> Type +varTypeTyCoVar = \case + Left v -> varTypeTyVar v + Right v -> varTypeId v + +tyCoVarToVar :: TyCoVar -> Var +tyCoVarToVar = \case + Left x -> TV x + Right x -> I x + varName :: Var -> Name varName = \case TV TyVar{varNameTyVar} -> varNameTyVar @@ -510,6 +524,11 @@ setVarType var ty = case var of TV tv -> TV tv { varTypeTyVar = ty } TTV ttv -> TTV ttv { varTypeTcTyVar = ty } +setTyCoVarType :: TyCoVar -> Type -> TyCoVar +setTyCoVarType var ty = case var of + Left tv -> Left tv { varTypeTyVar = ty } + Right id -> Right id { varTypeId = ty } + -- | Update a 'Var's type. Does not update the /multiplicity/ -- stored in an 'Id', if any. Because of the possibility for -- abuse, ASSERTs that there is no multiplicity to update. @@ -1151,6 +1170,14 @@ tyVarName = varNameTyVar tyVarKind :: TyVar -> Kind tyVarKind = varTypeTyVar +coVarKind :: CoVar -> Type +coVarKind cv = varTypeId cv + +tyCoVarKind :: TyCoVar -> Kind +tyCoVarKind = \case + Left tv -> tyVarKind tv + Right cv -> coVarKind cv + setTyVarUnique :: TyVar -> Unique -> TyVar setTyVarUnique tv uq = case setVarUnique (TV tv) uq of TV tv -> tv ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -500,13 +500,14 @@ type TyCoVarEnv elt = UniqFM TyCoVar elt -- | Coercion Variable Environment type CoVarEnv elt = UniqFM CoVar elt -emptyVarEnv :: VarEnv a +emptyVarEnv :: UniqFM var a mkVarEnv :: [(Var, a)] -> VarEnv a mkVarEnv_Directly :: [(Unique, a)] -> VarEnv a zipVarEnv :: [Var] -> [a] -> VarEnv a unitVarEnv :: Var -> a -> VarEnv a alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a -extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a +extendVarEnv :: UniqFM var a -> var -> a -> UniqFM var a +{-# SPECIALISE extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a #-} extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a @@ -527,7 +528,8 @@ mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a isEmptyVarEnv :: VarEnv a -> Bool -lookupVarEnv :: VarEnv a -> Var -> Maybe a +lookupVarEnv :: UniqFM var a -> var -> Maybe a +{-# SPECIALISE lookupVarEnv :: VarEnv a -> Var -> Maybe a #-} lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a filterVarEnv :: (a -> Bool) -> VarEnv a -> VarEnv a anyVarEnv :: (elt -> Bool) -> UniqFM key elt -> Bool ===================================== compiler/GHC/Types/Var/Set.hs ===================================== @@ -3,7 +3,7 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} - +{-# LANGUAGE LambdaCase #-} module GHC.Types.Var.Set ( -- * Var, Id and TyVar set types @@ -44,9 +44,12 @@ module GHC.Types.Var.Set ( sizeDVarSet, seqDVarSet, partitionDVarSet, dVarSetToVarSet, + leftsVarSet, rightsVarSet ) where +import Data.Either import GHC.Prelude +import GHC.Utils.Panic import GHC.Types.Var ( Var, TyVar, CoVar, TyCoVar, Id ) import GHC.Types.Unique @@ -78,30 +81,39 @@ type CoVarSet = UniqSet CoVar -- | Type or Coercion Variable Set type TyCoVarSet = UniqSet TyCoVar -emptyVarSet :: VarSet -intersectVarSet :: VarSet -> VarSet -> VarSet -unionVarSet :: VarSet -> VarSet -> VarSet +emptyVarSet :: UniqSet a +intersectVarSet :: UniqSet a -> UniqSet a -> UniqSet a +{-# SPECIALISE intersectVarSet :: VarSet -> VarSet -> VarSet #-} +unionVarSet :: UniqSet a -> UniqSet a -> UniqSet a +{-# SPECIALISE unionVarSet :: VarSet -> VarSet -> VarSet #-} unionVarSets :: [VarSet] -> VarSet mapUnionVarSet :: (a -> VarSet) -> [a] -> VarSet -- ^ map the function over the list, and union the results -unitVarSet :: Var -> VarSet -extendVarSet :: VarSet -> Var -> VarSet +unitVarSet :: Uniquable a => a -> UniqSet a +{-# SPECIALIZE unitVarSet :: Var -> VarSet #-} +extendVarSet :: Uniquable a => UniqSet a -> a -> UniqSet a +{-# SPECIALISE extendVarSet :: VarSet -> Var -> VarSet #-} extendVarSetList:: VarSet -> [Var] -> VarSet -elemVarSet :: Var -> VarSet -> Bool -delVarSet :: VarSet -> Var -> VarSet +elemVarSet :: Uniquable a => a -> UniqSet a -> Bool +{-# SPECIALISE elemVarSet :: Var -> VarSet -> Bool #-} +delVarSet :: Uniquable a => UniqSet a -> a -> UniqSet a +{-# SPECIALISE delVarSet :: VarSet -> Var -> VarSet #-} delVarSetList :: VarSet -> [Var] -> VarSet -minusVarSet :: VarSet -> VarSet -> VarSet +minusVarSet :: Uniquable a => UniqSet a -> UniqSet a -> UniqSet a +{-# SPECIALISE minusVarSet :: VarSet -> VarSet -> VarSet #-} isEmptyVarSet :: VarSet -> Bool -mkVarSet :: [Var] -> VarSet +mkVarSet :: Uniquable a => [a] -> UniqSet a +{-# SPECIALISE mkVarSet :: [Var] -> VarSet #-} lookupVarSet_Directly :: VarSet -> Unique -> Maybe Var lookupVarSet :: VarSet -> Var -> Maybe Var -- Returns the set element, which may be -- (==) to the argument, but not the same as lookupVarSetByName :: VarSet -> Name -> Maybe Var sizeVarSet :: VarSet -> Int -filterVarSet :: (Var -> Bool) -> VarSet -> VarSet +filterVarSet :: Uniquable a => (a -> Bool) -> UniqSet a -> UniqSet a +{-# SPECIALISE filterVarSet :: (Var -> Bool) -> VarSet -> VarSet #-} delVarSetByKey :: VarSet -> Unique -> VarSet elemVarSetByKey :: Unique -> VarSet -> Bool @@ -113,7 +125,8 @@ extendVarSet = addOneToUniqSet extendVarSetList= addListToUniqSet intersectVarSet = intersectUniqSets -intersectsVarSet:: VarSet -> VarSet -> Bool -- True if non-empty intersection +intersectsVarSet:: UniqSet a -> UniqSet a -> Bool -- True if non-empty intersection +{-# SPECIALISE intersectsVarSet :: VarSet -> VarSet -> Bool #-} disjointVarSet :: VarSet -> VarSet -> Bool -- True if empty intersection subVarSet :: VarSet -> VarSet -> Bool -- True if first arg is subset of second -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty; @@ -155,7 +168,8 @@ mapVarSet = mapUniqSet -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. -nonDetStrictFoldVarSet :: (Var -> a -> a) -> a -> VarSet -> a +nonDetStrictFoldVarSet :: (b -> a -> a) -> a -> UniqSet b -> a +{-# SPECIALISE nonDetStrictFoldVarSet :: (Var -> a -> a) -> a -> VarSet -> a #-} nonDetStrictFoldVarSet = nonDetStrictFoldUniqSet fixVarSet :: (VarSet -> VarSet) -- Map the current set to a new set @@ -251,7 +265,7 @@ extendDVarSet = addOneToUniqDSet elemDVarSet :: Var -> DVarSet -> Bool elemDVarSet = elementOfUniqDSet -dVarSetElems :: DVarSet -> [Var] +dVarSetElems :: UniqDSet a -> [a] dVarSetElems = uniqDSetToList subDVarSet :: DVarSet -> DVarSet -> Bool @@ -358,3 +372,10 @@ transCloDVarSet fn seeds | otherwise = go (acc `unionDVarSet` new_vs) new_vs where new_vs = fn candidates `minusDVarSet` acc + +leftsVarSet :: (Uniquable a, Uniquable b) => UniqSet (Either a b) -> UniqSet a +leftsVarSet = mapVarSet (\case Left x -> x; Right _ -> panic "leftsVarSet") . filterVarSet isLeft + +rightsVarSet :: (Uniquable a, Uniquable b) => UniqSet (Either a b) -> UniqSet b +rightsVarSet = mapVarSet (\case Right x -> x; Left _ -> panic "rightsVarSet") . filterVarSet isRight + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7b752c31a0557c8bb097b721d367a325a63f4d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7b752c31a0557c8bb097b721d367a325a63f4d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 28 10:39:37 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 28 May 2023 06:39:37 -0400 Subject: [Git][ghc/ghc][wip/romes/splitting-id] Var like Message-ID: <64732f69a6450_292e25c47c013425b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/splitting-id at Glasgow Haskell Compiler / GHC Commits: a0c117f6 by Rodrigo Mesquita at 2023-05-28T11:39:31+01:00 Var like - - - - - 4 changed files: - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Types/Var/Env.hs - compiler/GHC/Types/Var/Set.hs Changes: ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -283,6 +283,11 @@ runTyCoVars :: Endo TyCoVarSet -> TyCoVarSet {-# INLINE runTyCoVars #-} runTyCoVars f = appEndo f emptyVarSet +runCoVars :: Endo CoVarSet -> CoVarSet +{-# INLINE runCoVars #-} +runCoVars f = appEndo f emptyVarSet + + {- ********************************************************************* * * Deep free variables @@ -430,10 +435,10 @@ coVarsOfTypes :: [Type] -> CoVarSet coVarsOfCo :: Coercion -> CoVarSet coVarsOfCos :: [Coercion] -> CoVarSet -coVarsOfType ty = rightsVarSet $ runTyCoVars (mapVarSet Right <$> deep_cv_ty ty) -coVarsOfTypes tys = rightsVarSet $ runTyCoVars (mapVarSet Right <$> deep_cv_tys tys) -coVarsOfCo co = rightsVarSet $ runTyCoVars (mapVarSet Right <$> deep_cv_co co) -coVarsOfCos cos = rightsVarSet $ runTyCoVars (mapVarSet Right <$> deep_cv_cos cos) +coVarsOfType ty = runCoVars (deep_cv_ty ty) +coVarsOfTypes tys = runCoVars (deep_cv_tys tys) +coVarsOfCo co = runCoVars (deep_cv_co co) +coVarsOfCos cos = runCoVars (deep_cv_cos cos) deep_cv_ty :: Type -> Endo CoVarSet deep_cv_tys :: [Type] -> Endo CoVarSet ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -6,7 +6,7 @@ -} {-# LANGUAGE FlexibleContexts, MultiWayIf, FlexibleInstances, DeriveDataTypeable, - PatternSynonyms, BangPatterns, RecordWildCards, LambdaCase, NamedFieldPuns #-} + PatternSynonyms, BangPatterns, LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} -- | @@ -153,10 +153,10 @@ type NcId = Id -- A term-level (value) variable that is -- predicate: isNonCoVarId -- | Type Variable -type TypeVar = Var -- Definitely a type variable +type TypeVar = TyVar -- Definitely a type variable -- | Kind Variable -type KindVar = Var -- Definitely a kind variable +type KindVar = TyVar -- Definitely a kind variable -- See Note [Kind and type variables] -- See Note [Evidence: EvIds and CoVars] @@ -277,6 +277,48 @@ data Id id_details :: IdDetails, -- Stable, doesn't change id_info :: IdInfo } -- Unstable, updated by simplifier +class VarLike var where + varName :: var -> Name + realUnique :: var -> Int + varType :: var -> Type + +instance VarLike Var where + varName = \case + TV TyVar{varNameTyVar=name} -> name + TTV TcTyVar{varNameTcTyVar=name} -> name + I Id{varNameId=name} -> name + varType = \case + TV TyVar{varTypeTyVar=ty} -> ty + TTV TcTyVar{varTypeTcTyVar=ty} -> ty + I Id{varTypeId=ty} -> ty + realUnique = \case + TV TyVar{realUniqueTyVar=uq} -> uq + TTV TcTyVar{realUniqueTcTyVar=uq} -> uq + I Id{realUniqueId=uq} -> uq + +instance VarLike Id where + varName = varNameId + varType = varTypeId + realUnique = realUniqueId + +instance VarLike TyVar where + varName = varNameTyVar + varType = varTypeTyVar + realUnique = realUniqueTyVar + +instance VarLike TcTyVar where + varName = varNameTcTyVar + varType = varTypeTcTyVar + realUnique = realUniqueTcTyVar + +instance VarLike TyCoVar where + varName (Left v) = varNameTyVar v + varName (Right v) = varNameId v + varType (Left v) = varTypeTyVar v + varType (Right v) = varTypeId v + realUnique (Left v) = realUniqueTyVar v + realUnique (Right v) = realUniqueId v + varTypeTyCoVar :: TyCoVar -> Type varTypeTyCoVar = \case Left v -> varTypeTyVar v @@ -287,21 +329,6 @@ tyCoVarToVar = \case Left x -> TV x Right x -> I x -varName :: Var -> Name -varName = \case - TV TyVar{varNameTyVar} -> varNameTyVar - TTV TcTyVar{varNameTcTyVar} -> varNameTcTyVar - I Id{varNameId} -> varNameId -varType :: Var -> Type -varType = \case - TV TyVar{varTypeTyVar} -> varTypeTyVar - TTV TcTyVar{varTypeTcTyVar} -> varTypeTcTyVar - I Id{varTypeId} -> varTypeId -realUnique :: Var -> Int -realUnique = \case - TV TyVar{realUniqueTyVar} -> realUniqueTyVar - TTV TcTyVar{realUniqueTcTyVar} -> realUniqueTcTyVar - I Id{realUniqueId} -> realUniqueId -- | Identifier Scope data IdScope -- See Note [GlobalId/LocalId] @@ -488,7 +515,7 @@ instance Data TyVar where instance HasOccName Var where occName = nameOccName . varName -varUnique :: Var -> Unique +varUnique :: VarLike var => var -> Unique varUnique var = mkUniqueGrimily (realUnique var) varMultMaybe :: Var -> Maybe Mult ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -506,7 +506,7 @@ mkVarEnv_Directly :: [(Unique, a)] -> VarEnv a zipVarEnv :: [Var] -> [a] -> VarEnv a unitVarEnv :: Var -> a -> VarEnv a alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a -extendVarEnv :: UniqFM var a -> var -> a -> UniqFM var a +extendVarEnv :: Uniquable var => UniqFM var a -> var -> a -> UniqFM var a {-# SPECIALISE extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a #-} extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b @@ -528,7 +528,7 @@ mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a isEmptyVarEnv :: VarEnv a -> Bool -lookupVarEnv :: UniqFM var a -> var -> Maybe a +lookupVarEnv :: Uniquable var => UniqFM var a -> var -> Maybe a {-# SPECIALISE lookupVarEnv :: VarEnv a -> Var -> Maybe a #-} lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a filterVarEnv :: (a -> Bool) -> VarEnv a -> VarEnv a ===================================== compiler/GHC/Types/Var/Set.hs ===================================== @@ -43,8 +43,7 @@ module GHC.Types.Var.Set ( transCloDVarSet, sizeDVarSet, seqDVarSet, partitionDVarSet, - dVarSetToVarSet, - leftsVarSet, rightsVarSet + dVarSetToVarSet ) where import Data.Either @@ -125,9 +124,8 @@ extendVarSet = addOneToUniqSet extendVarSetList= addListToUniqSet intersectVarSet = intersectUniqSets -intersectsVarSet:: UniqSet a -> UniqSet a -> Bool -- True if non-empty intersection -{-# SPECIALISE intersectsVarSet :: VarSet -> VarSet -> Bool #-} -disjointVarSet :: VarSet -> VarSet -> Bool -- True if empty intersection +intersectsVarSet:: UniqSet a -> UniqSet a -> Bool -- True if non-empty intersection +disjointVarSet :: UniqSet a -> UniqSet a -> Bool -- True if empty intersection subVarSet :: VarSet -> VarSet -> Bool -- True if first arg is subset of second -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty; -- ditto disjointVarSet, subVarSet @@ -373,9 +371,3 @@ transCloDVarSet fn seeds where new_vs = fn candidates `minusDVarSet` acc -leftsVarSet :: (Uniquable a, Uniquable b) => UniqSet (Either a b) -> UniqSet a -leftsVarSet = mapVarSet (\case Left x -> x; Right _ -> panic "leftsVarSet") . filterVarSet isLeft - -rightsVarSet :: (Uniquable a, Uniquable b) => UniqSet (Either a b) -> UniqSet b -rightsVarSet = mapVarSet (\case Right x -> x; Left _ -> panic "rightsVarSet") . filterVarSet isRight - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0c117f6a0547cbe685ced99b26be2003e07070b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0c117f6a0547cbe685ced99b26be2003e07070b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 28 18:15:27 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sun, 28 May 2023 14:15:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/generate-addr-ops Message-ID: <64739a3fc5362_292e2514952db01621af@gitlab.mail> Matthew Craven pushed new branch wip/generate-addr-ops at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/generate-addr-ops You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 28 18:18:15 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sun, 28 May 2023 14:18:15 -0400 Subject: [Git][ghc/ghc][wip/generate-addr-ops] Generate Addr# access ops programmatically Message-ID: <64739ae722357_292e251493da50162317@gitlab.mail> Matthew Craven pushed to branch wip/generate-addr-ops at Glasgow Haskell Compiler / GHC Commits: 5d0a4cf8 by Matthew Craven at 2023-05-28T14:17:36-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - 5 changed files: - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - hadrian/src/Rules/Generate.hs - rts/gen_event_types.py Changes: ===================================== compiler/GHC/Builtin/bytearray-ops.txt.pp deleted ===================================== @@ -1,551 +0,0 @@ - ------------------------------------- --- ByteArray# operations ------------------------------------- - - --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp - - ------------------------------------- --- aligned index operations ------------------------------------- - -primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp - ByteArray# -> Int# -> Int8# - {Read a 8-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp - ByteArray# -> Int# -> Word8# - {Read a 8-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with can_fail = True - - ------------------------------------- --- unaligned index operations ------------------------------------- - -primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in bytes.} - with can_fail = True - - ------------------------------------- --- aligned read operations ------------------------------------- - -primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8# #) - {Read a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8# #) - {Read a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned read operations ------------------------------------- - -primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- aligned write operations ------------------------------------- - -primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s - {Write a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s - {Write a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned write operations ------------------------------------- - -primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - ===================================== utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py ===================================== @@ -1,8 +1,34 @@ #!/usr/bin/env python # -*- coding: utf-8 -*- +# This script generates the primop descriptions for many similar ByteArray# +# access operations. Its output is #include-d into primops.txt.pp. + from typing import Optional, NamedTuple import textwrap +import argparse + +msgs = [] + +arg_parser = argparse.ArgumentParser() +arg_parser.add_argument('addr_or_bytearray', + choices = ["addr-access-ops", "bytearray-access-ops"], + ) +arg_parser.add_argument('output_file', + type=argparse.FileType('w'), + metavar='FILE', + ) +args = arg_parser.parse_args() +write = args.output_file.write + + + +write(''' +-- Do not edit. +-- This file is generated by compiler/Builtin/gen_bytearray_addr_access_ops.py. +-- (The build system should take care of this for you.) + +''') class ElementType(NamedTuple): name: str @@ -28,26 +54,13 @@ element_types = [ ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), ] -# TODO: Eventually when the sized integer primops use proper unboxed types we -# should rather do: -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Int{n}", f"Int{n}#", f"{n}-bit signed integer", n // 8) ] -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Word{n}", f"Word{n}#", f"{n}-bit unsigned integer", n // 8) ] - -element_types += [ - ElementType("Int8", "Int8#", "8-bit signed integer", 1), - ElementType("Int16", "Int16#", "16-bit signed integer", 2), - ElementType("Int32", "Int32#", "32-bit signed integer", 4), - ElementType("Int64", "Int64#", "64-bit signed integer", 8), - - ElementType("Word8", "Word8#", "8-bit unsigned integer", 1), - ElementType("Word16", "Word16#", "16-bit unsigned integer", 2), - ElementType("Word32", "Word32#", "32-bit unsigned integer", 4), - ElementType("Word64", "Word64#", "64-bit unsigned integer", 8), -] +for n in [8,16,32,64]: + element_types += [ + ElementType(f"Int{n}", f"Int{n}#", + f"{n}-bit signed integer", n // 8), + ElementType(f"Word{n}", f"Word{n}#", + f"{n}-bit unsigned integer", n // 8) + ] def pretty_offset(n: Optional[int]) -> str: if n == MACH_WORD: @@ -57,87 +70,134 @@ def pretty_offset(n: Optional[int]) -> str: else: return f'{n}-byte words' +def get_align_warn(n: ElementType) -> str: + if n.width == 1: + return '' + return ''' + On some platforms, the access may fail + for an insufficiently aligned @Addr#@. + ''' + def print_block(template: str, **kwargs) -> None: - print(textwrap.dedent(template.format(**kwargs)).lstrip()) + write(textwrap.dedent(template.format(**kwargs)).lstrip()) + write('\n') def header(s: str): - print('') + write('\n') print_block(''' ------------------------------------ -- {s} ------------------------------------ ''', s=s) +if args.addr_or_bytearray == "bytearray-access-ops": + header("ByteArray# operations") -header("ByteArray# operations") - -print(''' --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp -''') - -header('aligned index operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in {offset}.}} with can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned index operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned index operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in bytes.}} with can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned read operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned read operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned read operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned write operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned write operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned write operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) + + +else: # addr_or_bytearray == "addr-access-ops": + header("Addr# access operations") + + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} -> State# s -> State# s + {{ Write a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1941,7 +1941,7 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-ops.txt.pp" +#include "bytearray-access-ops.txt.pp" primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2242,233 +2242,7 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 31-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# - with can_fail = True - -primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# - with can_fail = True - -primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# - with can_fail = True - -primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a - with can_fail = True - -primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# - with can_fail = True - -primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# - with can_fail = True - -primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# - with can_fail = True - -primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# - with can_fail = True - -primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# - with can_fail = True - -primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# - with can_fail = True - -primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# - with can_fail = True - -primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# - with can_fail = True - -primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True +#include "addr-access-ops.txt.pp" primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -32,6 +32,17 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" +accessOpsSource :: FilePath +accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" + +byteArrayAccessOpsTxt :: Stage -> FilePath +byteArrayAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" + +addrAccessOpsTxt :: Stage -> FilePath +addrAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" + isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -142,8 +153,21 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do + let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage + let addr_ops_txt = root -/- addrAccessOpsTxt stage + ba_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "bytearray-access-ops", file] + [] [] + addr_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "addr-access-ops", file] + [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource] + need $ [primopsSource, ba_ops_txt, addr_ops_txt] + -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== rts/gen_event_types.py ===================================== @@ -157,7 +157,7 @@ def generate_event_types_array() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('EventType eventTypes[] = {') @@ -184,7 +184,7 @@ def generate_event_types_defines() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('#pragma once') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d0a4cf87bfa3e7c9ab2866015c04e137a7f6347 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d0a4cf87bfa3e7c9ab2866015c04e137a7f6347 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 28 21:37:56 2023 From: gitlab at gitlab.haskell.org (Andrey Mokhov (@snowleopard)) Date: Sun, 28 May 2023 17:37:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-fix-multiline-synopsis Message-ID: <6473c9b42dad7_292e2514952dc418865a@gitlab.mail> Andrey Mokhov pushed new branch wip/hadrian-fix-multiline-synopsis at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-fix-multiline-synopsis You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun May 28 23:42:28 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sun, 28 May 2023 19:42:28 -0400 Subject: [Git][ghc/ghc][wip/generate-addr-ops] Generate Addr# access ops programmatically Message-ID: <6473e6e47eca8_292e251795015c1941fb@gitlab.mail> Matthew Craven pushed to branch wip/generate-addr-ops at Glasgow Haskell Compiler / GHC Commits: ccd16843 by Matthew Craven at 2023-05-28T19:42:00-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - 5 changed files: - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - hadrian/src/Rules/Generate.hs - rts/gen_event_types.py Changes: ===================================== compiler/GHC/Builtin/bytearray-ops.txt.pp deleted ===================================== @@ -1,551 +0,0 @@ - ------------------------------------- --- ByteArray# operations ------------------------------------- - - --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp - - ------------------------------------- --- aligned index operations ------------------------------------- - -primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp - ByteArray# -> Int# -> Int8# - {Read a 8-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp - ByteArray# -> Int# -> Word8# - {Read a 8-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with can_fail = True - - ------------------------------------- --- unaligned index operations ------------------------------------- - -primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in bytes.} - with can_fail = True - - ------------------------------------- --- aligned read operations ------------------------------------- - -primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8# #) - {Read a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8# #) - {Read a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned read operations ------------------------------------- - -primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- aligned write operations ------------------------------------- - -primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s - {Write a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s - {Write a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned write operations ------------------------------------- - -primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - ===================================== utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py ===================================== @@ -1,8 +1,34 @@ #!/usr/bin/env python # -*- coding: utf-8 -*- +# This script generates the primop descriptions for many similar ByteArray# +# and Addr# access operations. Its output is #include-d into primops.txt.pp. + from typing import Optional, NamedTuple import textwrap +import argparse + +msgs = [] + +arg_parser = argparse.ArgumentParser() +arg_parser.add_argument('addr_or_bytearray', + choices = ["addr-access-ops", "bytearray-access-ops"], + ) +arg_parser.add_argument('output_file', + type=argparse.FileType('w'), + metavar='FILE', + ) +args = arg_parser.parse_args() +write = args.output_file.write + + + +write(''' +-- Do not edit. +-- This file is generated by compiler/Builtin/gen_bytearray_addr_access_ops.py. +-- (The build system should take care of this for you.) + +''') class ElementType(NamedTuple): name: str @@ -28,26 +54,13 @@ element_types = [ ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), ] -# TODO: Eventually when the sized integer primops use proper unboxed types we -# should rather do: -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Int{n}", f"Int{n}#", f"{n}-bit signed integer", n // 8) ] -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Word{n}", f"Word{n}#", f"{n}-bit unsigned integer", n // 8) ] - -element_types += [ - ElementType("Int8", "Int8#", "8-bit signed integer", 1), - ElementType("Int16", "Int16#", "16-bit signed integer", 2), - ElementType("Int32", "Int32#", "32-bit signed integer", 4), - ElementType("Int64", "Int64#", "64-bit signed integer", 8), - - ElementType("Word8", "Word8#", "8-bit unsigned integer", 1), - ElementType("Word16", "Word16#", "16-bit unsigned integer", 2), - ElementType("Word32", "Word32#", "32-bit unsigned integer", 4), - ElementType("Word64", "Word64#", "64-bit unsigned integer", 8), -] +for n in [8,16,32,64]: + element_types += [ + ElementType(f"Int{n}", f"Int{n}#", + f"{n}-bit signed integer", n // 8), + ElementType(f"Word{n}", f"Word{n}#", + f"{n}-bit unsigned integer", n // 8) + ] def pretty_offset(n: Optional[int]) -> str: if n == MACH_WORD: @@ -57,87 +70,134 @@ def pretty_offset(n: Optional[int]) -> str: else: return f'{n}-byte words' +def get_align_warn(n: ElementType) -> str: + if n.width == 1: + return '' + return ''' + On some platforms, the access may fail + for an insufficiently aligned @Addr#@. + ''' + def print_block(template: str, **kwargs) -> None: - print(textwrap.dedent(template.format(**kwargs)).lstrip()) + write(textwrap.dedent(template.format(**kwargs)).lstrip()) + write('\n') def header(s: str): - print('') + write('\n') print_block(''' ------------------------------------ -- {s} ------------------------------------ ''', s=s) +if args.addr_or_bytearray == "bytearray-access-ops": + header("ByteArray# operations") -header("ByteArray# operations") - -print(''' --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp -''') - -header('aligned index operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in {offset}.}} with can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned index operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned index operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in bytes.}} with can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned read operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned read operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned read operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned write operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned write operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned write operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) + + +else: # addr_or_bytearray == "addr-access-ops": + header("Addr# access operations") + + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} -> State# s -> State# s + {{ Write a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1941,7 +1941,7 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-ops.txt.pp" +#include "bytearray-access-ops.txt.pp" primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2242,233 +2242,7 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 31-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# - with can_fail = True - -primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# - with can_fail = True - -primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# - with can_fail = True - -primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a - with can_fail = True - -primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# - with can_fail = True - -primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# - with can_fail = True - -primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# - with can_fail = True - -primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# - with can_fail = True - -primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# - with can_fail = True - -primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# - with can_fail = True - -primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# - with can_fail = True - -primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# - with can_fail = True - -primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True +#include "addr-access-ops.txt.pp" primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -32,6 +32,17 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" +accessOpsSource :: FilePath +accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" + +byteArrayAccessOpsTxt :: Stage -> FilePath +byteArrayAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" + +addrAccessOpsTxt :: Stage -> FilePath +addrAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" + isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -142,8 +153,21 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do + let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage + let addr_ops_txt = root -/- addrAccessOpsTxt stage + ba_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "bytearray-access-ops", file] + [] [] + addr_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "addr-access-ops", file] + [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource] + need $ [primopsSource, ba_ops_txt, addr_ops_txt] + -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== rts/gen_event_types.py ===================================== @@ -157,7 +157,7 @@ def generate_event_types_array() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('EventType eventTypes[] = {') @@ -184,7 +184,7 @@ def generate_event_types_defines() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('#pragma once') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccd168439df6c49549ab429c082656438fe3b8ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccd168439df6c49549ab429c082656438fe3b8ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 05:25:22 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 29 May 2023 01:25:22 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 53 commits: NCG: remove useless .align directive (#20758) Message-ID: <647437421e403_292e251493da502090ce@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 8331bf94 by Ben Gamari at 2023-05-29T09:24:22+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d89cfd2d61a8517116b4d050a2894230fd5cab3e...8331bf9473b123f499f95620dca239aee8da9895 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d89cfd2d61a8517116b4d050a2894230fd5cab3e...8331bf9473b123f499f95620dca239aee8da9895 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 05:27:20 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 29 May 2023 01:27:20 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <647437b8cd759_292e251493da3c209889@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 97b245a6 by Ben Gamari at 2023-05-29T09:27:06+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - + docs/users_guide/exts/implicit_forall.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/exts/type_signatures.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.hs - + testsuite/tests/rename/should_fail/RnNoImplicitForAll.stderr - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/97b245a6cfee3bcc663d4fcd991df735969cec97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/97b245a6cfee3bcc663d4fcd991df735969cec97 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 09:00:35 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 29 May 2023 05:00:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/#23434-wterm-variable-capture Message-ID: <647469b31a561_2f379c2c54232f6@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/#23434-wterm-variable-capture at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/%2323434-wterm-variable-capture You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 11:00:42 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 29 May 2023 07:00:42 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 2 commits: Fix -Wterm-variable-capture scope (#23434) Message-ID: <647485da7b404_2f379c2c0439547@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 0009b5ae by Andrei Borzenkov at 2023-05-29T12:47:16+04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - a47e341d by Andrei Borzenkov at 2023-05-29T15:00:08+04:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - + docs/users_guide/exts/implicit_forall.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/exts/type_signatures.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_compile/T22513a.stderr - testsuite/tests/rename/should_compile/T22513b.stderr - testsuite/tests/rename/should_compile/T22513c.stderr - testsuite/tests/rename/should_compile/T22513d.stderr - testsuite/tests/rename/should_compile/T22513e.stderr - testsuite/tests/rename/should_compile/T22513f.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97b245a6cfee3bcc663d4fcd991df735969cec97...a47e341d524a104c6f81260bf478bbc4c9ec52a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97b245a6cfee3bcc663d4fcd991df735969cec97...a47e341d524a104c6f81260bf478bbc4c9ec52a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 11:07:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 07:07:49 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <6474878510e14_2f379c2d3044462@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 234464c6 by Rodrigo Mesquita at 2023-05-29T12:05:43+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +96,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,17 +60,40 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run a preprocessing command, be it either the HsCpp or Cpp. +-- This is the common implementation to 'runCpp' and 'runHsCpp'. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +run_some_cpp :: Logger + -> DynFlags + -> String + -- ^ A short description of the preprocessor being run + -> (DynFlags -> (String, [Option])) + -- ^ Field accessor to get the preprocessor program and configured flags + -> [Option] + -- ^ Additional arguments to pass to the preprocessor + -> IO () +run_some_cpp logger dflags desc getPgm args1 = do + let (p,args0) = getPgm dflags + mb_env <- getGccEnv args2 + runSomethingFiltered logger id desc p + (args0 ++ args1) Nothing mb_env + +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports +runCpp logger dflags args = traceSystoolCommand logger "cpp" $ + run_some_cpp logger dflags "C pre-processor" pgm_cpp args + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ + let optPs = getOpts dflags opt_P + args1 = map Option (augmentImports dflags optPs) args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + in run_some_cpp logger dflags "Haskell C pre-processor" pgm_P (args1 ++ args2 ++ args) runPp :: Logger -> DynFlags -> [Option] -> IO () runPp logger dflags args = traceSystoolCommand logger "pp" $ do ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/234464c632f4bca516d79112b7d88e5c4a86687f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/234464c632f4bca516d79112b7d88e5c4a86687f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 11:14:15 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 07:14:15 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <64748907dc0fb_2f379c2c7c4682e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 04687408 by Rodrigo Mesquita at 2023-05-29T12:14:01+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +96,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,16 +60,28 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts + let (p,args0) = pgm_cpp dflags + args1 = args0 ++ args + mb_env <- getGccEnv args0 + runSomethingFiltered logger id "C pre-processor" p + args1 Nothing mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do let (p,args0) = pgm_P dflags - args1 = map Option modified_imports + optPs = getOpts dflags opt_P + args1 = map Option (augmentImports dflags optPs) args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p + runSomethingFiltered logger id "Haskell C pre-processor" p (args0 ++ args1 ++ args2 ++ args) Nothing mb_env runPp :: Logger -> DynFlags -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/046874083ad7ab8a7b040b0b9afb24792b5ed7db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/046874083ad7ab8a7b040b0b9afb24792b5ed7db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 11:19:15 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 07:19:15 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <64748a3323c37_2f379c2c2c531a1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 2e3a5c29 by Rodrigo Mesquita at 2023-05-29T12:19:01+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +96,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,16 +60,29 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts + let (p,args0) = pgm_cpp dflags + args1 = args0 ++ args + mb_env <- getGccEnv args1 + runSomethingFiltered logger id "C pre-processor" p + args1 Nothing mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do let (p,args0) = pgm_P dflags - args1 = map Option modified_imports + opts = getOpts dflags opt_P + modifiedImports = augmentImports dflags opts + args1 = map Option modifiedImports args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p + mb_env <- getGccEnv args2 -- romes: what about args0 and args? + runSomethingFiltered logger id "Haskell C pre-processor" p (args0 ++ args1 ++ args2 ++ args) Nothing mb_env runPp :: Logger -> DynFlags -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e3a5c29d11f76d22e1efea3b3690ecd9e3c5a95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e3a5c29d11f76d22e1efea3b3690ecd9e3c5a95 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 11:20:20 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 07:20:20 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <64748a74e8164_2f379c2c7c53561@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 26294d9c by Rodrigo Mesquita at 2023-05-29T12:20:08+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +96,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,16 +60,29 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts + let (p,args0) = pgm_cpp dflags + args1 = args0 ++ args + mb_env <- getGccEnv args1 + runSomethingFiltered logger id "C pre-processor" p + args1 Nothing mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do let (p,args0) = pgm_P dflags + opts = getOpts dflags opt_P + modified_imports = augmentImports dflags opts args1 = map Option modified_imports args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p + mb_env <- getGccEnv args2 -- romes: what about args0 and args? + runSomethingFiltered logger id "Haskell C pre-processor" p (args0 ++ args1 ++ args2 ++ args) Nothing mb_env runPp :: Logger -> DynFlags -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26294d9cbeaf7d03732bbcb11f987f5d90403541 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26294d9cbeaf7d03732bbcb11f987f5d90403541 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 11:22:00 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 07:22:00 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <64748ad8ca5eb_2f379c2c2c539e5@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: e22922e5 by Rodrigo Mesquita at 2023-05-29T12:21:40+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +96,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,16 +60,29 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts + let (p,args0) = pgm_cpp dflags + args1 = args0 ++ args + mb_env <- getGccEnv args1 + runSomethingFiltered logger id "C pre-processor" p + args1 Nothing mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do let (p,args0) = pgm_P dflags + opts = getOpts dflags opt_P + modified_imports = augmentImports dflags opts args1 = map Option modified_imports args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p + mb_env <- getGccEnv args2 -- romes: what about args0 and args? + runSomethingFiltered logger id "Haskell C pre-processor" p (args0 ++ args1 ++ args2 ++ args) Nothing mb_env runPp :: Logger -> DynFlags -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e22922e553859a9702dadac21361bb197fd76a14 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e22922e553859a9702dadac21361bb197fd76a14 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 11:35:06 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 07:35:06 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <64748deac11_2f379206ad7c5435c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 0f2495a8 by Rodrigo Mesquita at 2023-05-29T12:34:51+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,8 +96,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args | otherwise = GHC.SysTools.runCpp logger dflags args let platform = targetPlatform dflags ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,16 +60,30 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp runCpp :: Logger -> DynFlags -> [Option] -> IO () runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts + let (p,args0) = pgm_cpp dflags + userOpts_c = map Option $ getOpts dflags opt_c + args2 = args0 ++ args ++ userOpts_c + mb_env <- getGccEnv args2 + runSomethingFiltered logger id "C pre-processor" p + args2 Nothing mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do let (p,args0) = pgm_P dflags + opts = getOpts dflags opt_P + modified_imports = augmentImports dflags opts args1 = map Option modified_imports args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p + mb_env <- getGccEnv args2 -- romes: what about args0 and args? + runSomethingFiltered logger id "Haskell C pre-processor" p (args0 ++ args1 ++ args2 ++ args) Nothing mb_env runPp :: Logger -> DynFlags -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f2495a856f4b970d11f2a23679cff7b79ac88e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f2495a856f4b970d11f2a23679cff7b79ac88e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 11:49:08 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 29 May 2023 07:49:08 -0400 Subject: [Git][ghc/ghc][wip/int-index/tok-where] WIP: LHsToken for newtype/data and where in DataDecl Message-ID: <647491346dbe6_2f379c2cf4612dd@gitlab.mail> Andrei Borzenkov pushed to branch wip/int-index/tok-where at Glasgow Haskell Compiler / GHC Commits: 4915acc0 by Andrei Borzenkov at 2023-01-16T17:00:35+04:00 WIP: LHsToken for newtype/data and where in DataDecl - - - - - 17 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Decls.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/printer/T18791.stderr - utils/check-exact/ExactPrint.hs - utils/haddock Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Hs.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, - NewOrData, newOrDataToFlavour, anyLConIsGadt, + NewOrData, NewOrDataToken(..), newOrDataToFlavour, anyLConIsGadt, StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName, -- ** Class or type declarations @@ -132,6 +132,7 @@ import GHC.Data.Maybe import Data.Data (Data) import Data.Foldable (toList) import qualified GHC.Data.Strict as Strict +import Data.Functor (($>)) {- ************************************************************************ @@ -440,9 +441,9 @@ instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where pp_vanilla_decl_head ltycon tyvars fixity Nothing <+> equals) 4 (ppr rhs) - ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity + ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity, tcdTkWhere = tkWhere , tcdDataDefn = defn }) - = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn + = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn (tkWhere $> ()) ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, tcdFixity = fixity, @@ -715,12 +716,15 @@ ppDataDefnHeader pp_hdr HsDataDefn pp_data_defn :: (OutputableBndrId p) => (Maybe (LHsContext (GhcPass p)) -> SDoc) -- Printing the header -> HsDataDefn (GhcPass p) + -> Strict.Maybe () -> SDoc pp_data_defn pp_hdr defn at HsDataDefn { dd_cons = condecls , dd_derivs = derivings } + tkWhere | null condecls - = ppDataDefnHeader pp_hdr defn <+> pp_derivings derivings + , let tkWhere' = case tkWhere of Strict.Nothing -> empty; _ -> text "where" + = ppDataDefnHeader pp_hdr defn <+> tkWhere' <+> pp_derivings derivings | otherwise = hang (ppDataDefnHeader pp_hdr defn) 2 (pp_condecls (toList condecls) $$ pp_derivings derivings) @@ -729,7 +733,7 @@ pp_data_defn pp_hdr defn at HsDataDefn instance OutputableBndrId p => Outputable (HsDataDefn (GhcPass p)) where - ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d + ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d Strict.Nothing instance OutputableBndrId p => Outputable (StandaloneKindSig (GhcPass p)) where @@ -856,7 +860,7 @@ pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = , feqn_pats = pats , feqn_fixity = fixity , feqn_rhs = defn })}) - = pp_data_defn pp_hdr defn + = pp_data_defn pp_hdr defn Strict.Nothing where pp_hdr mctxt = ppr_instance_keyword top_lvl <+> pprHsFamInstLHS tycon bndrs pats fixity mctxt @@ -945,6 +949,9 @@ instance Outputable NewOrData where ppr NewType = text "newtype" ppr DataType = text "data" +instance Outputable (NewOrDataToken a) where + ppr = ppr . tokenNewOrData + -- At the moment we only call this with @f = '[]'@ and @f = 'DataDefnCons'@. anyLConIsGadt :: Foldable f => f (GenLocated l (ConDecl pass)) -> Bool anyLConIsGadt xs = case toList xs of ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -131,6 +131,11 @@ deriving instance Data (TyClDecl GhcPs) deriving instance Data (TyClDecl GhcRn) deriving instance Data (TyClDecl GhcTc) +-- deriving instance (DataIdLR p p) => Data (NewOrDataToken p) +deriving instance Data (NewOrDataToken GhcPs) +deriving instance Data (NewOrDataToken GhcRn) +deriving instance Data (NewOrDataToken GhcTc) + -- deriving instance (DataIdLR p p) => Data (FunDep p) deriving instance Data (FunDep GhcPs) deriving instance Data (FunDep GhcRn) ===================================== compiler/GHC/Parser.y ===================================== @@ -1283,7 +1283,7 @@ ty_decl :: { LTyClDecl GhcPs } -- ordinary data type or newtype declaration | type_data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings {% mkTyData (comb4 $1 $3 $4 $5) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3 - Nothing (reverse (snd $ unLoc $4)) + Nothing (snd $ unLoc $4) (fmap reverse $5) ((fstOf3 $ unLoc $1):(fst $ unLoc $4)) } -- We need the location on tycl_hdr in case @@ -1345,7 +1345,7 @@ inst_decl :: { LInstDecl GhcPs } | data_or_newtype 'instance' capi_ctype datafam_inst_hdr constrs maybe_derivings {% mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4) - Nothing (reverse (snd $ unLoc $5)) + Nothing (snd $ unLoc $5) (fmap reverse $6) ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) } @@ -1507,7 +1507,7 @@ at_decl_inst :: { LInstDecl GhcPs } -- data/newtype instance declaration, with optional 'instance' keyword | data_or_newtype opt_instance capi_ctype datafam_inst_hdr constrs maybe_derivings {% mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4) - Nothing (reverse (snd $ unLoc $5)) + Nothing (snd $ unLoc $5) (fmap reverse $6) ((fst $ unLoc $1):$2++(fst $ unLoc $5)) } @@ -1520,14 +1520,14 @@ at_decl_inst :: { LInstDecl GhcPs } (fmap reverse $7) ((fst $ unLoc $1):$2++(fst $ unLoc $5)++(fst $ unLoc $6)) } -type_data_or_newtype :: { Located (AddEpAnn, Bool, NewOrData) } - : 'data' { sL1 $1 (mj AnnData $1,False,DataType) } - | 'newtype' { sL1 $1 (mj AnnNewtype $1,False,NewType) } - | 'type' 'data' { sL1 $1 (mj AnnData $1,True ,DataType) } +type_data_or_newtype :: { Located (AddEpAnn, Bool, NewOrDataToken GhcPs) } + : 'data' { sL1 $1 (mj AnnData $1,False,DataTypeToken (hsTok $1)) } + | 'newtype' { sL1 $1 (mj AnnNewtype $1,False,NewTypeToken (hsTok $1)) } + | 'type' 'data' { sL1 $1 (mj AnnData $1,True ,DataTypeToken (hsTok $2)) } -data_or_newtype :: { Located (AddEpAnn, NewOrData) } - : 'data' { sL1 $1 (mj AnnData $1,DataType) } - | 'newtype' { sL1 $1 (mj AnnNewtype $1,NewType) } +data_or_newtype :: { Located (AddEpAnn, NewOrDataToken GhcPs) } + : 'data' { sL1 $1 (mj AnnData $1,DataTypeToken (hsTok $1)) } + | 'newtype' { sL1 $1 (mj AnnNewtype $1,NewTypeToken (hsTok $1)) } -- Family result/return kind signatures @@ -2364,19 +2364,23 @@ And both become a HsTyVar ("Zero", DataName) after the renamer. -- Datatype declarations gadt_constrlist :: { Located ([AddEpAnn] - ,[LConDecl GhcPs]) } -- Returned in order + , PsDataWhereClause) } : 'where' '{' gadt_constrs '}' {% checkEmptyGADTs $ L (comb2 $1 $3) ([mj AnnWhere $1 ,moc $2 ,mcc $4] - , unLoc $3) } + , PsDataWhereClause + (Strict.Just (hsTok $1)) + (unLoc $3)) } | 'where' vocurly gadt_constrs close {% checkEmptyGADTs $ L (comb2 $1 $3) ([mj AnnWhere $1] - , unLoc $3) } - | {- empty -} { noLoc ([],[]) } + , PsDataWhereClause + (Strict.Just (hsTok $1)) + (unLoc $3)) } + | {- empty -} { noLoc ([],PsDataWhereClause Strict.Nothing []) } gadt_constrs :: { Located [LConDecl GhcPs] } : gadt_constr ';' gadt_constrs @@ -2410,8 +2414,8 @@ consequence, GADT constructor names are restricted (names like '(*)' are allowed in usual data constructors, but not in GADTs). -} -constrs :: { Located ([AddEpAnn],[LConDecl GhcPs]) } - : '=' constrs1 { sLL $1 $2 ([mj AnnEqual $1],unLoc $2)} +constrs :: { Located ([AddEpAnn],PsDataWhereClause) } + : '=' constrs1 { sLL $1 $2 ([mj AnnEqual $1],PsDataWhereClause Strict.Nothing (reverse $ unLoc $2))} constrs1 :: { Located [LConDecl GhcPs] } : constrs1 '|' constr ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -23,7 +23,7 @@ module GHC.Parser.PostProcess ( mkHsDo, mkSpliceDecl, mkRoleAnnotDecl, PsClassWhereClause(..), mkClassDecl, - mkTyData, mkDataFamInst, + PsDataWhereClause(..), mkTyData, mkDataFamInst, mkTySynonym, mkTyFamInstEqn, mkStandaloneKindSig, mkTyFamInst, @@ -228,18 +228,24 @@ mkClassDecl loc' tkClass (L _ (mcxt, tycl_hdr)) fds pcwc annsIn , tcdATs = ats, tcdATDefs = at_defs , tcdDocs = docs })) } +data PsDataWhereClause = + PsDataWhereClause { + pdwcTkWhere :: !(Strict.Maybe (LHsToken "where" GhcPs)), + pdkwDecls :: ![LConDecl GhcPs] -- Returned in order + } + mkTyData :: SrcSpan -> Bool - -> NewOrData + -> NewOrDataToken GhcPs -> Maybe (LocatedP CType) -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) -> Maybe (LHsKind GhcPs) - -> [LConDecl GhcPs] + -> PsDataWhereClause -> Located (HsDeriving GhcPs) -> [AddEpAnn] -> P (LTyClDecl GhcPs) mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr)) - ksig data_cons (L _ maybe_deriv) annsIn + ksig (PsDataWhereClause tkWhere data_cons) (L _ maybe_deriv) annsIn = do { let loc = noAnnSrcSpan loc' ; (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; tyvars <- checkTyVars (ppr new_or_data) equalsDots tc tparams @@ -248,8 +254,10 @@ mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr)) ; data_cons <- checkNewOrData (locA loc) (unLoc tc) is_type_data new_or_data data_cons ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv ; return (L loc (DataDecl { tcdDExt = anns', + tcdTkNewOrData = new_or_data, tcdLName = tc, tcdTyVars = tyvars, tcdFixity = fixity, + tcdTkWhere = tkWhere, tcdDataDefn = defn })) } mkDataDefn :: Maybe (LocatedP CType) @@ -327,17 +335,17 @@ mkTyFamInstEqn loc bndrs lhs rhs anns , feqn_rhs = rhs })} mkDataFamInst :: SrcSpan - -> NewOrData + -> NewOrDataToken GhcPs -> Maybe (LocatedP CType) -> (Maybe ( LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs , LHsType GhcPs) -> Maybe (LHsKind GhcPs) - -> [LConDecl GhcPs] + -> PsDataWhereClause -> Located (HsDeriving GhcPs) -> [AddEpAnn] -> P (LInstDecl GhcPs) mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr) - ksig data_cons (L _ maybe_deriv) anns + ksig (PsDataWhereClause _ data_cons) (L _ maybe_deriv) anns = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; cs <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan ; let fam_eqn_ans = addAnns (EpAnn (spanAsAnchor loc) ann cs) anns emptyComments @@ -992,9 +1000,9 @@ checkRecordSyntax lr@(L loc r) -- | Check if the gadt_constrlist is empty. Only raise parse error for -- `data T where` to avoid affecting existing error message, see #8258. -checkEmptyGADTs :: Located ([AddEpAnn], [LConDecl GhcPs]) - -> P (Located ([AddEpAnn], [LConDecl GhcPs])) -checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration. +checkEmptyGADTs :: Located ([AddEpAnn], PsDataWhereClause) + -> P (Located ([AddEpAnn], PsDataWhereClause)) +checkEmptyGADTs gadts@(L span (_, PsDataWhereClause _ [])) -- Empty GADT declaration. = do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax unless gadtSyntax $ addError $ mkPlainErrorMsgEnvelope span $ PsErrIllegalWhereInDataDecl @@ -2633,12 +2641,12 @@ mkOpaquePragma src , inl_rule = FunLike } -checkNewOrData :: SrcSpan -> RdrName -> Bool -> NewOrData -> [LConDecl GhcPs] +checkNewOrData :: SrcSpan -> RdrName -> Bool -> NewOrDataToken GhcPs -> [LConDecl GhcPs] -> P (DataDefnCons (LConDecl GhcPs)) checkNewOrData span name is_type_data = curry $ \ case - (NewType, [a]) -> pure $ NewTypeCon a - (DataType, as) -> pure $ DataTypeCons is_type_data (handle_type_data as) - (NewType, as) -> addFatalError $ mkPlainErrorMsgEnvelope span $ PsErrMultipleConForNewtype name (length as) + (NewTypeToken{}, [a]) -> pure $ NewTypeCon a + (DataTypeToken{}, as) -> pure $ DataTypeCons is_type_data (handle_type_data as) + (NewTypeToken{}, as) -> addFatalError $ mkPlainErrorMsgEnvelope span $ PsErrMultipleConForNewtype name (length as) where -- In a "type data" declaration, the constructors are in the type/class -- namespace rather than the data constructor namespace. ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -479,14 +479,15 @@ instance HasHaddock (HsDecl GhcPs) where -- deriving newtype (Ord {- ^ Comment on Ord N -}) -- addHaddock (TyClD x decl) - | DataDecl { tcdDExt, tcdLName, tcdTyVars, tcdFixity, tcdDataDefn = defn } <- decl + | DataDecl { tcdDExt, tcdTkNewOrData, tcdLName, tcdTyVars, tcdFixity, tcdTkWhere, tcdDataDefn = defn } <- decl = do registerHdkA tcdLName defn' <- addHaddock defn pure $ TyClD x (DataDecl { tcdDExt, - tcdLName, tcdTyVars, tcdFixity, + tcdTkNewOrData, + tcdLName, tcdTyVars, tcdFixity, tcdTkWhere, tcdDataDefn = defn' }) -- Class declarations: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1819,13 +1819,16 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, -- "data", "newtype" declarations rnTyClDecl (DataDecl - { tcdLName = tycon, tcdTyVars = tyvars, + { tcdTkNewOrData = tkNewOrData, + tcdLName = tycon, tcdTyVars = tyvars, tcdFixity = fixity, + tcdTkWhere = tkWhere, tcdDataDefn = defn at HsDataDefn{ dd_cons = cons, dd_kindSig = kind_sig} }) = do { tycon' <- lookupLocatedTopConstructorRnN tycon ; let kvs = extractDataDefnKindVars defn doc = TyDataCtx tycon new_or_data = dataDefnConsNewOrData cons + tkNewOrData' = rnNewOrDataToken tkNewOrData ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn @@ -1833,11 +1836,13 @@ rnTyClDecl (DataDecl ; let rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) - ; return (DataDecl { tcdLName = tycon' - , tcdTyVars = tyvars' - , tcdFixity = fixity - , tcdDataDefn = defn' - , tcdDExt = rn_info }, fvs) } } + ; return (DataDecl { tcdTkNewOrData = (tkNewOrData' :: NewOrDataToken GhcRn) + , tcdLName = tycon' + , tcdTyVars = tyvars' + , tcdFixity = fixity + , tcdTkWhere = tkWhere + , tcdDataDefn = defn' + , tcdDExt = rn_info }, fvs) } } rnTyClDecl (ClassDecl { tcdLayout = layout, tcdTkClass = tkClass, @@ -1915,6 +1920,10 @@ rnLayoutInfo (ExplicitBraces ob cb) = ExplicitBraces ob cb rnLayoutInfo (VirtualBraces n) = VirtualBraces n rnLayoutInfo NoLayoutInfo = NoLayoutInfo +rnNewOrDataToken :: NewOrDataToken GhcPs -> NewOrDataToken GhcRn +rnNewOrDataToken (NewTypeToken a) = NewTypeToken a +rnNewOrDataToken (DataTypeToken a) = DataTypeToken a + -- Does the data type declaration include a CUSK? data_decl_has_cusk :: LHsQTyVars (GhcPass p) -> NewOrData -> Bool -> Maybe (LHsKind (GhcPass p')) -> RnM Bool data_decl_has_cusk tyvars new_or_data no_rhs_kvs kind_sig = do ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -286,8 +286,10 @@ cvtDec (NewtypeD ctxt tc tvs ksig constr derivs) , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn + , tcdTkNewOrData = NewTypeToken noHsTok , tcdLName = tc', tcdTyVars = tvs' , tcdFixity = Prefix + , tcdTkWhere = Strict.Nothing , tcdDataDefn = defn } } cvtDec (TypeDataD tc tvs ksig constrs) @@ -516,8 +518,10 @@ cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn + , tcdTkNewOrData = DataTypeToken noHsTok , tcdLName = tc', tcdTyVars = tvs' , tcdFixity = Prefix + , tcdTkWhere = Strict.Nothing , tcdDataDefn = defn } } ---------------- ===================================== compiler/Language/Haskell/Syntax/Decls.hs ===================================== @@ -29,6 +29,7 @@ module Language.Haskell.Syntax.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..), HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, + NewOrDataToken(..), tokenNewOrData, NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData, isTypeDataDefnCons, StandaloneKindSig(..), LStandaloneKindSig, @@ -441,12 +442,14 @@ data TyClDecl pass -- 'GHC.Parser.Annotation.AnnWhere', -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - DataDecl { tcdDExt :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs - , tcdLName :: LIdP pass -- ^ Type constructor - , tcdTyVars :: LHsQTyVars pass -- ^ Type variables - -- See Note [TyVar binders for associated decls] - , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration - , tcdDataDefn :: HsDataDefn pass } + DataDecl { tcdDExt :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs + , tcdTkNewOrData :: !(NewOrDataToken pass) -- ^ "newtype" or "data" token + , tcdLName :: LIdP pass -- ^ Type constructor + , tcdTyVars :: LHsQTyVars pass -- ^ Type variables + -- See Note [TyVar binders for associated decls] + , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration + , tcdTkWhere :: !(Strict.Maybe (LHsToken "where" pass)) -- ^ The "where" token + , tcdDataDefn :: HsDataDefn pass } -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnClass', -- 'GHC.Parser.Annotation.AnnWhere','GHC.Parser.Annotation.AnnOpen', @@ -995,6 +998,16 @@ data NewOrData | DataType -- ^ @data Blah ...@ deriving ( Eq, Data ) -- Needed because Demand derives Eq +-- type role NewOrDataToken representational +-- | Same as `NewOrData`, but with additional location info +data NewOrDataToken pass + = NewTypeToken !(LHsToken "newtype" pass) -- ^ @newtype Blah ...@ + | DataTypeToken !(LHsToken "data" pass) -- ^ @data Blah ...@ + +tokenNewOrData :: NewOrDataToken pass -> NewOrData +tokenNewOrData NewTypeToken{} = NewType +tokenNewOrData DataTypeToken{} = DataType + -- | Whether a data-type declaration is @data@ or @newtype@, and its constructors. data DataDefnCons a = NewTypeCon -- @newtype N x = MkN blah@ ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr ===================================== @@ -78,6 +78,11 @@ ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:16:3-7 }))] (EpaComments [])) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { T17544_kw.hs:15:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:15:6-8 }) (Unqual @@ -86,6 +91,11 @@ (NoExtField) []) (Prefix) + (Just + (L + (TokenLoc + (EpaSpan { T17544_kw.hs:16:3-7 })) + (HsTok))) (HsDataDefn (NoExtField) (Nothing) @@ -169,6 +179,11 @@ ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:19:3-7 }))] (EpaComments [])) + (NewTypeToken + (L + (TokenLoc + (EpaSpan { T17544_kw.hs:18:1-7 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:18:9-11 }) (Unqual @@ -177,6 +192,11 @@ (NoExtField) []) (Prefix) + (Just + (L + (TokenLoc + (EpaSpan { T17544_kw.hs:19:3-7 })) + (HsTok))) (HsDataDefn (NoExtField) (Nothing) ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -93,6 +93,11 @@ ,(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:8:12 }))] (EpaComments [])) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { DumpParsedAst.hs:8:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:8:6-10 }) (Unqual @@ -101,6 +106,7 @@ (NoExtField) []) (Prefix) + (Nothing) (HsDataDefn (NoExtField) (Nothing) @@ -486,6 +492,11 @@ ,(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:15:19 }))] (EpaComments [])) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { DumpParsedAst.hs:15:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:15:6 }) (Unqual @@ -540,6 +551,7 @@ (Unqual {OccName: k}))))))]) (Prefix) + (Nothing) (HsDataDefn (NoExtField) (Nothing) ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -100,6 +100,11 @@ (True) {NameSet: [{Name: DumpRenamedAst.Peano}]}) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { DumpRenamedAst.hs:10:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:10:6-10 }) {Name: DumpRenamedAst.Peano}) @@ -107,6 +112,7 @@ [] []) (Prefix) + (Nothing) (HsDataDefn (NoExtField) (Nothing) @@ -739,6 +745,11 @@ {NameSet: [{Name: a} ,{Name: f}]}) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { DumpRenamedAst.hs:22:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:6 }) {Name: DumpRenamedAst.T}) @@ -783,6 +794,7 @@ (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:22:16 }) {Name: k})))))]) (Prefix) + (Nothing) (HsDataDefn (NoExtField) (Nothing) @@ -1385,5 +1397,3 @@ {Name: GHC.Types.Type})))))])))))] (Nothing) (Nothing))) - - ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -26,6 +26,11 @@ (True) {NameSet: [{Name: GHC.Types.Int}]}) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { T14189.hs:6:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:6:6-11 }) {Name: T14189.MyType}) @@ -33,6 +38,7 @@ [] []) (Prefix) + (Nothing) (HsDataDefn (NoExtField) (Nothing) @@ -223,5 +229,3 @@ (FieldSelectors) {Name: T14189.f}))])])]) (Nothing))) - - ===================================== testsuite/tests/parser/should_compile/T15323.stderr ===================================== @@ -66,6 +66,11 @@ ,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:5:21-25 }))] (EpaComments [])) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { T15323.hs:5:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:5:6-17 }) (Unqual @@ -88,6 +93,11 @@ (Unqual {OccName: v}))))]) (Prefix) + (Just + (L + (TokenLoc + (EpaSpan { T15323.hs:5:21-25 })) + (HsTok))) (HsDataDefn (NoExtField) (Nothing) ===================================== testsuite/tests/parser/should_compile/T20452.stderr ===================================== @@ -66,6 +66,11 @@ ,(AddEpAnn AnnEqual (EpaSpan { T20452.hs:5:24 }))] (EpaComments [])) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { T20452.hs:5:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:5:6-11 }) (Unqual @@ -105,6 +110,7 @@ (Unqual {OccName: k}))))))]) (Prefix) + (Nothing) (HsDataDefn (NoExtField) (Nothing) @@ -154,6 +160,11 @@ ,(AddEpAnn AnnEqual (EpaSpan { T20452.hs:6:24 }))] (EpaComments [])) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { T20452.hs:6:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:6:6-11 }) (Unqual @@ -195,6 +206,7 @@ (Unqual {OccName: k}))))))]) (Prefix) + (Nothing) (HsDataDefn (NoExtField) (Nothing) ===================================== testsuite/tests/printer/T18791.stderr ===================================== @@ -66,6 +66,11 @@ ,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:4:8-12 }))] (EpaComments [])) + (DataTypeToken + (L + (TokenLoc + (EpaSpan { T18791.hs:4:1-4 })) + (HsTok))) (L (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:4:6 }) (Unqual @@ -74,6 +79,11 @@ (NoExtField) []) (Prefix) + (Just + (L + (TokenLoc + (EpaSpan { T18791.hs:4:8-12 })) + (HsTok))) (HsDataDefn (NoExtField) (Nothing) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3450,12 +3450,12 @@ instance ExactPrint (TyClDecl GhcPs) where , tcdRhs = rhs' }) -- TODO: add a workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/20452 - exact (DataDecl { tcdDExt = an, tcdLName = ltycon, tcdTyVars = tyvars - , tcdFixity = fixity, tcdDataDefn = defn }) = do + exact (DataDecl { tcdDExt = an, tcdTkNewOrData = tknd, tcdLName = ltycon, tcdTyVars = tyvars + , tcdFixity = fixity, tcdTkWhere = tkWhere, tcdDataDefn = defn }) = do (_, an', ltycon', tyvars', _, _mctxt', defn') <- exactDataDefn an (exactVanillaDeclHead ltycon tyvars fixity) defn - return (DataDecl { tcdDExt = an', tcdLName = ltycon', tcdTyVars = tyvars' - , tcdFixity = fixity, tcdDataDefn = defn' }) + return (DataDecl { tcdDExt = an', tcdTkNewOrData = tknd, tcdLName = ltycon', tcdTyVars = tyvars' + , tcdFixity = fixity, tcdTkWhere = tkWhere, tcdDataDefn = defn' }) -- ----------------------------------- ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 0fa7dc86dccd751e06845c7ac3908230df2add7f +Subproject commit 9e9ba4e432194c2b98ce3becaa7f736c2e6ec962 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4915acc018b083bd0c612fb25438ee4e6b0de4f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4915acc018b083bd0c612fb25438ee4e6b0de4f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 12:46:31 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 29 May 2023 08:46:31 -0400 Subject: [Git][ghc/ghc][wip/js-supported-extensions] 53 commits: NCG: remove useless .align directive (#20758) Message-ID: <64749ea75d549_2f379c2c4084049@gitlab.mail> Josh Meredith pushed to branch wip/js-supported-extensions at Glasgow Haskell Compiler / GHC Commits: b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bae24c5f0235482ab50cdad2bbabe6aa94352edf...0350b1865f392cf9590c82b5194b62e63770aa44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bae24c5f0235482ab50cdad2bbabe6aa94352edf...0350b1865f392cf9590c82b5194b62e63770aa44 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 13:28:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 09:28:41 -0400 Subject: [Git][ghc/ghc][wip/move-via-c-flags-into-ghc] Move via-C flags into GHC Message-ID: <6474a8896496d_2f379c2c7c9618f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/move-via-c-flags-into-ghc at Glasgow Haskell Compiler / GHC Commits: a09a5a67 by Ben Gamari at 2023-05-29T14:28:31+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 9 changed files: - compiler/GHC/Settings/IO.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_gcc_extra_flags.m4 - + m4/fp_gcc_supports_via_c_flags.m4 Changes: ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -76,7 +76,6 @@ initSettings top_dir = do getToolSetting :: String -> ExceptT SettingsError m String getToolSetting key = expandToolDir useInplaceMinGW mtool_dir <$> getSetting key targetPlatformString <- getSetting "target platform string" - myExtraGccViaCFlags <- getSetting "GCC extra via C opts" cc_prog <- getToolSetting "C compiler command" cxx_prog <- getToolSetting "C++ compiler command" cc_args_str <- getToolSetting "C compiler flags" @@ -93,6 +92,16 @@ initSettings top_dir = do cpp_args = map Option (words cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str + + -- The extra flags we need to pass gcc when we invoke it to compile .hc code. + -- + -- -fwrapv is needed for gcc to emit well-behaved code in the presence of + -- integer wrap around (#952). + extraGccViaCFlags = if platformUnregisterised platform + -- configure guarantees cc support these flags + then ["-fwrapv", "-fno-builtin"] + else [] + ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" @@ -204,7 +213,7 @@ initSettings top_dir = do , toolSettings_opt_lc = [] , toolSettings_opt_i = [] - , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags + , toolSettings_extraGccViaCFlags = extraGccViaCFlags } , sTargetPlatform = platform ===================================== configure.ac ===================================== @@ -622,14 +622,15 @@ FP_GCC_VERSION dnl ** See whether cc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +dnl ** Check support for the extra flags passed by GHC when compiling via C +FP_GCC_SUPPORTS_VIA_C_FLAGS + dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on dnl RISCV64 GCC. FP_CC_SUPPORTS__ATOMICS -FP_GCC_EXTRA_FLAGS - dnl ** look to see if we have a C compiler using an llvm back end. dnl FP_CC_LLVM_BACKEND ===================================== distrib/configure.ac.in ===================================== @@ -164,7 +164,7 @@ AC_SUBST([OptCmd]) dnl ** Check gcc version and flags we need to pass it ** FP_GCC_VERSION FP_GCC_SUPPORTS_NO_PIE -FP_GCC_EXTRA_FLAGS +FP_GCC_SUPPORTS_VIA_C_FLAGS FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) ===================================== hadrian/bindist/Makefile ===================================== @@ -79,8 +79,7 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ - @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ + @echo '[("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ @echo ',("C++ compiler command", "$(SettingsCxxCompilerCommand)")' >> $@ @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -234,7 +234,6 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -137,7 +137,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -411,8 +411,7 @@ generateSettings :: Expr String generateSettings = do ctx <- getContext settings <- traverse sequence $ - [ ("GCC extra via C opts", expr $ lookupSystemConfig "gcc-extra-via-c-opts") - , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) + [ ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) , ("C++ compiler command", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerCommand) , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) ===================================== m4/fp_gcc_extra_flags.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_GCC_EXTRA_FLAGS -# ------------------ -# Determine which extra flags we need to pass gcc when we invoke it -# to compile .hc code. -# -# -fwrapv is needed for gcc to emit well-behaved code in the presence of -# integer wrap around. (#952) -# -AC_DEFUN([FP_GCC_EXTRA_FLAGS], -[AC_REQUIRE([FP_GCC_VERSION]) -AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts], -[ - if test "$Unregisterised" = "YES"; then - # These used to be conditioned on gcc version but we no longer support - # GCC versions which lack support for these flags - fp_cv_gcc_extra_opts="-fwrapv -fno-builtin" - fi -]) -AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) -]) ===================================== m4/fp_gcc_supports_via_c_flags.m4 ===================================== @@ -0,0 +1,17 @@ +# FP_GCC_SUPPORTS_VIA_C_FLAGS +# --------------------------- +# Make sure GCC supports the flags passed by GHC when compiling via C +AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C]) + echo 'int main() { return 0; }' > conftest.c + if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + AC_MSG_ERROR([gcc must support the flags -fwrapv and -fno-builtin]) + fi + rm -f conftest.c conftest.o conftest +]) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a09a5a670fd3f27a47f427c5160ba852206c6cdc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a09a5a670fd3f27a47f427c5160ba852206c6cdc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 13:40:01 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 09:40:01 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 37 commits: Configure CPP into settings Message-ID: <6474ab3166252_2f379c2cf410466e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 0f2495a8 by Rodrigo Mesquita at 2023-05-29T12:34:51+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - e466605e by Ben Gamari at 2023-05-29T14:33:46+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 2e0524f9 by Ben Gamari at 2023-05-29T14:34:14+01:00 ghc-toolchain: Initial commit - - - - - 97a82a82 by Ben Gamari at 2023-05-29T14:35:48+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - f61b94c9 by Ben Gamari at 2023-05-29T14:35:48+01:00 configure: Rip out toolchain selection logic - - - - - 71f1dd39 by Ben Gamari at 2023-05-29T14:35:48+01:00 Fixes - - - - - cc63ff07 by Rodrigo Mesquita at 2023-05-29T14:35:48+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 9174f095 by Rodrigo Mesquita at 2023-05-29T14:35:48+01:00 Re-introduce ld-override option - - - - - 9ab01e51 by Rodrigo Mesquita at 2023-05-29T14:39:50+01:00 ROMES:WIP - - - - - b62687bf by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 0e829b33 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 ROMES: WIP - - - - - 8eb31dc1 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Re-introduce flags in hadrian config - - - - - e77ceac6 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 ROMES WIP - - - - - ad193863 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 3e19cb2c by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - 42f64fd1 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Rip more of configure that is no longer being used - - - - - 769482a0 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - c51d5ed7 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Rip out more from hadrians system.config.in - - - - - 85d273c7 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Configure CLink supports response files - - - - - b6c962d5 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Read deleted keys from host and target's target - - - - - 175a7139 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 ROMES: WIP 3 - - - - - 971c6125 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - ea40aade by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - ae4ea31b by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Handle unspecified vs specified flags and commands better - - - - - 5ae5f357 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 ROMES: WIP 4 - - - - - f48aa614 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Configure Cpp and HsCpp separately - - - - - 3c85c98c by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Fixes for compilation - - - - - 7fc65804 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Link is GNU linkerg - - - - - 7ee0354a by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 ROMES: WIP 5 - - - - - 944d5fef by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 1f5c111c by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 0be70d89 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 helper AC function for enable/disable - - - - - 321ce008 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Delete unused imports of SysTools.Info - - - - - 0793d743 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 7e9ec6b5 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Delete trailing whitespace - - - - - b076bec4 by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Delete trailing whitespace - - - - - 7891623e by Rodrigo Mesquita at 2023-05-29T14:39:52+01:00 Get rid of MonadCatch instances and dependencies - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b58ffb71bf7fe28e5e2484f0cc7ea1e6036b522b...7891623edd386d8bde976ab59255ad66e92a4a46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b58ffb71bf7fe28e5e2484f0cc7ea1e6036b522b...7891623edd386d8bde976ab59255ad66e92a4a46 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 14:24:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 10:24:40 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ghc-toolchain: Check Cc supports extra-via-c-flags Message-ID: <6474b5a8e5b78_2f379c2cf4109126@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: e78dd2e1 by Rodrigo Mesquita at 2023-05-29T15:24:32+01:00 ghc-toolchain: Check Cc supports extra-via-c-flags - - - - - 4 changed files: - configure.ac - distrib/configure.ac.in - − m4/fp_gcc_supports_via_c_flags.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs Changes: ===================================== configure.ac ===================================== @@ -588,10 +588,6 @@ dnl -------------------------------------------------------------- dnl ** does #! work? AC_SYS_INTERPRETER() -dnl ROMES:TODO: Make this check in ghc-toolchain -dnl ** Check support for the extra flags passed by GHC when compiling via C -# FP_GCC_SUPPORTS_VIA_C_FLAGS - dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on ===================================== distrib/configure.ac.in ===================================== @@ -143,9 +143,6 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion]) OptCmd="$OPT" AC_SUBST([OptCmd]) -# ROMES:TODO: Move this to ghc-toolchain -FP_GCC_SUPPORTS_VIA_C_FLAGS - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) ===================================== m4/fp_gcc_supports_via_c_flags.m4 deleted ===================================== @@ -1,17 +0,0 @@ -# FP_GCC_SUPPORTS_VIA_C_FLAGS -# --------------------------- -# Make sure GCC supports the flags passed by GHC when compiling via C -AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS], -[ - AC_REQUIRE([AC_PROG_CC]) - AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C]) - echo 'int main() { return 0; }' > conftest.c - if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - AC_MSG_ERROR([gcc must support the flags -fwrapv and -fno-builtin]) - fi - rm -f conftest.c conftest.o conftest -]) - ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Toolchain.Tools.Cc , addPlatformDepCcFlags ) where +import Control.Monad +import Data.List (isInfixOf) -- Wouldn't it be better to use bytestring? import System.FilePath import GHC.Platform.ArchOS @@ -32,6 +34,7 @@ findCc progOpt = checking "for C compiler" $ do cc <- ignoreUnusedArgs $ Cc {ccProgram} checkCcWorks cc checkC99Support cc + checkCcSupportsExtraViaCFlags cc return cc checkCcWorks :: Cc -> M () @@ -63,6 +66,23 @@ checkC99Support cc = checking "for C99 support" $ withTempDir $ \dir -> do , "#endif" ] +checkCcSupportsExtraViaCFlags :: Cc -> M () +checkCcSupportsExtraViaCFlags cc = checking "whether cc supports extra via-c flags" $ withTempDir $ \dir -> do + let test_o = dir "test.o" + test_c = test_o -<.> "c" + writeFile test_c "int main() { return 0; }" + (code, out, err) <- readProgram (ccProgram cc) + [ "-fwrapv", "-fno-builtin" + , "-Werror", "-x", "c" + , "-o", test_o, test_c] + when (not (isSuccess code) + || "unrecognized" `isInfixOf` out + || "unrecognized" `isInfixOf` err + ) $ + throwE "Your C compiler must support the -fwrapv and -fno-builtin flags" + + + -- | Preprocess the given program. preprocess :: Cc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e78dd2e19a1b556d77ba1ee4e79e964e2002dac3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e78dd2e19a1b556d77ba1ee4e79e964e2002dac3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 14:29:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 10:29:41 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 35 commits: Rip out runtime linker/compiler checks Message-ID: <6474b6d54483d_2f379c2c40109655@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 781ba709 by Ben Gamari at 2023-05-29T15:29:29+01:00 Rip out runtime linker/compiler checks - - - - - 8ee8993e by Ben Gamari at 2023-05-29T15:29:29+01:00 configure: Rip out toolchain selection logic - - - - - 5fcc41e2 by Ben Gamari at 2023-05-29T15:29:29+01:00 Fixes - - - - - bcedb7f5 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 208c3810 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Re-introduce ld-override option - - - - - 41fdf1a1 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ROMES:WIP - - - - - c9ce9f23 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ghc-toolchain library and usage in hadrian flags - - - - - fcc41b6a by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ROMES: WIP - - - - - 1a53b229 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Re-introduce flags in hadrian config - - - - - 724d1d6a by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ROMES WIP - - - - - 4cdc3bd1 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 5165fb65 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - ab644676 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Rip more of configure that is no longer being used - - - - - cbf8b999 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - df908348 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Rip out more from hadrians system.config.in - - - - - 9a650eb4 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Configure CLink supports response files - - - - - cc5d28dc by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Read deleted keys from host and target's target - - - - - dd94a5b9 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ROMES: WIP 3 - - - - - f6aefa59 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 1e0f5be4 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - 0c029140 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Handle unspecified vs specified flags and commands better - - - - - d45f9011 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ROMES: WIP 4 - - - - - d54b700d by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Configure Cpp and HsCpp separately - - - - - 5c09ce87 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Fixes for compilation - - - - - 5a9b5435 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Link is GNU linkerg - - - - - 0a950c24 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 ROMES: WIP 5 - - - - - 3fa1419b by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 7f1d18b6 by Rodrigo Mesquita at 2023-05-29T15:29:29+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 21903644 by Rodrigo Mesquita at 2023-05-29T15:29:30+01:00 helper AC function for enable/disable - - - - - 2075557f by Rodrigo Mesquita at 2023-05-29T15:29:30+01:00 Delete unused imports of SysTools.Info - - - - - 75e0cf33 by Rodrigo Mesquita at 2023-05-29T15:29:30+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 66c7081c by Rodrigo Mesquita at 2023-05-29T15:29:30+01:00 Delete trailing whitespace - - - - - 06b10d82 by Rodrigo Mesquita at 2023-05-29T15:29:30+01:00 Delete trailing whitespace - - - - - e1b8af60 by Rodrigo Mesquita at 2023-05-29T15:29:30+01:00 Get rid of MonadCatch instances and dependencies - - - - - 0b617125 by Rodrigo Mesquita at 2023-05-29T15:29:30+01:00 ghc-toolchain: Check Cc supports extra-via-c-flags - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e78dd2e19a1b556d77ba1ee4e79e964e2002dac3...0b6171256ba95491f5cfd328a55a7fbfc8a37060 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e78dd2e19a1b556d77ba1ee4e79e964e2002dac3...0b6171256ba95491f5cfd328a55a7fbfc8a37060 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 15:37:46 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 29 May 2023 11:37:46 -0400 Subject: [Git][ghc/ghc][wip/int-index/tok-where] 936 commits: Hadrian: fix ghcDebugAssertions off-by-one error Message-ID: <6474c6ca555fd_2f379206ad7c12096e@gitlab.mail> Andrei Borzenkov pushed to branch wip/int-index/tok-where at Glasgow Haskell Compiler / GHC Commits: cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - de928cf0 by Andrei Borzenkov at 2023-05-29T19:35:07+04:00 Use LHsToken for module, data, newtype, class, where in HsModule, DataDecl and ClassDecl types Updates the haddock submodule. - - - - - 11 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4915acc018b083bd0c612fb25438ee4e6b0de4f7...de928cf0a1b0cd775b45bb304fe09e679871fb58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4915acc018b083bd0c612fb25438ee4e6b0de4f7...de928cf0a1b0cd775b45bb304fe09e679871fb58 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 16:14:12 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 12:14:12 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 5 commits: tweak Message-ID: <6474cf546d446_2f379c2b0012508f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 5a4a6476 by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00 tweak - - - - - 4a60c532 by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00 Get rid of MonadCatch instances and dependencies - - - - - e4d7017a by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00 ghc-toolchain: Check Cc supports extra-via-c-flags - - - - - f4c084d1 by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00 Consider empty programs as non-specified programs - - - - - e3592361 by Rodrigo Mesquita at 2023-05-29T17:13:33+01:00 Cpp and HsCpp cleanup - - - - - 12 changed files: - configure.ac - distrib/configure.ac.in - hadrian/cfg/system.config.in - m4/fp_cpp_cmd_with_args.m4 - − m4/fp_gcc_supports_via_c_flags.m4 - m4/fp_hs_cpp_cmd_with_args.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs Changes: ===================================== configure.ac ===================================== @@ -450,10 +450,6 @@ AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) -AC_SUBST([HaskellCPPCmd]) -AC_SUBST([HaskellCPPArgs]) - -dnl ROMES:TODO: Are we setting C99 flags in ghc toolchain for every target? dnl ROMES:TODO: Feels out of date; integrate into ghc-toolchain # CPP, CPPFLAGS @@ -461,11 +457,9 @@ dnl ROMES:TODO: Feels out of date; integrate into ghc-toolchain dnl ROMES:TODO: This comment will generate a merge conflict, but we'll get rid of this all before that can happen dnl Note that we must do this after setting the C99 flags, or otherwise we dnl might end up trying to configure the C99 flags using -E as a CPPFLAG -FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) -FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) -AC_SUBST([CPPCmd_STAGE0]) -AC_SUBST([CPPCmd]) +FP_CPP_CMD_WITH_ARGS([CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([CPPCmd],[CONF_CPP_OPTS_STAGE2]) dnl ROMES:TODO: Are we setting the C99 flags in ghc-toolchain already? FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) @@ -588,10 +582,6 @@ dnl -------------------------------------------------------------- dnl ** does #! work? AC_SYS_INTERPRETER() -dnl ROMES:TODO: Make this check in ghc-toolchain -dnl ** Check support for the extra flags passed by GHC when compiling via C -# FP_GCC_SUPPORTS_VIA_C_FLAGS - dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on @@ -614,8 +604,6 @@ dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLA FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) -AC_SUBST([CPPCmd_STAGE0]) -AC_SUBST([CPPCmd]) dnl Identify C++ standard library flavour and location FP_FIND_CXX_STD_LIB ===================================== distrib/configure.ac.in ===================================== @@ -108,8 +108,6 @@ AC_PROG_CXX([g++ clang++ c++]) # --with-hs-cpp/--with-hs-cpp-flags FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) -AC_SUBST([HaskellCPPCmd]) -AC_SUBST([HaskellCPPArgs]) FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) @@ -143,9 +141,6 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion]) OptCmd="$OPT" AC_SUBST([OptCmd]) -# ROMES:TODO: Move this to ghc-toolchain -FP_GCC_SUPPORTS_VIA_C_FLAGS - FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) @@ -190,11 +185,9 @@ FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CON # --with-cpp/-with-cpp-flags dnl Note that we must do this after setting and using the C99 CPPFLAGS, or dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG -FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) -FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) -AC_SUBST([CPPCmd_STAGE0]) -AC_SUBST([CPPCmd]) +FP_CPP_CMD_WITH_ARGS([CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([CPPCmd],[CONF_CPP_OPTS_STAGE2]) dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) ===================================== hadrian/cfg/system.config.in ===================================== @@ -9,15 +9,12 @@ alex = @AlexCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ -cpp = @CPPCmd@ -hs-cpp = @HaskellCPPCmd@ make = @MakeCmd@ system-merge-objects = @LD_STAGE0@ objdump = @ObjdumpCmd@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ -system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -39,7 +36,6 @@ python = @PythonCmd@ system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@ system-ar-supports-dash-l = @ArSupportsDashL_STAGE0@ cc-llvm-backend = @CcLlvmBackend@ -hs-cpp-args = @HaskellCPPArgs@ # Build options: #=============== @@ -92,8 +88,6 @@ project-git-commit-id = @ProjectGitCommitId@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -gcc-extra-via-c-opts = @GccExtraViaCOpts@ - # ROMES:TODO: Drop almost every of these from settings. settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -1,10 +1,9 @@ # FP_CPP_CMD_WITH_ARGS() # ---------------------- -# sets CPP command and its arguments +# Sets CPP command and its arguments from args --with-cpp and --with-cpp-flags # -# $1 = CC (unmodified) -# $2 = the variable to set to CPP command -# $3 = the variable to set to CPP command arguments +# $1 = the variable to set to CPP command +# $2 = the variable to set to CPP command arguments # # The reason for using the non-standard --with-cpp and --with-cpp-flags instead # of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", @@ -21,17 +20,9 @@ AC_ARG_WITH(cpp, then AC_MSG_WARN([Request to use $withval will be ignored]) else - CPP_CMD="$withval" + $1="$withval" fi -], -[ - # We can't use the CPP var here, since CPP_CMD is expected to be a single - # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". - # So we use CC with -E by default - CPP_CMD="$1" - CPP_ARGS="-E" -] -) +],[]) AC_ARG_WITH(cpp-flags, [AS_HELP_STRING([--with-cpp-flags=ARG], @@ -41,19 +32,9 @@ AC_ARG_WITH(cpp-flags, then AC_MSG_WARN([Request to use $withval will be ignored]) else - # Use whatever flags were manually set, ignoring previously configured - # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) - CPP_ARGS="$CPP_ARGS $withval" + $2="$withval" fi -], -[ - # Augment CPP_ARGS with whatever flags were previously configured and passed - # as an argument. - CPP_ARGS="$CPP_ARGS $$3" -]) - -$2="$CPP_CMD" -$3="$CPP_ARGS" +],[]) ]) ===================================== m4/fp_gcc_supports_via_c_flags.m4 deleted ===================================== @@ -1,17 +0,0 @@ -# FP_GCC_SUPPORTS_VIA_C_FLAGS -# --------------------------- -# Make sure GCC supports the flags passed by GHC when compiling via C -AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS], -[ - AC_REQUIRE([AC_PROG_CC]) - AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C]) - echo 'int main() { return 0; }' > conftest.c - if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - AC_MSG_ERROR([gcc must support the flags -fwrapv and -fno-builtin]) - fi - rm -f conftest.c conftest.o conftest -]) - ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -1,6 +1,6 @@ # FP_HSCPP_CMD_WITH_ARGS() # ---------------------- -# sets HS CPP command and its arguments +# sets HS CPP command and its arguments from args --with-hs-cpp and --with-hs-cpp-flags # # $1 = the variable to set to HS CPP command # $2 = the variable to set to HS CPP command arguments @@ -16,26 +16,18 @@ AC_ARG_WITH(hs-cpp, else $1=$withval fi -], -[ - # We can't use $CPP here, since $1 is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - $1=$CC -] -) +],[]) AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - $2=$withval - fi - ], -[ $2="" ] -) +[AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + $2=$withval + fi +],[]) ]) ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -148,19 +148,21 @@ options = where progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)] progOpts progName description lens = - [ Option [] [progName] (ReqArg (set (lens % _poPath) . Just) metavar) ("Path of " ++ description) + [ Option [] [progName] (ReqArg (set (lens % _poPath) . progPath) metavar) ("Path of " ++ description) , Option [] [progName++"-opt"] (ReqArg (over (lens % _poFlags) . updatePoFlags) "OPTS") ("Flags to pass to " ++ progName) ] where metavar = map toUpper progName - updatePoFlags newOpts existingOpts - = case newOpts of - -- Empty list of flags is as if it was unspecified - "" -> existingOpts - -- Otherwise append specified flags to existing flags or make new - _ -> case existingOpts of - Nothing -> Just [newOpts] - Just eopts -> Just (eopts ++ [newOpts]) + + progPath "" = Nothing + progPath p = Just p + + -- Empty list of flags is as if it was unspecified + updatePoFlags "" existingOpts = existingOpts + -- Otherwise append specified flags to existing flags or make new + updatePoFlags newOpts Nothing = Just [newOpts] + updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts]) + enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)] enableDisable optName description lens = @@ -195,7 +197,7 @@ main = do [] -> do let env = Env { verbosity = optVerbosity opts , targetPrefix = case optTargetPrefix opts of - Just prefix -> Just $ prefix + Just prefix -> Just prefix Nothing -> Just $ optTriple opts ++ "-" , keepTemp = optKeepTemp opts , logContexts = [] @@ -323,7 +325,7 @@ mkTarget opts = do tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc - tgtLlvmTarget <- pure $ optTriple opts + let tgtLlvmTarget = optTriple opts -- code generator configuration tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -33,10 +33,10 @@ library default-extensions: NoImplicitPrelude build-depends: base, directory, - exceptions, filepath, process, transformers, + async, ghc-boot hs-source-dirs: src default-language: Haskell2010 @@ -47,7 +47,6 @@ executable ghc-toolchain default-extensions: NoImplicitPrelude build-depends: base, directory, - exceptions, filepath, process, transformers, ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -6,6 +6,7 @@ module GHC.Toolchain.Monad , M , runM , getEnv + , makeM , throwE , ifCrossCompiling @@ -27,7 +28,6 @@ import qualified Prelude import Control.Applicative import Control.Monad -import qualified Control.Monad.Catch as MC import Control.Monad.IO.Class import Control.Monad.Trans.Class import qualified Control.Monad.Trans.Reader as Reader @@ -43,9 +43,7 @@ data Env = Env { verbosity :: Int } newtype M a = M (Except.ExceptT [Error] (Reader.ReaderT Env IO) a) - deriving (Functor, Applicative, Monad, MonadIO, Alternative, - -- TODO: Eliminate these instances (ROMES: why?) - MC.MonadThrow, MC.MonadCatch, MC.MonadMask) + deriving (Functor, Applicative, Monad, MonadIO, Alternative) runM :: Env -> M a -> IO (Either [Error] a) runM env (M k) = @@ -54,6 +52,9 @@ runM env (M k) = getEnv :: M Env getEnv = M $ lift Reader.ask +makeM :: IO (Either [Error] a) -> M a +makeM io = M (Except.ExceptT (Reader.ReaderT (\env -> io))) + data Error = Error { errorMessage :: String , errorLogContexts :: [String] } ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Toolchain.Tools.Cc , addPlatformDepCcFlags ) where +import Control.Monad +import Data.List (isInfixOf) -- Wouldn't it be better to use bytestring? import System.FilePath import GHC.Platform.ArchOS @@ -32,6 +34,7 @@ findCc progOpt = checking "for C compiler" $ do cc <- ignoreUnusedArgs $ Cc {ccProgram} checkCcWorks cc checkC99Support cc + checkCcSupportsExtraViaCFlags cc return cc checkCcWorks :: Cc -> M () @@ -63,6 +66,21 @@ checkC99Support cc = checking "for C99 support" $ withTempDir $ \dir -> do , "#endif" ] +checkCcSupportsExtraViaCFlags :: Cc -> M () +checkCcSupportsExtraViaCFlags cc = checking "whether cc supports extra via-c flags" $ withTempDir $ \dir -> do + let test_o = dir "test.o" + test_c = test_o -<.> "c" + writeFile test_c "int main() { return 0; }" + (code, out, err) <- readProgram (ccProgram cc) + [ "-fwrapv", "-fno-builtin" + , "-Werror", "-x", "c" + , "-o", test_o, test_c] + when (not (isSuccess code) + || "unrecognized" `isInfixOf` out + || "unrecognized" `isInfixOf` err + ) $ + throwE "Your C compiler must support the -fwrapv and -fno-builtin flags" + -- | Preprocess the given program. preprocess :: Cc ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -61,7 +61,7 @@ findHsCppArgs cpp = withTempDir $ \dir -> do findCpp :: ProgOpt -> Cc -> M Cpp findCpp progOpt cc = checking "for C preprocessor" $ do - -- Use the specified HS CPP or try to find one (candidate is the c compiler) + -- Use the specified CPP or try to find one (candidate is the c compiler) foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] case poFlags progOpt of -- If the user specified CPP flags don't second-guess them @@ -70,3 +70,4 @@ findCpp progOpt cc = checking "for C preprocessor" $ do Nothing -> do let cppProgram = over _prgFlags (["-E"]++) foundCppProg return Cpp{cppProgram} + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs ===================================== @@ -9,8 +9,8 @@ module GHC.Toolchain.Utils , isSuccess ) where +import Control.Exception import Control.Monad -import Control.Monad.Catch import Control.Monad.IO.Class import System.Directory import System.FilePath @@ -19,30 +19,28 @@ import System.Exit import GHC.Toolchain.Prelude -createTempDirectory - :: forall m. (MonadIO m, MonadCatch m) - => m FilePath +createTempDirectory :: IO FilePath createTempDirectory = do - root <- liftIO $ getTemporaryDirectory + root <- getTemporaryDirectory go root 0 where - go :: FilePath -> Int -> m FilePath + go :: FilePath -> Int -> IO FilePath go root n = do let path = root "tmp"++show n - res <- try $ liftIO $ createDirectory path + res <- try $ createDirectory path case res of Right () -> return path Left err | isAlreadyExistsError err -> go root (n+1) - | otherwise -> throwM err + | otherwise -> throwIO err withTempDir :: (FilePath -> M a) -> M a withTempDir f = do env <- getEnv let close dir | keepTemp env = return () - | otherwise = liftIO $ removeDirectoryRecursive dir - bracket createTempDirectory close f + | otherwise = removeDirectoryRecursive dir + makeM (bracket createTempDirectory close (runM env . f)) expectJust :: String -> Maybe a -> M a expectJust err Nothing = throwE err View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b6171256ba95491f5cfd328a55a7fbfc8a37060...e3592361d5c710f987e90193b6f9e639716667e6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b6171256ba95491f5cfd328a55a7fbfc8a37060...e3592361d5c710f987e90193b6f9e639716667e6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 16:15:15 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 12:15:15 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 77 commits: Migrate errors in GHC.Tc.Validity Message-ID: <6474cf931bf4_2f37927240dc1257b1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 3463eb38 by Rodrigo Mesquita at 2023-05-29T17:14:28+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 34d531de by Ben Gamari at 2023-05-29T17:14:28+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 998c3baa by Ben Gamari at 2023-05-29T17:14:28+01:00 ghc-toolchain: Initial commit - - - - - 835cfdc9 by Ben Gamari at 2023-05-29T17:14:28+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - c1b9b9aa by Ben Gamari at 2023-05-29T17:14:28+01:00 Rip out runtime linker/compiler checks - - - - - 2bf524a4 by Ben Gamari at 2023-05-29T17:14:28+01:00 configure: Rip out toolchain selection logic - - - - - 7a61dd7f by Ben Gamari at 2023-05-29T17:14:28+01:00 Fixes - - - - - a0563af8 by Rodrigo Mesquita at 2023-05-29T17:14:28+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 905f69ce by Rodrigo Mesquita at 2023-05-29T17:14:28+01:00 Re-introduce ld-override option - - - - - e79ff601 by Rodrigo Mesquita at 2023-05-29T17:14:28+01:00 ROMES:WIP - - - - - a1d83469 by Rodrigo Mesquita at 2023-05-29T17:14:28+01:00 ghc-toolchain library and usage in hadrian flags - - - - - eda4529e by Rodrigo Mesquita at 2023-05-29T17:14:28+01:00 ROMES: WIP - - - - - 6fe4dc40 by Rodrigo Mesquita at 2023-05-29T17:14:28+01:00 Re-introduce flags in hadrian config - - - - - cd42abb1 by Rodrigo Mesquita at 2023-05-29T17:14:29+01:00 ROMES WIP - - - - - d97505da by Rodrigo Mesquita at 2023-05-29T17:14:29+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - b09da989 by Rodrigo Mesquita at 2023-05-29T17:14:29+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - 5eaf682e by Rodrigo Mesquita at 2023-05-29T17:14:29+01:00 Rip more of configure that is no longer being used - - - - - 0be7c619 by Rodrigo Mesquita at 2023-05-29T17:14:29+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - 9aae1e18 by Rodrigo Mesquita at 2023-05-29T17:14:29+01:00 Rip out more from hadrians system.config.in - - - - - 01118fb5 by Rodrigo Mesquita at 2023-05-29T17:15:02+01:00 Configure CLink supports response files - - - - - 1defbe03 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Read deleted keys from host and target's target - - - - - f2b8eedc by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 ROMES: WIP 3 - - - - - 819e57be by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 05516cfc by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - 36f8892f by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Handle unspecified vs specified flags and commands better - - - - - 422763b3 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 ROMES: WIP 4 - - - - - 68e171ed by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Configure Cpp and HsCpp separately - - - - - df081047 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Fixes for compilation - - - - - 1821d168 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Link is GNU linkerg - - - - - 3bf5b97e by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 ROMES: WIP 5 - - - - - 45cd1dc2 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - 8472655d by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 11761523 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 helper AC function for enable/disable - - - - - 2584aaae by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Delete unused imports of SysTools.Info - - - - - cefb1618 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 2507ec99 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Delete trailing whitespace - - - - - 799ca6df by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Delete trailing whitespace - - - - - 8c52d31e by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 tweak - - - - - a49e04eb by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Get rid of MonadCatch instances and dependencies - - - - - 2144e04e by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 ghc-toolchain: Check Cc supports extra-via-c-flags - - - - - a1be7f3a by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Consider empty programs as non-specified programs - - - - - 917b4362 by Rodrigo Mesquita at 2023-05-29T17:15:04+01:00 Cpp and HsCpp cleanup - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3592361d5c710f987e90193b6f9e639716667e6...917b43623a547fc2a135d835caf09c1831365fbd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3592361d5c710f987e90193b6f9e639716667e6...917b43623a547fc2a135d835caf09c1831365fbd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 17:14:52 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 13:14:52 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Add comment from check for gold t22266 Message-ID: <6474dd8c5aebf_2f379206ad7c139074@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 7c4735ec by Rodrigo Mesquita at 2023-05-29T17:26:51+01:00 Add comment from check for gold t22266 - - - - - 1 changed file: - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -40,6 +40,10 @@ checkMergingWorks cc nm mergeObjs = let ok = all (`isInfixOf` out) ["funA", "funB"] unless ok $ throwE "merged objects is missing symbols" +-- Test for binutils #22266. This bug manifested as GHC bug #14328 (see also: +-- #14675, #14291). +-- Uses test from +-- https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=033bfb739b525703bfe23f151d09e9beee3a2afe checkForGoldT22266 :: Cc -> CcLink -> MergeObjs -> M () checkForGoldT22266 cc ccLink mergeObjs = do version <- checking "for ld.gold object merging bug (binutils #22266)" $ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c4735ecde54cf2f6106a52613d1d3388e91ca3b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c4735ecde54cf2f6106a52613d1d3388e91ca3b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 17:33:44 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 29 May 2023 13:33:44 -0400 Subject: [Git][ghc/ghc][wip/int-index/tok-where] Use LHsToken for module, data, newtype, class, where in HsModule, Message-ID: <6474e1f8d4ee2_2f379c2b0014172a@gitlab.mail> Andrei Borzenkov pushed to branch wip/int-index/tok-where at Glasgow Haskell Compiler / GHC Commits: 72253c38 by Andrei Borzenkov at 2023-05-29T21:33:33+04:00 Use LHsToken for module, data, newtype, class, where in HsModule, DataDecl and ClassDecl types Updates the haddock submodule. - - - - - 30 changed files: - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Decls.hs - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20718b.stderr - testsuite/tests/parser/should_compile/T20846.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72253c38be6cd759f1d7b2a98ed1c7cf944fce97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72253c38be6cd759f1d7b2a98ed1c7cf944fce97 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 17:35:52 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 13:35:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/drop-ld Message-ID: <6474e2785ad37_2f3796381ad41445b9@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/drop-ld at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/drop-ld You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 17:50:24 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 13:50:24 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <6474e5e09c581_2f379c2d30157769@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 2e275356 by Rodrigo Mesquita at 2023-05-29T18:50:12+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,9 +96,8 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) - | otherwise = GHC.SysTools.runCpp logger dflags args + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args + | otherwise = GHC.SysTools.runCpp logger tmpfs dflags args let platform = targetPlatform dflags targetArch = stringEncodeArch $ platformArch platform ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,38 +60,8 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env - -runPp :: Logger -> DynFlags -> [Option] -> IO () -runPp logger dflags args = traceSystoolCommand logger "pp" $ do - let prog = pgm_F dflags - opts = map Option (getOpts dflags opt_F) - runSomething logger "Haskell pre-processor" prog (args ++ opts) - --- | Run compiler of C-like languages and raw objects (such as gcc or clang). -runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO () -runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do - let args1 = map Option userOpts - args2 = languageOptions ++ args ++ args1 - -- We take care to pass -optc flags in args1 last to ensure that the - -- user can override flags passed by GHC. See #14452. - mb_env <- getGccEnv args2 - runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2 - mb_env - where - -- discard some harmless warnings from gcc that we can't turn off - cc_filter = unlines . doFilter . lines - + -- | Discard some harmless warnings from gcc that we can't turn off +cc_filter = unlines . doFilter . lines where {- gcc gives warnings in chunks like so: In file included from /foo/bar/baz.h:11, @@ -139,6 +109,49 @@ runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do | "warning: call-clobbered register used" `isContainedIn` w = False | otherwise = True +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () +runCpp logger tmpfs dflags args = traceSystoolCommand logger "cpp" $ do + let (p,args0) = pgm_cpp dflags + userOpts_c = map Option $ getOpts dflags opt_c + args2 = args0 ++ args ++ userOpts_c + mb_env <- getGccEnv args2 + runSomethingResponseFile logger tmpfs dflags cc_filter "C pre-processor" p + args2 mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do + let (p,args0) = pgm_P dflags + opts = getOpts dflags opt_P + modified_imports = augmentImports dflags opts + args1 = map Option modified_imports + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] + mb_env <- getGccEnv args2 -- romes: what about args0 and args? + runSomethingFiltered logger id "Haskell C pre-processor" p + (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + +runPp :: Logger -> DynFlags -> [Option] -> IO () +runPp logger dflags args = traceSystoolCommand logger "pp" $ do + let prog = pgm_F dflags + opts = map Option (getOpts dflags opt_F) + runSomething logger "Haskell pre-processor" prog (args ++ opts) + +-- | Run compiler of C-like languages and raw objects (such as gcc or clang). +runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO () +runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do + let args1 = map Option userOpts + args2 = languageOptions ++ args ++ args1 + -- We take care to pass -optc flags in args1 last to ensure that the + -- user can override flags passed by GHC. See #14452. + mb_env <- getGccEnv args2 + runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2 + mb_env + where -- force the C compiler to interpret this file as C when -- compiling .hc files, by adding the -x c option. -- Also useful for plain .c files, just in case GHC saw a ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e275356b78675c71543afa8868d053cbb7bf1ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e275356b78675c71543afa8868d053cbb7bf1ca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 17:58:02 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 13:58:02 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-ld] Stop configuring into settings unused Ld command Message-ID: <6474e7aa81416_2f379be0c0d0160156@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-ld at Glasgow Haskell Compiler / GHC Commits: eea5ff15 by Rodrigo Mesquita at 2023-05-29T18:53:39+01:00 Stop configuring into settings unused Ld command - - - - - 13 changed files: - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_prog_ld_filelist.m4 - m4/fp_prog_ld_flag.m4 - m4/fp_prog_ld_is_gnu.m4 - m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_settings.m4 Changes: ===================================== configure.ac ===================================== @@ -482,9 +482,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_BUILD_ID @@ -1233,7 +1231,6 @@ echo "\ hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd - ld : $LdCmd nm : $NmCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd ===================================== distrib/configure.ac.in ===================================== @@ -125,9 +125,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_BUILD_ID ===================================== ghc/Main.hs ===================================== @@ -628,7 +628,7 @@ mode_flags = "Global Package DB", "C compiler flags", "C compiler link flags", - "ld flags"], + ], let k' = "-print-" ++ map (replaceSpace . toLower) k replaceSpace ' ' = '-' replaceSpace c = c ===================================== hadrian/bindist/Makefile ===================================== @@ -88,8 +88,6 @@ lib/settings : config.mk @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ - @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ - @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -264,8 +264,6 @@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ -SettingsLdCommand = @SettingsLdCommand@ -SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -11,7 +11,7 @@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ hs-cpp = @HaskellCPPCmd@ -ld = @LdCmd@ +ld = @LD@ make = @MakeCmd@ nm = @NmCmd@ merge-objects = @MergeObjsCmd@ @@ -152,8 +152,6 @@ settings-c-compiler-flags = @SettingsCCompilerFlags@ settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ -settings-ld-command = @SettingsLdCommand@ -settings-ld-flags = @SettingsLdFlags@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -113,8 +113,6 @@ data SettingsFileSetting | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie - | SettingsFileSetting_LdCommand - | SettingsFileSetting_LdFlags | SettingsFileSetting_MergeObjectsCommand | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand @@ -210,8 +208,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" - SettingsFileSetting_LdCommand -> "settings-ld-command" - SettingsFileSetting_LdFlags -> "settings-ld-flags" SettingsFileSetting_MergeObjectsCommand -> "settings-merge-objects-command" SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -420,8 +420,6 @@ generateSettings = do , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) - , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) - , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") ===================================== m4/fp_prog_ld_filelist.m4 ===================================== @@ -12,7 +12,7 @@ AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist], ${CC-cc} -c conftest2.c echo conftest1.o > conftest.o-files echo conftest2.o >> conftest.o-files - if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 + if $LD -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 then fp_cv_ld_has_filelist=yes else ===================================== m4/fp_prog_ld_flag.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_FLAG], AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_$2=$1 else fp_cv_$2= ===================================== m4/fp_prog_ld_is_gnu.m4 ===================================== @@ -4,7 +4,7 @@ # GNU ld or not. AC_DEFUN([FP_PROG_LD_IS_GNU],[ AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], -[[if ${LdCmd} --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then +[[if $LD --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then fp_cv_gnu_ld=YES else fp_cv_gnu_ld=NO ===================================== m4/fp_prog_ld_no_compact_unwind.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_ld_no_compact_unwind=yes else fp_cv_ld_no_compact_unwind=no ===================================== m4/fp_settings.m4 ===================================== @@ -16,8 +16,6 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" - SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" - SettingsLdFlags="" # LLD does not support object merging (#21068) SettingsMergeObjectsCommand="" SettingsMergeObjectsFlags="" @@ -38,8 +36,6 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" - SettingsLdCommand="$LdCmd" - SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" SettingsMergeObjectsCommand="$MergeObjsCmd" @@ -113,8 +109,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) - AC_SUBST(SettingsLdCommand) - AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsMergeObjectsCommand) AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eea5ff157d8774c486b1ea2835845786e353339e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eea5ff157d8774c486b1ea2835845786e353339e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 17:58:21 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 13:58:21 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-ld] Stop configuring into settings unused Ld command Message-ID: <6474e7bd59592_2f3796a499201604dd@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-ld at Glasgow Haskell Compiler / GHC Commits: e7703d1d by Rodrigo Mesquita at 2023-05-29T18:58:12+01:00 Stop configuring into settings unused Ld command - - - - - 13 changed files: - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_prog_ld_filelist.m4 - m4/fp_prog_ld_flag.m4 - m4/fp_prog_ld_is_gnu.m4 - m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_settings.m4 Changes: ===================================== configure.ac ===================================== @@ -482,9 +482,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_BUILD_ID @@ -1233,7 +1231,6 @@ echo "\ hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd - ld : $LdCmd nm : $NmCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd ===================================== distrib/configure.ac.in ===================================== @@ -125,9 +125,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_BUILD_ID ===================================== ghc/Main.hs ===================================== @@ -627,8 +627,8 @@ mode_flags = "LibDir", "Global Package DB", "C compiler flags", - "C compiler link flags", - "ld flags"], + "C compiler link flags" + ], let k' = "-print-" ++ map (replaceSpace . toLower) k replaceSpace ' ' = '-' replaceSpace c = c ===================================== hadrian/bindist/Makefile ===================================== @@ -88,8 +88,6 @@ lib/settings : config.mk @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ - @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ - @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -264,8 +264,6 @@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ -SettingsLdCommand = @SettingsLdCommand@ -SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -11,7 +11,7 @@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ hs-cpp = @HaskellCPPCmd@ -ld = @LdCmd@ +ld = @LD@ make = @MakeCmd@ nm = @NmCmd@ merge-objects = @MergeObjsCmd@ @@ -152,8 +152,6 @@ settings-c-compiler-flags = @SettingsCCompilerFlags@ settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ -settings-ld-command = @SettingsLdCommand@ -settings-ld-flags = @SettingsLdFlags@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -113,8 +113,6 @@ data SettingsFileSetting | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie - | SettingsFileSetting_LdCommand - | SettingsFileSetting_LdFlags | SettingsFileSetting_MergeObjectsCommand | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand @@ -210,8 +208,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" - SettingsFileSetting_LdCommand -> "settings-ld-command" - SettingsFileSetting_LdFlags -> "settings-ld-flags" SettingsFileSetting_MergeObjectsCommand -> "settings-merge-objects-command" SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -420,8 +420,6 @@ generateSettings = do , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) - , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) - , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") ===================================== m4/fp_prog_ld_filelist.m4 ===================================== @@ -12,7 +12,7 @@ AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist], ${CC-cc} -c conftest2.c echo conftest1.o > conftest.o-files echo conftest2.o >> conftest.o-files - if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 + if $LD -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 then fp_cv_ld_has_filelist=yes else ===================================== m4/fp_prog_ld_flag.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_FLAG], AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_$2=$1 else fp_cv_$2= ===================================== m4/fp_prog_ld_is_gnu.m4 ===================================== @@ -4,7 +4,7 @@ # GNU ld or not. AC_DEFUN([FP_PROG_LD_IS_GNU],[ AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], -[[if ${LdCmd} --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then +[[if $LD --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then fp_cv_gnu_ld=YES else fp_cv_gnu_ld=NO ===================================== m4/fp_prog_ld_no_compact_unwind.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_ld_no_compact_unwind=yes else fp_cv_ld_no_compact_unwind=no ===================================== m4/fp_settings.m4 ===================================== @@ -16,8 +16,6 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" - SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" - SettingsLdFlags="" # LLD does not support object merging (#21068) SettingsMergeObjectsCommand="" SettingsMergeObjectsFlags="" @@ -38,8 +36,6 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" - SettingsLdCommand="$LdCmd" - SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" SettingsMergeObjectsCommand="$MergeObjsCmd" @@ -113,8 +109,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) - AC_SUBST(SettingsLdCommand) - AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsMergeObjectsCommand) AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7703d1d5003427312ff9278683b72ac9409444f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7703d1d5003427312ff9278683b72ac9409444f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 18:34:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 14:34:34 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <6474f03ab1e30_2f37927240dc169826@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 24eafb9b by Rodrigo Mesquita at 2023-05-29T19:34:20+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 18 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,9 +96,8 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) - | otherwise = GHC.SysTools.runCpp logger dflags args + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args + | otherwise = GHC.SysTools.runCpp logger tmpfs dflags args let platform = targetPlatform dflags targetArch = stringEncodeArch $ platformArch platform ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,38 +60,9 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env - -runPp :: Logger -> DynFlags -> [Option] -> IO () -runPp logger dflags args = traceSystoolCommand logger "pp" $ do - let prog = pgm_F dflags - opts = map Option (getOpts dflags opt_F) - runSomething logger "Haskell pre-processor" prog (args ++ opts) - --- | Run compiler of C-like languages and raw objects (such as gcc or clang). -runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO () -runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do - let args1 = map Option userOpts - args2 = languageOptions ++ args ++ args1 - -- We take care to pass -optc flags in args1 last to ensure that the - -- user can override flags passed by GHC. See #14452. - mb_env <- getGccEnv args2 - runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2 - mb_env - where - -- discard some harmless warnings from gcc that we can't turn off - cc_filter = unlines . doFilter . lines - +-- | Discard some harmless warnings from gcc that we can't turn off +cc_filter :: String -> String +cc_filter = unlines . doFilter . lines where {- gcc gives warnings in chunks like so: In file included from /foo/bar/baz.h:11, @@ -139,6 +110,49 @@ runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do | "warning: call-clobbered register used" `isContainedIn` w = False | otherwise = True +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () +runCpp logger tmpfs dflags args = traceSystoolCommand logger "cpp" $ do + let (p,args0) = pgm_cpp dflags + userOpts_c = map Option $ getOpts dflags opt_c + args2 = args0 ++ args ++ userOpts_c + mb_env <- getGccEnv args2 + runSomethingResponseFile logger tmpfs dflags cc_filter "C pre-processor" p + args2 mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do + let (p,args0) = pgm_P dflags + opts = getOpts dflags opt_P + modified_imports = augmentImports dflags opts + args1 = map Option modified_imports + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] + mb_env <- getGccEnv args2 -- romes: what about args0 and args? + runSomethingFiltered logger id "Haskell C pre-processor" p + (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + +runPp :: Logger -> DynFlags -> [Option] -> IO () +runPp logger dflags args = traceSystoolCommand logger "pp" $ do + let prog = pgm_F dflags + opts = map Option (getOpts dflags opt_F) + runSomething logger "Haskell pre-processor" prog (args ++ opts) + +-- | Run compiler of C-like languages and raw objects (such as gcc or clang). +runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO () +runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do + let args1 = map Option userOpts + args2 = languageOptions ++ args ++ args1 + -- We take care to pass -optc flags in args1 last to ensure that the + -- user can override flags passed by GHC. See #14452. + mb_env <- getGccEnv args2 + runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2 + mb_env + where -- force the C compiler to interpret this file as C when -- compiling .hc files, by adding the -x c option. -- Also useful for plain .c files, just in case GHC saw a ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,58 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +--with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +$2="$CPP_CMD" +$3="$CPP_ARGS" ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24eafb9b6f97b707676dc5de583eb4716ebf207b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24eafb9b6f97b707676dc5de583eb4716ebf207b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 20:54:28 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 29 May 2023 16:54:28 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Stop configuring into settings unused Ld command Message-ID: <647511045de_2f379206ad7c183096@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: b8cba82b by Rodrigo Mesquita at 2023-05-29T21:53:58+01:00 Stop configuring into settings unused Ld command - - - - - 12 changed files: - configure.ac - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - + m4/fp_prog_ld_filelist.m4 - + m4/fp_prog_ld_flag.m4 - + m4/fp_prog_ld_is_gnu.m4 - + m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_settings.m4 Changes: ===================================== configure.ac ===================================== @@ -1131,7 +1131,6 @@ echo "\ hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd - ld : $LdCmd nm : $NmCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd ===================================== ghc/Main.hs ===================================== @@ -627,8 +627,8 @@ mode_flags = "LibDir", "Global Package DB", "C compiler flags", - "C compiler link flags", - "ld flags"], + "C compiler link flags" + ], let k' = "-print-" ++ map (replaceSpace . toLower) k replaceSpace ' ' = '-' replaceSpace c = c ===================================== hadrian/bindist/Makefile ===================================== @@ -89,8 +89,6 @@ lib/settings : config.mk @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ - @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ - @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -264,8 +264,6 @@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ -SettingsLdCommand = @SettingsLdCommand@ -SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -9,6 +9,7 @@ alex = @AlexCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +ld = @LD@ make = @MakeCmd@ system-merge-objects = @LD_STAGE0@ objdump = @ObjdumpCmd@ @@ -99,8 +100,6 @@ settings-c-compiler-flags = @SettingsCCompilerFlags@ settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ -settings-ld-command = @SettingsLdCommand@ -settings-ld-flags = @SettingsLdFlags@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -101,8 +101,6 @@ data ToolchainSetting | ToolchainSetting_CxxCompilerFlags | ToolchainSetting_CCompilerLinkFlags | ToolchainSetting_CCompilerSupportsNoPie - | ToolchainSetting_LdCommand - | ToolchainSetting_LdFlags | ToolchainSetting_MergeObjectsCommand | ToolchainSetting_MergeObjectsFlags | ToolchainSetting_ArCommand @@ -196,9 +194,6 @@ settingsFileSetting key = case key of ToolchainSetting_CxxCompilerFlags -> queryHostTargetConfig (flags . cxxProgram . tgtCxxCompiler) ToolchainSetting_CCompilerLinkFlags -> queryHostTargetConfig (flags . ccLinkProgram . tgtCCompilerLink) ToolchainSetting_CCompilerSupportsNoPie -> queryHostTargetConfig (yesNo . ccLinkSupportsNoPie . tgtCCompilerLink) - -- ROMES:TODO: Rename LdCommand to CCLink - ToolchainSetting_LdCommand -> lookupSystemConfig "settings-ld-command" - ToolchainSetting_LdFlags -> lookupSystemConfig "settings-ld-flags" ToolchainSetting_MergeObjectsCommand -> queryHostTargetConfig (maybe "" (cmd . mergeObjsProgram) . tgtMergeObjs) ToolchainSetting_MergeObjectsFlags -> queryHostTargetConfig (maybe "" (flags . mergeObjsProgram) . tgtMergeObjs) ToolchainSetting_ArCommand -> queryHostTargetConfig (cmd . arMkArchive . tgtAr) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -427,8 +427,6 @@ generateSettings = do , ("CPP flags", expr $ settingsFileSetting ToolchainSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting ToolchainSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting ToolchainSetting_HaskellCPPFlags) - , ("ld command", expr $ settingsFileSetting ToolchainSetting_LdCommand) - , ("ld flags", expr $ settingsFileSetting ToolchainSetting_LdFlags) , ("ld supports compact unwind", expr $ queryTargetTargetConfig linkSupportsCompactUnwind) , ("ld supports filelist", expr $ queryTargetTargetConfig linkSupportsFilelist) , ("ld supports response files", expr $ queryTargetTargetConfig linkSupportsResponseFiles) ===================================== m4/fp_prog_ld_filelist.m4 ===================================== @@ -0,0 +1,25 @@ +# FP_PROG_LD_FILELIST +# ------------------- +# Sets the output variable LdHasFilelist to YES if ld supports +# -filelist, or NO otherwise. +AC_DEFUN([FP_PROG_LD_FILELIST], +[ +AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist], +[ + echo 'int foo() { return 0; }' > conftest1.c + echo 'int bar() { return 0; }' > conftest2.c + ${CC-cc} -c conftest1.c + ${CC-cc} -c conftest2.c + echo conftest1.o > conftest.o-files + echo conftest2.o >> conftest.o-files + if $LD -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 + then + fp_cv_ld_has_filelist=yes + else + fp_cv_ld_has_filelist=no + fi + rm -rf conftest* +]) +FP_CAPITALIZE_YES_NO(["$fp_cv_ld_has_filelist"], [LdHasFilelist]) +AC_SUBST([LdHasFilelist]) +])# FP_PROG_LD_FILELIST ===================================== m4/fp_prog_ld_flag.m4 ===================================== @@ -0,0 +1,17 @@ +# FP_PROG_LD_FLAG +# --------------- +# Sets the output variable $2 to $1 if ld supports the $1 flag. +# Otherwise the variable's value is empty. +AC_DEFUN([FP_PROG_LD_FLAG], +[ +AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2], +[echo 'int foo() { return 0; }' > conftest.c +${CC-cc} -c conftest.c +if $LD -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then + fp_cv_$2=$1 +else + fp_cv_$2= +fi +rm -rf conftest*]) +$2=$fp_cv_$2 +])# FP_PROG_LD_FLAG ===================================== m4/fp_prog_ld_is_gnu.m4 ===================================== @@ -0,0 +1,13 @@ +# FP_PROG_LD_IS_GNU +# ----------------- +# Sets the output variable LdIsGNULd to YES or NO, depending on whether it is +# GNU ld or not. +AC_DEFUN([FP_PROG_LD_IS_GNU],[ +AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], +[[if $LD --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then + fp_cv_gnu_ld=YES +else + fp_cv_gnu_ld=NO +fi]]) +AC_SUBST([LdIsGNULd],["$fp_cv_gnu_ld"]) +])# FP_PROG_LD_IS_GNU ===================================== m4/fp_prog_ld_no_compact_unwind.m4 ===================================== @@ -0,0 +1,18 @@ +# FP_PROG_LD_NO_COMPACT_UNWIND +# ---------------------------- +# Sets the output variable LdHasNoCompactUnwind to YES if ld supports +# -no_compact_unwind, or NO otherwise. +AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], +[ +AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], +[echo 'int foo() { return 0; }' > conftest.c +${CC-cc} -c conftest.c +if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then + fp_cv_ld_no_compact_unwind=yes +else + fp_cv_ld_no_compact_unwind=no +fi +rm -rf conftest*]) +FP_CAPITALIZE_YES_NO(["$fp_cv_ld_no_compact_unwind"], [LdHasNoCompactUnwind]) +AC_SUBST([LdHasNoCompactUnwind]) +])# FP_PROG_LD_NO_COMPACT_UNWIND ===================================== m4/fp_settings.m4 ===================================== @@ -19,8 +19,6 @@ AC_DEFUN([FP_SETTINGS], SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" - SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" - SettingsLdFlags="" # LLD does not support object merging (#21068) SettingsMergeObjectsCommand="" SettingsMergeObjectsFlags="" @@ -43,8 +41,6 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" - SettingsLdCommand="$LdCmd" - SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" SettingsMergeObjectsCommand="$MergeObjsCmd" @@ -120,8 +116,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) - AC_SUBST(SettingsLdCommand) - AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsMergeObjectsCommand) AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8cba82b5212601f090653c2ec7c3ba20b917cb3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8cba82b5212601f090653c2ec7c3ba20b917cb3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon May 29 23:43:41 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 29 May 2023 19:43:41 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 2 commits: add a more appropriate error context for case alternative in failable do stmt pattern binding Message-ID: <647538adaac42_2f379c2c7c212046@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 83605216 by Apoorv Ingle at 2023-05-26T19:42:38-05:00 add a more appropriate error context for case alternative in failable do stmt pattern binding - - - - - ecdb4bd6 by Apoorv Ingle at 2023-05-29T18:43:31-05:00 more error context changes - - - - - 3 changed files: - compiler/GHC/Hs/Utils.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -41,7 +41,7 @@ just attach noSrcSpan to everything. module GHC.Hs.Utils( -- * Terms mkHsPar, mkHsApp, mkHsAppWith, mkHsApps, mkHsAppsWith, - mkHsAppType, mkHsAppTypes, mkHsCaseAlt, + mkHsAppType, mkHsAppTypes, mkHsCaseAlt, mkHsCaseAltDoExp, mkSimpleMatch, unguardedGRHSs, unguardedRHS, mkMatchGroup, mkLamCaseMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf, mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo, @@ -282,7 +282,7 @@ mkHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) mkHsLamDoExp pats body = mkHsPar (noLocA $ HsLam noExtField matches) where matches = mkMatchGroup (Generated DoExpansion) - (noLocA [mkSimpleMatch LambdaExpr pats' body]) + (noLocA [mkSimpleMatch (StmtCtxt (HsDoStmt (DoExpr Nothing))) pats' body]) pats' = map (parenthesizePat appPrec) pats mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc @@ -300,6 +300,17 @@ mkHsCaseAlt :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) mkHsCaseAlt pat expr = mkSimpleMatch CaseAlt [pat] expr + +mkHsCaseAltDoExp :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) + ~ SrcAnn NoEpAnns, + Anno (Match (GhcPass p) (LocatedA (body (GhcPass p)))) + ~ SrcSpanAnnA) + => LPat (GhcPass p) -> (LocatedA (body (GhcPass p))) + -> LMatch (GhcPass p) (LocatedA (body (GhcPass p))) +mkHsCaseAltDoExp pat expr + = mkSimpleMatch (StmtCtxt (HsDoStmt (DoExpr Nothing))) [pat] expr + + nlHsTyApp :: Id -> [Type] -> LHsExpr GhcTc nlHsTyApp fun_id tys = noLocA (mkHsWrap (mkWpTyApps tys) (HsVar noExtField (noLocA fun_id))) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -269,7 +269,9 @@ tcExpr (HsLam _ match) res_ty where match_ctxt = MC { mc_what = case mg_ext match of Generated DoExpansion -> StmtCtxt (HsDoStmt (DoExpr Nothing)) + -- Either this lambda expr was generated by expanding a do block _ -> LambdaExpr + -- Or it was a true lambda , mc_body = tcBody } herald = ExpectedFunTyLam match @@ -416,9 +418,10 @@ tcExpr (HsMultiIf _ alts) res_ty tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt , text "expr:" <+> ppr expr - , text "res_ty" <+> ppr res_ty ]) + , text "res_ty" <+> ppr res_ty + ]) ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - tcExpr (unLoc expr) res_ty + tcApp (unLoc expr) res_ty } tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -267,6 +267,7 @@ tcMatch ctxt pat_tys rhs_ty match add_match_ctxt match thing_inside = case mc_what ctxt of LambdaExpr -> thing_inside + StmtCtxt (HsDoStmt{}) -> thing_inside -- this is an expanded do stmt _ -> addErrCtxt (pprMatchInCtxt match) thing_inside ------------- @@ -1249,11 +1250,11 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) -- ------------------------------------------------------- -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts - expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ genPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e) - , expr - ] + expr <- mk_failable_lexpr_tcm pat (noLocA $ mkExpandedStmt stmt expand_stmts) fail_op + return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ genPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e) + , genPopSrcSpanExpr expr + ]) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) @@ -1339,10 +1340,14 @@ expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = } where do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) - do_arg (ApplicativeArgOne mb_fail_op pat expr _) = - return ((pat, mb_fail_op), expr) - do_arg (ApplicativeArgMany _ stmts ret pat _) = - do { expr <- expand_do_stmts do_or_lc $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] + do_arg (ApplicativeArgOne + { xarg_app_arg_one = mb_fail_op + , app_arg_pattern = pat@(L loc _) + , arg_expr = rhs + }) = + return ((pat, mb_fail_op), wrapGenSpan (mkExpandedStmt (L loc (BindStmt xbsn pat rhs)) rhs)) + do_arg (ApplicativeArgMany _ stmts ret pat ctxt) = + do { expr <- expand_do_stmts ctxt $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] ; return ((pat, Nothing), expr) } match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) @@ -1353,6 +1358,9 @@ expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = SyntaxExprRn op -> mkHsApps (wrapGenSpan op) [l_expr, r_expr] NoSyntaxExprRn -> pprPanic "expand_do_stmts op:" (ppr op) + xbsn :: XBindStmtRn + xbsn = XBindStmtRn NoSyntaxExprRn Nothing + expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) @@ -1374,7 +1382,7 @@ mk_failable_lexpr_tcm pat lexpr fail_op = ; if irrf_pat -- don't decorate with fail statement if -- the pattern is irrefutable - then return $ mkHsLamDoExp [pat] (genPopSrcSpanExpr lexpr) + then return $ mkHsLamDoExp [pat] lexpr else mk_fail_lexpr pat lexpr fail_op } @@ -1385,9 +1393,9 @@ mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsEx mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ - (wrapGenSpan [ mkHsCaseAlt pat (genPopSrcSpanExpr lexpr) -- pat -> expr - , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" - (wrapGenSpan $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) + (wrapGenSpan [ mkHsCaseAltDoExp pat lexpr -- pat -> expr + , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" + (wrapGenSpan $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) ])) where mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ff1c26dafd53b1c836df8f7d0db1b6c265ee6c4...ecdb4bd6e4b74a48208df4568a4f1d6ec89d62b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ff1c26dafd53b1c836df8f7d0db1b6c265ee6c4...ecdb4bd6e4b74a48208df4568a4f1d6ec89d62b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 08:03:47 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 30 May 2023 04:03:47 -0400 Subject: [Git][ghc/ghc][wip/int-index/hdk-register-tok] 939 commits: Handle type data declarations in Template Haskell quotations and splices (fixes #22500) Message-ID: <6475ade39bbc9_2f379c2d302451ec@gitlab.mail> Andrei Borzenkov pushed to branch wip/int-index/hdk-register-tok at Glasgow Haskell Compiler / GHC Commits: 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 72253c38 by Andrei Borzenkov at 2023-05-29T21:33:33+04:00 Use LHsToken for module, data, newtype, class, where in HsModule, DataDecl and ClassDecl types Updates the haddock submodule. - - - - - 57d930b5 by Vladislav Zavialov at 2023-05-30T12:03:10+04:00 Register LHsToken in Parser.PostProcess.Haddock - - - - - 11 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bccd18c7f9c12296f5deeb422cc886cf967ab14d...57d930b5529a265d8a3e7a9131f660222ddac4a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bccd18c7f9c12296f5deeb422cc886cf967ab14d...57d930b5529a265d8a3e7a9131f660222ddac4a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 08:21:08 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 30 May 2023 04:21:08 -0400 Subject: [Git][ghc/ghc][wip/int-index/hdk-register-tok] Register LHsToken in Parser.PostProcess.Haddock Message-ID: <6475b1f4b0c1b_2f37927240dc24904a@gitlab.mail> Andrei Borzenkov pushed to branch wip/int-index/hdk-register-tok at Glasgow Haskell Compiler / GHC Commits: b70a5859 by Vladislav Zavialov at 2023-05-30T12:20:52+04:00 Register LHsToken in Parser.PostProcess.Haddock - - - - - 4 changed files: - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr Changes: ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Parser.Annotation ( AddEpAnn(..), EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn, TokenLocation(..), - getTokenSrcSpan, + getTokenSrcSpan, getTokenBufSpan, DeltaPos(..), deltaPos, getDeltaLine, EpAnn(..), Anchor(..), AnchorOperation(..), @@ -418,6 +418,11 @@ getTokenSrcSpan NoTokenLoc = noSrcSpan getTokenSrcSpan (TokenLoc EpaDelta{}) = noSrcSpan getTokenSrcSpan (TokenLoc (EpaSpan rspan mbufpos)) = RealSrcSpan rspan mbufpos +getTokenBufSpan :: TokenLocation -> Strict.Maybe BufSpan +getTokenBufSpan (TokenLoc (EpaSpan _ mbspan)) = mbspan +getTokenBufSpan (TokenLoc EpaDelta{}) = Strict.Nothing +getTokenBufSpan NoTokenLoc = Strict.Nothing + instance Outputable a => Outputable (GenLocated TokenLocation a) where ppr (L _ x) = ppr x ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -62,7 +62,6 @@ import Data.Traversable import Data.Maybe import Data.List.NonEmpty (nonEmpty) import qualified Data.List.NonEmpty as NE -import Control.Monad import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader import Control.Monad.Trans.Writer @@ -249,15 +248,17 @@ instance HasHaddock (Located (HsModule GhcPs)) where -- module M where -- -- Only do this when the module header exists. - headerDocs <- - for @Maybe (hsmodName mod) $ \(L l_name _) -> - extendHdkA (locA l_name) $ liftHdkA $ do - -- todo: register keyword location of 'module', see Note [Register keyword location] - docs <- - inLocRange (locRangeTo (getBufPos (srcSpanStart (locA l_name)))) $ - takeHdkComments mkDocNext - dc <- selectDocString docs - pure $ lexLHsDocString <$> dc + headerDocs <- case hsmodHeaderTokens mod of + HsNoModTk -> pure Nothing + modToks -> + liftHdkA $ do + docs <- + inLocRange (locRangeTo (getBufPos (srcSpanStart (modSigTokenLocation modToks)))) $ + takeHdkComments mkDocNext + dc <- selectDocString docs + pure $ lexLHsDocString <$> dc + + traverse_ @Maybe registerHdkA (hsmodName mod) -- Step 2, process documentation comments in the export list: -- @@ -272,6 +273,7 @@ instance HasHaddock (Located (HsModule GhcPs)) where -- -- Only do this when the export list exists. hsmodExports' <- traverse @Maybe addHaddock (hsmodExports mod) + registerWhereTokenHdkA (hsmodHeaderTokens mod) -- Step 3, register the import section to reject invalid comments: -- @@ -295,7 +297,15 @@ instance HasHaddock (Located (HsModule GhcPs)) where pure $ L l_mod $ mod { hsmodExports = hsmodExports' , hsmodDecls = hsmodDecls' - , hsmodExt = (hsmodExt mod) { hsmodHaddockModHeader = join @Maybe headerDocs } } + , hsmodExt = (hsmodExt mod) { hsmodHaddockModHeader = headerDocs } } + where + modSigTokenLocation HsNoModTk = noSrcSpan + modSigTokenLocation (HsSigTk sigTok _) = getTokenSrcSpan $ getLoc sigTok + modSigTokenLocation (HsModTk modTok _) = getTokenSrcSpan $ getLoc modTok + + registerWhereTokenHdkA HsNoModTk = pure () + registerWhereTokenHdkA (HsSigTk _ whereTok) = registerTokenHdkA whereTok + registerWhereTokenHdkA (HsModTk _ whereTok) = registerTokenHdkA whereTok lexHsDocString :: HsDocString -> HsDoc GhcPs lexHsDocString = lexHsDoc parseIdentifier @@ -313,7 +323,6 @@ instance HasHaddock (LocatedL [LocatedA (IE GhcPs)]) where addHaddock (L l_exports exports) = extendHdkA (locA l_exports) $ do exports' <- addHaddockInterleaveItems NoLayoutInfo mkDocIE exports - registerLocHdkA (srcLocSpan (srcSpanEnd (locA l_exports))) -- Do not consume comments after the closing parenthesis pure $ L l_exports exports' -- Needed to use 'addHaddockInterleaveItems' in 'instance HasHaddock (Located [LIE GhcPs])'. @@ -481,13 +490,18 @@ instance HasHaddock (HsDecl GhcPs) where addHaddock (TyClD x decl) | DataDecl { tcdDExt, tcdTkNewOrData, tcdLName, tcdTyVars, tcdTkWhere, tcdFixity, tcdDataDefn = defn } <- decl = do + registerNewOrDataTokHdkA tcdTkNewOrData registerHdkA tcdLName + traverse_ @Strict.Maybe registerTokenHdkA tcdTkWhere defn' <- addHaddock defn pure $ TyClD x (DataDecl { tcdDExt, tcdTkNewOrData, tcdLName, tcdTyVars, tcdTkWhere, tcdFixity, tcdDataDefn = defn' }) + where + registerNewOrDataTokHdkA (NewTypeToken tok) = registerTokenHdkA tok + registerNewOrDataTokHdkA (DataTypeToken tok) = registerTokenHdkA tok -- Class declarations: -- @@ -502,8 +516,9 @@ instance HasHaddock (HsDecl GhcPs) where tcdCtxt, tcdLName, tcdTyVars, tcdFixity, tcdFDs, tcdTkWhere, tcdSigs, tcdMeths, tcdATs, tcdATDefs } <- decl = do + registerTokenHdkA tcdTkClass registerHdkA tcdLName - -- todo: register keyword location of 'where', see Note [Register keyword location] + traverse_ @Strict.Maybe registerTokenHdkA tcdTkWhere where_cls' <- addHaddockInterleaveItems tcdLayout (mkDocHsDecl tcdLayout) $ flattenBindsAndSigs (tcdMeths, tcdSigs, tcdATs, tcdATDefs, [], []) @@ -1158,6 +1173,13 @@ registerLocHdkA l = HdkA (getBufSpan l) (pure ()) registerHdkA :: GenLocated (SrcSpanAnn' a) e -> HdkA () registerHdkA a = registerLocHdkA (getLocA a) +-- Let the neighbours know about a token at this location. +-- Similar to registerLocHdkA and registerHdkA. +-- +-- See Note [Adding Haddock comments to the syntax tree]. +registerTokenHdkA :: LHsToken tok GhcPs -> HdkA () +registerTokenHdkA (L l _) = HdkA (getTokenBufSpan l) (pure ()) + -- Modify the action of a HdkA computation. hoistHdkA :: (HdkM a -> HdkM b) -> HdkA a -> HdkA b hoistHdkA f (HdkA l m) = HdkA l (f m) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs ===================================== @@ -1,16 +1,16 @@ {-# LANGUAGE GADTs #-} {-# OPTIONS -haddock -ddump-parsed-ast #-} --- Haddock comments in this test case should all be rejected, but they are not. --- --- This is a known issue. Users should avoid writing comments in such --- positions, as a future fix will disallow them. +-- Haddock comments in this test case all are rejected. -- -- See Note [Register keyword location] in GHC.Parser.PostProcess.Haddock module -- | Bad comment for the module - T17544_kw where + T17544_kw ( + Foo(..), + Bar(..), + Cls(..)) where data Foo -- | Bad comment for MkFoo where MkFoo :: Foo ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr ===================================== @@ -10,8 +10,8 @@ { T17544_kw.hs:1:1 } (UnchangedAnchor)) (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:11:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:13-17 }))] + [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:8:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:12-16 }))] [] (Just ((,) @@ -23,33 +23,115 @@ (VirtualBraces (1)) (Nothing) - (Just - (L - { T17544_kw.hs:12:3-33 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:12:7-33 } - (HsDocStringChunk - " Bad comment for the module")) - [])) - [])))) + (Nothing)) (HsModTk (L (TokenLoc - (EpaSpan { T17544_kw.hs:11:1-6 })) + (EpaSpan { T17544_kw.hs:8:1-6 })) (HsTok)) (L (TokenLoc - (EpaSpan { T17544_kw.hs:13:13-17 })) + (EpaSpan { T17544_kw.hs:13:12-16 })) (HsTok))) (Just (L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-11 }) + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:10:3-11 }) {ModuleName: T17544_kw})) - (Nothing) + (Just + (L + (SrcSpanAnn (EpAnn + (Anchor + { T17544_kw.hs:(10,13)-(13,10) } + (UnchangedAnchor)) + (AnnList + (Nothing) + (Just + (AddEpAnn AnnOpenP (EpaSpan { T17544_kw.hs:10:13 }))) + (Just + (AddEpAnn AnnCloseP (EpaSpan { T17544_kw.hs:13:10 }))) + [] + []) + (EpaComments + [])) { T17544_kw.hs:(10,13)-(13,10) }) + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T17544_kw.hs:11:3-9 } + (UnchangedAnchor)) + (AnnListItem + [(AddCommaAnn + (EpaSpan { T17544_kw.hs:11:10 }))]) + (EpaComments + [])) { T17544_kw.hs:11:3-9 }) + (IEThingAll + (EpAnn + (Anchor + { T17544_kw.hs:11:3-5 } + (UnchangedAnchor)) + [(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:11:7-8 })) + ,(AddEpAnn AnnOpenP (EpaSpan { T17544_kw.hs:11:6 })) + ,(AddEpAnn AnnCloseP (EpaSpan { T17544_kw.hs:11:9 })) + ,(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:11:7-8 }))] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:11:3-5 }) + (IEName + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:11:3-5 }) + (Unqual + {OccName: Foo})))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T17544_kw.hs:12:3-9 } + (UnchangedAnchor)) + (AnnListItem + [(AddCommaAnn + (EpaSpan { T17544_kw.hs:12:10 }))]) + (EpaComments + [])) { T17544_kw.hs:12:3-9 }) + (IEThingAll + (EpAnn + (Anchor + { T17544_kw.hs:12:3-5 } + (UnchangedAnchor)) + [(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:12:7-8 })) + ,(AddEpAnn AnnOpenP (EpaSpan { T17544_kw.hs:12:6 })) + ,(AddEpAnn AnnCloseP (EpaSpan { T17544_kw.hs:12:9 })) + ,(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:12:7-8 }))] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:12:3-5 }) + (IEName + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:12:3-5 }) + (Unqual + {OccName: Bar})))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-9 }) + (IEThingAll + (EpAnn + (Anchor + { T17544_kw.hs:13:3-5 } + (UnchangedAnchor)) + [(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:13:7-8 })) + ,(AddEpAnn AnnOpenP (EpaSpan { T17544_kw.hs:13:6 })) + ,(AddEpAnn AnnCloseP (EpaSpan { T17544_kw.hs:13:9 })) + ,(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:13:7-8 }))] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-5 }) + (IEName + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-5 }) + (Unqual + {OccName: Cls}))))))])) [] [(L (SrcSpanAnn (EpAnn @@ -138,19 +220,7 @@ (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) (Unqual {OccName: Foo})))) - (Just - (L - { T17544_kw.hs:15:10-35 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:15:14-35 } - (HsDocStringChunk - " Bad comment for MkFoo")) - [])) - [])))))]) + (Nothing)))]) [])))) ,(L (SrcSpanAnn (EpAnn @@ -265,19 +335,7 @@ (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:24-26 }) (Unqual {OccName: Bar})))) - (Just - (L - { T17544_kw.hs:18:13-38 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:18:17-38 } - (HsDocStringChunk - " Bad comment for MkBar")) - [])) - [])))))) + (Nothing)))) [])))) ,(L (SrcSpanAnn (EpAnn @@ -378,20 +436,18 @@ []} [] [] - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:22:5-34 }) - (DocCommentNext - (L - { T17544_kw.hs:22:5-34 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:22:9-34 } - (HsDocStringChunk - " Bad comment for clsmethod")) - [])) - []))))])))])) + [])))])) + + + +T17544_kw.hs:9:3: warning: [GHC-94458] [-Winvalid-haddock] + A Haddock comment cannot appear in this position and will be ignored. + +T17544_kw.hs:15:10: warning: [GHC-94458] [-Winvalid-haddock] + A Haddock comment cannot appear in this position and will be ignored. +T17544_kw.hs:18:13: warning: [GHC-94458] [-Winvalid-haddock] + A Haddock comment cannot appear in this position and will be ignored. +T17544_kw.hs:22:5: warning: [GHC-94458] [-Winvalid-haddock] + A Haddock comment cannot appear in this position and will be ignored. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b70a58593bc0477fd90e0c0836fe9f837f7e169f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b70a58593bc0477fd90e0c0836fe9f837f7e169f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 08:35:19 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 30 May 2023 04:35:19 -0400 Subject: [Git][ghc/ghc][wip/testsuite-stack-size] testsuite: Pass -kb16k -kc128k for performance tests Message-ID: <6475b54761ced_2f379c2c4025144a@gitlab.mail> Matthew Pickering pushed to branch wip/testsuite-stack-size at Glasgow Haskell Compiler / GHC Commits: 21163368 by Matthew Pickering at 2023-05-30T09:34:22+01:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -1791,7 +1791,11 @@ async def simple_build(name: Union[TestName, str], stats_file = name + '.comp.stats' if isCompilerStatsTest(): - extra_hc_opts += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' + # Set a bigger chunk size to reduce variation due to additional under/overflowing + # The tests are attempting to test how much work the compiler is doing by proxy of + # bytes allocated. The additional allocations caused by stack overflow can cause + # spurious failures if you trip over the limit (see #23439) + extra_hc_opts += ' +RTS -kc128k -kb16k -V0 -t' + stats_file + ' --machine-readable -RTS' if backpack: extra_hc_opts += ' -outputdir ' + name + '.out' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/21163368a188eb8c692329afd744f81ecb5e2a9b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/21163368a188eb8c692329afd744f81ecb5e2a9b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 08:47:56 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 30 May 2023 04:47:56 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Tweaks Message-ID: <6475b83c44101_2f3796a499202539c5@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 2adee668 by Rodrigo Mesquita at 2023-05-30T09:47:50+01:00 Tweaks - - - - - 2 changed files: - hadrian/src/Builder.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs Changes: ===================================== hadrian/src/Builder.hs ===================================== @@ -433,7 +433,7 @@ systemBuilderPath builder = case builder of Ghc _ (Stage0 {}) -> fromKey "system-ghc" GhcPkg _ (Stage0 {}) -> fromKey "system-ghc-pkg" Happy -> fromKey "happy" - HsCpp -> fromKey "hs-cpp" + HsCpp -> fromTargetTC "hs-cpp" (Toolchain.hsCppProgram . tgtHsCPreprocessor) Ld _ -> fromTargetTC "ld" (Toolchain.ccLinkProgram . tgtCCompilerLink) -- MergeObjects Stage0 is a special case in case of -- cross-compiling. We're building stage1, e.g. code which will be ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -53,7 +53,7 @@ getEnv :: M Env getEnv = M $ lift Reader.ask makeM :: IO (Either [Error] a) -> M a -makeM io = M (Except.ExceptT (Reader.ReaderT (\env -> io))) +makeM io = M (Except.ExceptT (Reader.ReaderT (\_env -> io))) data Error = Error { errorMessage :: String , errorLogContexts :: [String] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2adee66879754dcc9308f5c8b4ee751afc2af3bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2adee66879754dcc9308f5c8b4ee751afc2af3bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 10:07:27 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 30 May 2023 06:07:27 -0400 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] 553 commits: Windows: Remove mingwex dependency Message-ID: <6475cadf57eb0_2f379c2cf427439@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 4a92480c by Vladislav Zavialov at 2023-05-30T12:06:55+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21cfded1b061bb1ad02537de0c8e8681a5c63f43...4a92480c0b1ed2ede04470b6c5e4c8f2c2a178d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21cfded1b061bb1ad02537de0c8e8681a5c63f43...4a92480c0b1ed2ede04470b6c5e4c8f2c2a178d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 10:27:21 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 30 May 2023 06:27:21 -0400 Subject: [Git][ghc/ghc][wip/js-th] JS: implement TH support Message-ID: <6475cf893b86_2f379c2c402823a6@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 51f52fbe by Sylvain Henry at 2023-05-30T12:32:45+02:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Types.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/ghc.cabal.in - + ghc-interp.js - hadrian/src/Base.hs - hadrian/src/Rules/Generate.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - libraries/template-haskell/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/annotations/should_compile/all.T - testsuite/tests/annotations/should_fail/all.T - testsuite/tests/annotations/should_run/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51f52fbe5d74ccf11dde3b4288aa296e5b87b59a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51f52fbe5d74ccf11dde3b4288aa296e5b87b59a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 10:59:16 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Tue, 30 May 2023 06:59:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/torsten.schmits/test-way-ghci-opt Message-ID: <6475d70461548_2f379c2c40295863@gitlab.mail> Torsten Schmits pushed new branch wip/torsten.schmits/test-way-ghci-opt at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/test-way-ghci-opt You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 11:06:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 May 2023 07:06:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Change GHC.Driver.Session import to .DynFlags Message-ID: <6475d8a7c1855_2f37927240dc3025bd@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - bdec1da2 by Ben Gamari at 2023-05-30T07:06:11-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 30 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Config/HsToCore.hs - compiler/GHC/Driver/Config/Linker.hs - compiler/GHC/Driver/Config/Stg/Debug.hs - compiler/GHC/Driver/Config/Stg/Lift.hs - compiler/GHC/Driver/Config/Stg/Pipeline.hs - compiler/GHC/Driver/Config/StgToJS.hs - compiler/GHC/Driver/Config/Tidy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24821bd7da1d2922c709567d07a3d66b58c90f8d...bdec1da2575588d0b7d04a76e45e826d43ec134b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24821bd7da1d2922c709567d07a3d66b58c90f8d...bdec1da2575588d0b7d04a76e45e826d43ec134b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 11:40:01 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 30 May 2023 07:40:01 -0400 Subject: [Git][ghc/ghc][wip/js-th] Don't use getKey Message-ID: <6475e091711b8_2f3791fc247e030827e@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 0e55f259 by Sylvain Henry at 2023-05-30T13:45:26+02:00 Don't use getKey - - - - - 3 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Context.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -659,9 +659,9 @@ gHC_RECORDS = mkBaseModule (fsLit "GHC.Records") rOOT_MAIN :: Module rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation -mkInteractiveModule :: Int -> Module --- (mkInteractiveMoudule 9) makes module 'interactive:Ghci9' -mkInteractiveModule n = mkModule interactiveUnit (mkModuleName ("Ghci" ++ show n)) +mkInteractiveModule :: String -> Module +-- (mkInteractiveMoudule "9") makes module 'interactive:Ghci9' +mkInteractiveModule n = mkModule interactiveUnit (mkModuleName ("Ghci" ++ n)) pRELUDE_NAME, mAIN_NAME :: ModuleName pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude") ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2585,7 +2585,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do -- guaranteed. -- -- We reuse the unique we obtained for the binding, but any unique would do. - let this_mod = mkInteractiveModule (getKey u) + let this_mod = mkInteractiveModule (show u) let for_bytecode = True (stg_binds, _prov_map, _collected_ccs, _stg_cg_infos) <- ===================================== compiler/GHC/Runtime/Context.hs ===================================== @@ -330,7 +330,7 @@ icReaderEnv = igre_env . ic_gre_cache icInteractiveModule :: InteractiveContext -> Module icInteractiveModule (InteractiveContext { ic_mod_index = index }) - = mkInteractiveModule index + = mkInteractiveModule (show index) -- | This function returns the list of visible TyThings (useful for -- e.g. showBindings). View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e55f2591487b685c599acc97a3a4357f9bf00f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e55f2591487b685c599acc97a3a4357f9bf00f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 14:15:10 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Tue, 30 May 2023 10:15:10 -0400 Subject: [Git][ghc/ghc][wip/t21766] 29 commits: Introduce GHCiMessage to wrap GhcMessage Message-ID: <647604ee6b653_2f3791fc247e033696e@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 5f2ffef1 by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5f1cf0e6 by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b820ef5c by Finley McIlwaine at 2023-05-30T14:15:06+00:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 98197fed by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 13f9eea3 by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Add note describing IPE data compression See ticket #21766 - - - - - 692251af by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - bb0846ed by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 4c4d6476 by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 9b7ad15d by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - ec4f79b1 by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 0c8f3c75 by Finley McIlwaine at 2023-05-30T14:15:06+00:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs - compiler/GHC/Driver/Config/Diagnostic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/220c546a0c9ee677400c92fe5cbf6fa5f381c1fd...0c8f3c75d1117670ef8d3d8d9b6e6c0e3805464e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/220c546a0c9ee677400c92fe5cbf6fa5f381c1fd...0c8f3c75d1117670ef8d3d8d9b6e6c0e3805464e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 15:59:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 30 May 2023 11:59:40 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] Configure CPP into settings Message-ID: <64761d6cb9756_2f37927240dc378366@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 417c37e0 by Rodrigo Mesquita at 2023-05-30T16:59:28+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 19 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -699,7 +699,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -82,15 +82,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" @@ -118,7 +121,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -171,10 +173,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -827,7 +827,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,9 +96,8 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) - | otherwise = GHC.SysTools.runCpp logger dflags args + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args + | otherwise = GHC.SysTools.runCpp logger tmpfs dflags args let platform = targetPlatform dflags targetArch = stringEncodeArch $ platformArch platform ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,38 +60,9 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env - -runPp :: Logger -> DynFlags -> [Option] -> IO () -runPp logger dflags args = traceSystoolCommand logger "pp" $ do - let prog = pgm_F dflags - opts = map Option (getOpts dflags opt_F) - runSomething logger "Haskell pre-processor" prog (args ++ opts) - --- | Run compiler of C-like languages and raw objects (such as gcc or clang). -runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO () -runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do - let args1 = map Option userOpts - args2 = languageOptions ++ args ++ args1 - -- We take care to pass -optc flags in args1 last to ensure that the - -- user can override flags passed by GHC. See #14452. - mb_env <- getGccEnv args2 - runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2 - mb_env - where - -- discard some harmless warnings from gcc that we can't turn off - cc_filter = unlines . doFilter . lines - +-- | Discard some harmless warnings from gcc that we can't turn off +cc_filter :: String -> String +cc_filter = unlines . doFilter . lines where {- gcc gives warnings in chunks like so: In file included from /foo/bar/baz.h:11, @@ -139,6 +110,49 @@ runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do | "warning: call-clobbered register used" `isContainedIn` w = False | otherwise = True +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () +runCpp logger tmpfs dflags args = traceSystoolCommand logger "cpp" $ do + let (p,args0) = pgm_cpp dflags + userOpts_c = map Option $ getOpts dflags opt_c + args2 = args0 ++ args ++ userOpts_c + mb_env <- getGccEnv args2 + runSomethingResponseFile logger tmpfs dflags cc_filter "C pre-processor" p + args2 mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do + let (p,args0) = pgm_P dflags + opts = getOpts dflags opt_P + modified_imports = augmentImports dflags opts + args1 = map Option modified_imports + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] + mb_env <- getGccEnv args2 -- romes: what about args0 and args? + runSomethingFiltered logger id "Haskell C pre-processor" p + (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + +runPp :: Logger -> DynFlags -> [Option] -> IO () +runPp logger dflags args = traceSystoolCommand logger "pp" $ do + let prog = pgm_F dflags + opts = map Option (getOpts dflags opt_F) + runSomething logger "Haskell pre-processor" prog (args ++ opts) + +-- | Run compiler of C-like languages and raw objects (such as gcc or clang). +runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO () +runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do + let args1 = map Option userOpts + args2 = languageOptions ++ args ++ args1 + -- We take care to pass -optc flags in args1 last to ensure that the + -- user can override flags passed by GHC. See #14452. + mb_env <- getGccEnv args2 + runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2 + mb_env + where -- force the C compiler to interpret this file as C when -- compiling .hc files, by adding the -x c option. -- Also useful for plain .c files, just in case GHC saw a ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -663,6 +663,16 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1230,6 +1240,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -223,6 +223,16 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -86,6 +86,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -258,6 +258,8 @@ TablesNextToCode = @TablesNextToCode@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsCxxCompilerCommand = @SettingsCxxCompilerCommand@ +SettingsCPPCommand = @SettingsCPPCommand@ +SettingsCPPFlags = @SettingsCPPFlags@ SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -146,6 +143,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -81,7 +81,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -92,7 +91,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -107,6 +105,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -191,7 +191,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -204,6 +203,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -418,6 +418,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,63 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +# --with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]. + If you set --with-cpp=CC, ensure -E is included in --with-cpp-flags])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) + +$2="$CPP_CMD" +$3="$CPP_ARGS" -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +# Clear CPP_CMD and CPP_ARGS +unset CPP_CMD +unset CPP_ARGS ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" @@ -35,6 +37,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -107,6 +111,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/417c37e0d648ddc8420df19dd449adb17f845bf0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/417c37e0d648ddc8420df19dd449adb17f845bf0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 16:27:57 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 30 May 2023 12:27:57 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: Remove more settings bits from hadrian/cfg Message-ID: <6476240d83e13_2f379244576ac383848@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 37aa0f13 by Rodrigo Mesquita at 2023-05-30T10:43:58+01:00 Remove more settings bits from hadrian/cfg - - - - - 188f60e3 by Rodrigo Mesquita at 2023-05-30T17:27:11+01:00 Use llvm target from ghc-toolchain - - - - - cdb184e4 by Rodrigo Mesquita at 2023-05-30T17:27:50+01:00 Print default.target - - - - - 10 changed files: - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/stack.yaml - m4/ghc_toolchain.m4 - mk/project.mk.in - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs Changes: ===================================== hadrian/cfg/system.config.in ===================================== @@ -11,11 +11,8 @@ cc = @CC@ happy = @HappyCmd@ ld = @LD@ make = @MakeCmd@ -system-merge-objects = @LD_STAGE0@ objdump = @ObjdumpCmd@ sphinx-build = @SPHINXBUILD@ -system-ar = @AR_STAGE0@ -system-cc = @CC_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -34,16 +31,12 @@ python = @PythonCmd@ # Information about builders: #============================ -system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@ -system-ar-supports-dash-l = @ArSupportsDashL_STAGE0@ cc-llvm-backend = @CcLlvmBackend@ # Build options: #=============== -use-libffi-for-adjustors = @UseLibffiForAdjustors@ ghc-source-path = @hardtop@ -leading-underscore = @LeadingUnderscore@ # Information about build, host and target systems: #================================================== @@ -59,7 +52,6 @@ host-vendor = @HostVendor_CPP@ target-platform = @TargetPlatform@ target-platform-full = @TargetPlatformFull@ target-vendor = @TargetVendor_CPP@ -llvm-target = @LLVMTarget_CPP@ cross-compiling = @CrossCompiling@ @@ -89,21 +81,7 @@ project-git-commit-id = @ProjectGitCommitId@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -# ROMES:TODO: Drop almost every of these from settings. -settings-c-compiler-command = @SettingsCCompilerCommand@ -settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ -settings-cpp-command = @SettingsCPPCommand@ -settings-cpp-flags = @SettingsCPPFlags@ -settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ -settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ -settings-c-compiler-flags = @SettingsCCompilerFlags@ -settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ -settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ -settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ -settings-merge-objects-command = @SettingsMergeObjectsCommand@ -settings-merge-objects-flags = @SettingsMergeObjectsFlags@ -settings-ar-command = @SettingsArCommand@ -settings-ranlib-command = @SettingsRanlibCommand@ +# ROMES:TODO: Get rid of some of these settings completely? settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ @@ -114,8 +92,6 @@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ settings-use-distro-mingw = @SettingsUseDistroMINGW@ -target-word-size = @TargetWordSize@ -target-word-big-endian = @TargetWordBigEndian@ target-has-libm = @TargetHasLibm@ # Include and library directories: ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -70,7 +70,7 @@ flag f = do UseSystemFfi -> SystemConfigKey "use-system-ffi" BootstrapThreadedRts -> SystemConfigKey "bootstrap-threaded-rts" BootstrapEventLoggingRts -> SystemConfigKey "bootstrap-event-logging-rts" - UseLibffiForAdjustors -> SystemConfigKey "use-libffi-for-adjustors" + UseLibffiForAdjustors -> HostTargetKey tgtUseLibffiForAdjustors UseLibdw -> SystemConfigKey "use-lib-dw" UseLibnuma -> SystemConfigKey "use-lib-numa" UseLibm -> SystemConfigKey "use-lib-m" ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -149,7 +149,7 @@ setting key = case key of LibdwLibDir -> systemConf "libdw-lib-dir" LibnumaIncludeDir -> systemConf "libnuma-include-dir" LibnumaLibDir -> systemConf "libnuma-lib-dir" - LlvmTarget -> systemConf "llvm-target" + LlvmTarget -> targetConf tgtLlvmTarget ProjectGitCommitId -> systemConf "project-git-commit-id" ProjectName -> systemConf "project-name" ProjectVersion -> systemConf "project-version" @@ -167,7 +167,7 @@ setting key = case key of TargetVendor -> systemConf "target-vendor" TargetArchHaskell -> targetConf (show . archHaskell) TargetOsHaskell -> targetConf (show . osHaskell) - TargetWordSize -> systemConf "target-word-size" -- targetConf tgtWordSize + TargetWordSize -> targetConf (show . wordSize2Bytes . tgtWordSize) BourneShell -> systemConf "bourne-shell" where systemConf = lookupSystemConfig ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -23,6 +23,7 @@ import Target import Utilities import qualified GHC.Toolchain as Toolchain +import GHC.Toolchain (Endianness(..), wordSize2Bytes) import GHC.Toolchain.Program (prgFlags) -- | Track this file to rebuild generated files whenever it changes. @@ -448,8 +449,8 @@ generateSettings = do , ("target platform string", getSetting TargetPlatform) , ("target os", getSetting TargetOsHaskell) , ("target arch", getSetting TargetArchHaskell) - , ("target word size", expr $ lookupSystemConfig "target-word-size") - , ("target word big endian", expr $ lookupSystemConfig "target-word-big-endian") + , ("target word size", expr $ queryTargetTargetConfig wordSize) + , ("target word big endian", expr $ queryTargetTargetConfig isBigEndian) , ("target has GNU nonexec stack", expr $ queryTargetTargetConfig (yesNo . Toolchain.tgtSupportsGnuNonexecStack)) , ("target has .ident directive", expr $ queryTargetTargetConfig (yesNo . Toolchain.tgtSupportsIdentDirective)) , ("target has subsections via symbols", expr $ queryTargetTargetConfig (yesNo . Toolchain.tgtSupportsSubsectionsViaSymbols)) @@ -482,6 +483,8 @@ generateSettings = do linkSupportsCompactUnwind = yesNo . Toolchain.ccLinkSupportsCompactUnwind . Toolchain.tgtCCompilerLink linkIsGnu = yesNo . Toolchain.ccLinkIsGnu . Toolchain.tgtCCompilerLink arFlags = unwords . prgFlags . Toolchain.arMkArchive . Toolchain.tgtAr + isBigEndian = yesNo . (\case BigEndian -> True; LittleEndian -> False) . Toolchain.tgtEndianness + wordSize = show . wordSize2Bytes . Toolchain.tgtWordSize ===================================== hadrian/stack.yaml ===================================== @@ -2,6 +2,7 @@ resolver: lts-19.8 packages: - '.' +- 'utils/ghc-toolchain' nix: enable: false @@ -12,3 +13,4 @@ nix: - git - ncurses - perl + - ghc-toolchain ===================================== m4/ghc_toolchain.m4 ===================================== @@ -65,6 +65,9 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], python3 -c 'import sys; print(sys.argv)' "[$]@" ) M Target mkTarget opts = do - cc0 <- findCc (optCc opts) + let tgtLlvmTarget = optTriple opts + cc0 <- findCc tgtLlvmTarget (optCc opts) cxx <- findCxx (optCxx opts) cpp <- findCpp (optCpp opts) cc0 hsCpp <- findHsCpp (optHsCpp opts) cc0 @@ -325,7 +326,6 @@ mkTarget opts = do tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc - let tgtLlvmTarget = optTriple opts -- code generator configuration tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -41,7 +41,6 @@ data Target = Target -- GHC capabilities , tgtUnregisterised :: Bool , tgtTablesNextToCode :: Bool - -- , tgtHasRtsLinker :: Bool -- NO NEED! Rebase on MR removing it. -- , tgtHasThreadedRts :: Bool -- Do we need this for each target? Or just when bootstrapping? , tgtUseLibffiForAdjustors :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it @@ -63,3 +62,8 @@ data Target = Target } deriving (Show, Read, Eq, Ord) +-- | The word size as an integer representing the number of bytes +wordSize2Bytes :: WordSize -> Int +wordSize2Bytes WS4 = 4 +wordSize2Bytes WS8 = 8 + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -28,10 +28,12 @@ newtype Cc = Cc { ccProgram :: Program _ccProgram :: Lens Cc Program _ccProgram = Lens ccProgram (\x o -> o{ccProgram=x}) -findCc :: ProgOpt -> M Cc -findCc progOpt = checking "for C compiler" $ do +findCc :: String -- ^ The llvm target to use if Cc supports --target + -> ProgOpt -> M Cc +findCc llvmTarget progOpt = checking "for C compiler" $ do ccProgram <- findProgram "C compiler" progOpt ["cc", "clang", "gcc"] - cc <- ignoreUnusedArgs $ Cc {ccProgram} + cc' <- ignoreUnusedArgs $ Cc {ccProgram} + cc <- supportsTarget llvmTarget cc' checkCcWorks cc checkC99Support cc checkCcSupportsExtraViaCFlags cc @@ -56,6 +58,15 @@ ignoreUnusedArgs cc = checking "for -Qunused-arguments support" $ do let cc' = over (_ccProgram % _prgFlags) (++["-Qunused-arguments"]) cc (cc' <$ checkCcWorks cc') <|> return cc +-- Does CC support the --target= option? If so, we should pass it +-- whenever possible to avoid ambiguity and potential compile-time errors (e.g. +-- see #20162). +supportsTarget :: String -- ^ The llvm target to use if Cc supports --target + -> Cc -> M Cc +supportsTarget llvmTarget cc = checking "whether Cc supports --target" $ do + let cc' = over (_ccProgram % _prgFlags) (++["--target="++llvmTarget]) cc + (cc' <$ checkCcWorks cc') <|> return cc + checkC99Support :: Cc -> M () checkC99Support cc = checking "for C99 support" $ withTempDir $ \dir -> do let test_o = dir "test.o" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2adee66879754dcc9308f5c8b4ee751afc2af3bc...cdb184e4b5be33fa4d9aa9eb9bd485d852d87aa1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2adee66879754dcc9308f5c8b4ee751afc2af3bc...cdb184e4b5be33fa4d9aa9eb9bd485d852d87aa1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 17:07:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 May 2023 13:07:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: testsuite: Pass -kb16k -kc128k for performance tests Message-ID: <64762d3b503ac_2f379244576ac395186@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f7f9e4e7 by Matthew Pickering at 2023-05-30T13:06:59-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - f6f46fc6 by Ben Gamari at 2023-05-30T13:06:59-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 10 changed files: - compiler/GHC/Settings/IO.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_gcc_extra_flags.m4 - + m4/fp_gcc_supports_via_c_flags.m4 - testsuite/driver/testlib.py Changes: ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -76,7 +76,6 @@ initSettings top_dir = do getToolSetting :: String -> ExceptT SettingsError m String getToolSetting key = expandToolDir useInplaceMinGW mtool_dir <$> getSetting key targetPlatformString <- getSetting "target platform string" - myExtraGccViaCFlags <- getSetting "GCC extra via C opts" cc_prog <- getToolSetting "C compiler command" cxx_prog <- getToolSetting "C++ compiler command" cc_args_str <- getToolSetting "C compiler flags" @@ -93,6 +92,16 @@ initSettings top_dir = do cpp_args = map Option (words cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str + + -- The extra flags we need to pass gcc when we invoke it to compile .hc code. + -- + -- -fwrapv is needed for gcc to emit well-behaved code in the presence of + -- integer wrap around (#952). + extraGccViaCFlags = if platformUnregisterised platform + -- configure guarantees cc support these flags + then ["-fwrapv", "-fno-builtin"] + else [] + ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" @@ -204,7 +213,7 @@ initSettings top_dir = do , toolSettings_opt_lc = [] , toolSettings_opt_i = [] - , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags + , toolSettings_extraGccViaCFlags = extraGccViaCFlags } , sTargetPlatform = platform ===================================== configure.ac ===================================== @@ -622,14 +622,15 @@ FP_GCC_VERSION dnl ** See whether cc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +dnl ** Check support for the extra flags passed by GHC when compiling via C +FP_GCC_SUPPORTS_VIA_C_FLAGS + dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on dnl RISCV64 GCC. FP_CC_SUPPORTS__ATOMICS -FP_GCC_EXTRA_FLAGS - dnl ** look to see if we have a C compiler using an llvm back end. dnl FP_CC_LLVM_BACKEND ===================================== distrib/configure.ac.in ===================================== @@ -164,7 +164,7 @@ AC_SUBST([OptCmd]) dnl ** Check gcc version and flags we need to pass it ** FP_GCC_VERSION FP_GCC_SUPPORTS_NO_PIE -FP_GCC_EXTRA_FLAGS +FP_GCC_SUPPORTS_VIA_C_FLAGS FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) ===================================== hadrian/bindist/Makefile ===================================== @@ -79,8 +79,7 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ - @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ + @echo '[("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ @echo ',("C++ compiler command", "$(SettingsCxxCompilerCommand)")' >> $@ @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -234,7 +234,6 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -137,7 +137,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -411,8 +411,7 @@ generateSettings :: Expr String generateSettings = do ctx <- getContext settings <- traverse sequence $ - [ ("GCC extra via C opts", expr $ lookupSystemConfig "gcc-extra-via-c-opts") - , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) + [ ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) , ("C++ compiler command", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerCommand) , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) ===================================== m4/fp_gcc_extra_flags.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_GCC_EXTRA_FLAGS -# ------------------ -# Determine which extra flags we need to pass gcc when we invoke it -# to compile .hc code. -# -# -fwrapv is needed for gcc to emit well-behaved code in the presence of -# integer wrap around. (#952) -# -AC_DEFUN([FP_GCC_EXTRA_FLAGS], -[AC_REQUIRE([FP_GCC_VERSION]) -AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts], -[ - if test "$Unregisterised" = "YES"; then - # These used to be conditioned on gcc version but we no longer support - # GCC versions which lack support for these flags - fp_cv_gcc_extra_opts="-fwrapv -fno-builtin" - fi -]) -AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) -]) ===================================== m4/fp_gcc_supports_via_c_flags.m4 ===================================== @@ -0,0 +1,17 @@ +# FP_GCC_SUPPORTS_VIA_C_FLAGS +# --------------------------- +# Make sure GCC supports the flags passed by GHC when compiling via C +AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C]) + echo 'int main() { return 0; }' > conftest.c + if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + AC_MSG_ERROR([gcc must support the flags -fwrapv and -fno-builtin]) + fi + rm -f conftest.c conftest.o conftest +]) + ===================================== testsuite/driver/testlib.py ===================================== @@ -1791,7 +1791,11 @@ async def simple_build(name: Union[TestName, str], stats_file = name + '.comp.stats' if isCompilerStatsTest(): - extra_hc_opts += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' + # Set a bigger chunk size to reduce variation due to additional under/overflowing + # The tests are attempting to test how much work the compiler is doing by proxy of + # bytes allocated. The additional allocations caused by stack overflow can cause + # spurious failures if you trip over the limit (see #23439) + extra_hc_opts += ' +RTS -kc128k -kb16k -V0 -t' + stats_file + ' --machine-readable -RTS' if backpack: extra_hc_opts += ' -outputdir ' + name + '.out' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdec1da2575588d0b7d04a76e45e826d43ec134b...f6f46fc6479890d07e5c215e40cc3bd6a954a9d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdec1da2575588d0b7d04a76e45e826d43ec134b...f6f46fc6479890d07e5c215e40cc3bd6a954a9d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 17:40:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 30 May 2023 13:40:30 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 36 commits: Move via-C flags into GHC Message-ID: <6476350ec5d73_2f379c2cf44089f8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 98933a81 by Ben Gamari at 2023-05-30T18:27:10+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - dc639ee5 by Ben Gamari at 2023-05-30T18:27:10+01:00 ghc-toolchain: Initial commit - - - - - 0ed861bd by Ben Gamari at 2023-05-30T18:27:10+01:00 Rip out runtime linker/compiler checks - - - - - f912c4f9 by Ben Gamari at 2023-05-30T18:27:10+01:00 configure: Rip out toolchain selection logic - - - - - b1836d31 by Ben Gamari at 2023-05-30T18:27:10+01:00 Fixes - - - - - 61304d56 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. - - - - - 341e6a89 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Re-introduce ld-override option - - - - - 925784de by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 ghc-toolchain library and usage in hadrian flags - - - - - 41fec247 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Re-introduce flags in hadrian config - - - - - 71884db6 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist - - - - - 9ca9fb0e by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Handle passing CPP cmd and flags from configure to ghc-toolchain - - - - - d1603cd2 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Rip more of configure that is no longer being used - - - - - 7e36516a by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code - - - - - 59abac81 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Rip out more from hadrians system.config.in - - - - - f7206ebb by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Configure CLink supports response files - - - - - 6f74ef31 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Read deleted keys from host and target's target - - - - - d50699f6 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. - - - - - 0ba90dba by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] - - - - - 5451a941 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Handle unspecified vs specified flags and commands better - - - - - 6f878979 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Configure Cpp and HsCpp separately - - - - - 64d2d696 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Fixes for compilation - - - - - b8c03ff5 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Link is GNU linkerg - - - - - 681a44f1 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. - - - - - c9dbc76b by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... - - - - - 858a0194 by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 helper AC function for enable/disable - - - - - b97ce5bd by Rodrigo Mesquita at 2023-05-30T18:27:10+01:00 Delete unused imports of SysTools.Info - - - - - 120f82c5 by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Drop PROG_CPP in distrib/autoconf too - - - - - 58caa344 by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Get rid of MonadCatch instances and dependencies - - - - - de4bb9ea by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 ghc-toolchain: Check Cc supports extra-via-c-flags - - - - - 4c27d354 by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Consider empty programs as non-specified programs - - - - - 7b10379b by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Cpp and HsCpp cleanup - - - - - ac6fedb6 by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Add comment from check for gold t22266 - - - - - 4f652366 by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Stop configuring into settings unused Ld command - - - - - 34b5f21b by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Remove more settings bits from hadrian/cfg - - - - - fbc5d5e4 by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Use llvm target from ghc-toolchain - - - - - 08be70b9 by Rodrigo Mesquita at 2023-05-30T18:28:30+01:00 Print default.target - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cdb184e4b5be33fa4d9aa9eb9bd485d852d87aa1...08be70b93696b84bfab9afdfa2f30549fe21b06e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cdb184e4b5be33fa4d9aa9eb9bd485d852d87aa1...08be70b93696b84bfab9afdfa2f30549fe21b06e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 17:55:50 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Tue, 30 May 2023 13:55:50 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] WIP: MO_S_MulMayOflo Message-ID: <647638a64f7b_2f379c2cf441174c@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: a9c3b295 by Sven Tennie at 2023-05-30T19:55:40+02:00 WIP: MO_S_MulMayOflo - - - - - 6 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -946,38 +946,110 @@ getRegister' config plat expr isNbitEncodeable :: Int -> Integer -> Bool isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) -- N.B. MUL does not set the overflow flag. + -- Return 0 when the operation cannot overflow, /= 0 otherwise do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + do_mul_may_oflo w _x _y | w > W64 = pprPanic "Cannot multiply larger than 64bit" (ppr w) do_mul_may_oflo w at W64 x y = do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - lo <- getNewRegNat II64 - hi <- getNewRegNat II64 - return $ Any (intFormat w) (\dst -> - code_x `appOL` - code_y `snocOL` - MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CSET (OpReg w dst) (OpReg w hi) (OpRegShift w lo SASR 63) NE) + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + -- TODO: Can't we clobber reg_x and reg_y to save registers? + lo <- getNewRegNat II64 + hi <- getNewRegNat II64 + -- TODO: Overhaul CSET: 3rd operand isn't needed for SNEZ + let nonSense = OpImm (ImmInt 0) + pure $ + Any + (intFormat w) + ( \dst -> + code_x + `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W64 reg_x reg_y + `appOL` toOL + [ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)), + MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y), + ASR (OpReg w lo) (OpReg w reg_x) (OpImm (ImmInt (widthInBits W64 - 1))), + ann + (text "Set flag if result of MULH contains more than sign bits.") + (SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)), + CSET (OpReg w dst) (OpReg w hi) nonSense NE + ] + ) do_mul_may_oflo w x y = do - (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, format_y, code_y) <- getSomeReg y - let mul = case w of - W32 -> SMULL - W16 -> MUL - W8 -> MUL - _ -> panic "do_mul_may_oflo: impossible" - wx' = max (formatToWidth format_x) w - wy' = max (formatToWidth format_y) w - return $ Any (intFormat w) (\dst -> - code_x `appOL` - signExtend (formatToWidth format_x) wx' reg_x reg_x `appOL` - code_y `appOL` - signExtend (formatToWidth format_y) wy' reg_y reg_y `snocOL` - mul (OpReg w dst) (OpReg wx' reg_x) (OpReg wy' reg_y) - ) - -- TODO: Handle overflow - -- `snocOL` - -- CSET (OpReg w dst) (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) NE) + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + let width_x = formatToWidth format_x + width_y = formatToWidth format_y + if w > width_x && w > width_y + then + pure $ + Any + (intFormat w) + ( \dst -> + -- 8bit * 8bit cannot overflow 16bit + -- 16bit * 16bit cannot overflow 32bit + -- 32bit * 32bit cannot overflow 64bit + unitOL $ annExpr expr (ADD (OpReg w dst) zero (OpImm (ImmInt 0))) + ) + else do + let use32BitMul = width_x <= W32 && width_y <= W32 + nonSense = OpImm (ImmInt 0) + if use32BitMul + then do + narrowedReg <- getNewRegNat II64 + pure $ + Any + (intFormat w) + ( \dst -> + code_x + `appOL` signExtend (formatToWidth format_x) W32 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W32 reg_y reg_y + `snocOL` annExpr expr (MUL (OpReg W32 dst) (OpReg W32 reg_x) (OpReg W32 reg_y)) + `appOL` signExtend W32 w dst narrowedReg + `appOL` toOL + [ ann + (text "Check if the multiplied value fits in the narrowed register") + (SUB (OpReg w dst) (OpReg w dst) (OpReg w narrowedReg)), + CSET (OpReg w dst) (OpReg w dst) nonSense NE + ] + ) + else do + -- TODO: Can't we clobber reg_x and reg_y to save registers? + lo <- getNewRegNat II64 + hi <- getNewRegNat II64 + narrowedLo <- getNewRegNat II64 + + -- TODO: Overhaul CSET: 3rd operand isn't needed for SNEZ + let nonSense = OpImm (ImmInt 0) + pure $ + Any + (intFormat w) + ( \dst -> + code_x + `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W64 reg_x reg_y + `appOL` toOL + [ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)), + MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y), + ASR (OpReg w lo) (OpReg w reg_x) (OpImm (ImmInt (widthInBits W64 - 1))), + ann + (text "Set flag if result of MULH contains more than sign bits.") + (SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)), + CSET (OpReg w hi) (OpReg w hi) nonSense NE + ] + `appOL` signExtend W64 w lo narrowedLo + `appOL` toOL + [ ann + (text "Check if the multiplied value fits in the narrowed register") + (SUB (OpReg w narrowedLo) (OpReg w lo) (OpReg w narrowedLo)), + CSET (OpReg w narrowedLo) (OpReg w narrowedLo) nonSense NE, + ann + (text "Combine both overflow flags") + (OR (OpReg w dst) (OpReg w narrowedLo) (OpReg w hi)) + ] + ) -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -602,6 +602,7 @@ data Instr | DIV Operand Operand Operand -- rd = rn ÷ rm | REM Operand Operand Operand -- rd = rn % rm + -- TODO: Rename: MULH | SMULH Operand Operand Operand | SMULL Operand Operand Operand ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -466,7 +466,7 @@ pprInstr platform instr = case instr of MUL o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul") o1 o2 o3 | otherwise -> op3 (text "\tmul") o1 o2 o3 - SMULH o1 o2 o3 -> op3 (text "\tsmulh") o1 o2 o3 + SMULH o1 o2 o3 -> op3 (text "\tmulh") o1 o2 o3 SMULL o1 o2 o3 -> op3 (text "\tsmull") o1 o2 o3 NEG o1 o2 | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfneg") o1 o2 ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE GHCForeignImportPrim, MagicHash, UnliftedFFITypes #-} + +module Main where +import GHC.Exts + +foreign import prim "runCmmzh" runCmm# :: Int# -> Int# + +main :: IO () +main = (print . show) (I# (runCmm# 0#)) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm ===================================== @@ -0,0 +1,4 @@ +runCmmzh() { + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,3 +229,8 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) + +test('MulMayOflo', + [ omit_ways(['ghci']), js_skip], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9c3b295b322d48b8d5143a5eb3beb8a471674b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9c3b295b322d48b8d5143a5eb3beb8a471674b1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 18:25:39 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 30 May 2023 14:25:39 -0400 Subject: [Git][ghc/ghc][wip/expand-do] more error context changes Message-ID: <64763fa3e5d96_2f37927240dc4143d8@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: a7c93859 by Apoorv Ingle at 2023-05-30T13:25:19-05:00 more error context changes - - - - - 6 changed files: - compiler/GHC/Hs/Utils.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - testsuite/tests/ghc-api/T18522-dbg-ppr.hs - − testsuite/tests/rebindable/pattern-fails - − testsuite/tests/typecheck/should_run/Typeable1 Changes: ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -282,7 +282,7 @@ mkHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) mkHsLamDoExp pats body = mkHsPar (noLocA $ HsLam noExtField matches) where matches = mkMatchGroup (Generated DoExpansion) - (noLocA [mkSimpleMatch LambdaExpr pats' body]) + (noLocA [mkSimpleMatch (StmtCtxt (HsDoStmt (DoExpr Nothing))) pats' body]) pats' = map (parenthesizePat appPrec) pats mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -418,9 +418,10 @@ tcExpr (HsMultiIf _ alts) res_ty tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt , text "expr:" <+> ppr expr - , text "res_ty" <+> ppr res_ty ]) + , text "res_ty" <+> ppr res_ty + ]) ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - tcExpr (unLoc expr) res_ty + tcApp (unLoc expr) res_ty } tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -267,6 +267,7 @@ tcMatch ctxt pat_tys rhs_ty match add_match_ctxt match thing_inside = case mc_what ctxt of LambdaExpr -> thing_inside + StmtCtxt (HsDoStmt{}) -> thing_inside -- this is an expanded do stmt _ -> addErrCtxt (pprMatchInCtxt match) thing_inside ------------- @@ -1249,11 +1250,11 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) -- ------------------------------------------------------- -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts - expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ genPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e) - , expr - ] + expr <- mk_failable_lexpr_tcm pat (noLocA $ mkExpandedStmt stmt expand_stmts) fail_op + return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) + [ genPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e) + , genPopSrcSpanExpr expr + ]) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) @@ -1339,10 +1340,14 @@ expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = } where do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) - do_arg (ApplicativeArgOne mb_fail_op pat expr _) = - return ((pat, mb_fail_op), expr) - do_arg (ApplicativeArgMany _ stmts ret pat _) = - do { expr <- expand_do_stmts do_or_lc $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] + do_arg (ApplicativeArgOne + { xarg_app_arg_one = mb_fail_op + , app_arg_pattern = pat@(L loc _) + , arg_expr = rhs + }) = + return ((pat, mb_fail_op), wrapGenSpan (mkExpandedStmt (L loc (BindStmt xbsn pat rhs)) rhs)) + do_arg (ApplicativeArgMany _ stmts ret pat ctxt) = + do { expr <- expand_do_stmts ctxt $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] ; return ((pat, Nothing), expr) } match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) @@ -1353,6 +1358,9 @@ expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = SyntaxExprRn op -> mkHsApps (wrapGenSpan op) [l_expr, r_expr] NoSyntaxExprRn -> pprPanic "expand_do_stmts op:" (ppr op) + xbsn :: XBindStmtRn + xbsn = XBindStmtRn NoSyntaxExprRn Nothing + expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) @@ -1374,7 +1382,7 @@ mk_failable_lexpr_tcm pat lexpr fail_op = ; if irrf_pat -- don't decorate with fail statement if -- the pattern is irrefutable - then return $ mkHsLamDoExp [pat] (genPopSrcSpanExpr lexpr) + then return $ mkHsLamDoExp [pat] lexpr else mk_fail_lexpr pat lexpr fail_op } @@ -1385,7 +1393,7 @@ mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsEx mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ - (wrapGenSpan [ mkHsCaseAltDoExp pat (genPopSrcSpanExpr lexpr) -- pat -> expr + (wrapGenSpan [ mkHsCaseAltDoExp pat lexpr -- pat -> expr , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" (wrapGenSpan $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) ])) ===================================== testsuite/tests/ghc-api/T18522-dbg-ppr.hs ===================================== @@ -44,7 +44,7 @@ main = do forall (a :: k) (b :: j) -> () |] let hs_t = fromRight (error "convertToHsType") $ - convertToHsType Generated noSrcSpan th_t + convertToHsType (Generated OtherExpansion) noSrcSpan th_t (messages, mres) <- tcRnType hsc_env SkolemiseFlexi True hs_t let (warnings, errors) = partitionMessages messages ===================================== testsuite/tests/rebindable/pattern-fails deleted ===================================== Binary files a/testsuite/tests/rebindable/pattern-fails and /dev/null differ ===================================== testsuite/tests/typecheck/should_run/Typeable1 deleted ===================================== Binary files a/testsuite/tests/typecheck/should_run/Typeable1 and /dev/null differ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7c938593d090e67b98efe98c299f512dfd66067 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7c938593d090e67b98efe98c299f512dfd66067 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 18:58:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 30 May 2023 14:58:17 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Fix bugs in MergeTool and Ar Message-ID: <64764749e8dd_2f37916db33e4420055@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 5705030f by Rodrigo Mesquita at 2023-05-30T19:58:11+01:00 Fix bugs in MergeTool and Ar - - - - - 5 changed files: - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs Changes: ===================================== m4/ghc_toolchain.m4 ===================================== @@ -61,7 +61,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], while read -r arg; do set -- "[$]@" "$arg" done - ./acghc-toolchain "[$]@" || exit 1 + ./acghc-toolchain -v2 "[$]@" || exit 1 python3 -c 'import sys; print(sys.argv)' "[$]@" ) M () ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -73,9 +73,9 @@ checkArWorks prog = checking "that ar works" $ withTempDir $ \dir -> do checkArSupportsDashL :: Program -> M Bool checkArSupportsDashL bareAr = checking "that ar supports -L" $ withTempDir $ \dir -> do let file ext = dir "conftest" <.> ext - archive1 = dir "conttest-a.a" - archive2 = dir "conttest-b.a" - merged = dir "conttest.a" + archive1 = dir "conftest-a.a" + archive2 = dir "conftest-b.a" + merged = dir "conftest.a" mapM_ (createFile . file) ["file", "a0", "a1", "b0", "b1"] -- Build two archives, merge them, and check that the -- result contains the original files rather than the two @@ -85,7 +85,7 @@ checkArSupportsDashL bareAr = checking "that ar supports -L" $ withTempDir $ \di oneOf "trying -L" [ do callProgram bareAr ["qcL", merged, archive1, archive2] contents <- readProgramStdout bareAr ["t", merged] - return $ not $ "conftest.a1" `isInfixOf` contents + return $ "conftest.a1" `isInfixOf` contents , return False ] @@ -102,3 +102,4 @@ checkArSupportsAtFile bareAr mkArchive = checking "that ar supports @-files" $ w if lines contents == objs then return True else logDebug "Contents didn't match" >> return False + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -33,8 +33,8 @@ checkMergingWorks :: Cc -> Nm -> MergeObjs -> M () checkMergingWorks cc nm mergeObjs = checking "whether object merging works" $ withTempDir $ \dir -> do let fo s = dir s <.> "o" - compileC cc (fo "a") "void funA(int x) { return x; }" - compileC cc (fo "b") "void funB(int x) { return x; }" + compileC cc (fo "a") "int funA(int x) { return x; }" + compileC cc (fo "b") "int funB(int x) { return x; }" callProgram (mergeObjsProgram mergeObjs) [fo "a", fo "b", "-o", fo "out"] out <- readProgramStdout (nmProgram nm) [fo "out"] let ok = all (`isInfixOf` out) ["funA", "funB"] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5705030f926b28496a7df4fa33587f6e2de05fda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5705030f926b28496a7df4fa33587f6e2de05fda You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 19:00:40 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 30 May 2023 15:00:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/cleanup-selfboot Message-ID: <647647d877fa6_2f3792760d804420553@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/cleanup-selfboot at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/cleanup-selfboot You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 19:09:55 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 30 May 2023 15:09:55 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Add check and log errors on error Message-ID: <64764a03212ed_2f3792946deac4240dc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 0867fd34 by Rodrigo Mesquita at 2023-05-30T20:09:49+01:00 Add check and log errors on error - - - - - 2 changed files: - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs Changes: ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -5,6 +5,7 @@ module Main where import Control.Monad import Data.Char (toUpper) +import Data.Maybe (isNothing) import System.Exit import System.Console.GetOpt import System.Environment @@ -310,7 +311,8 @@ mkTarget opts = do nm <- findNm (optNm opts) mergeObjs <- optional $ findMergeObjs (optMergeObjs opts) cc ccLink nm - -- TODO: Either mergeObjs or -L capable ar + when (isNothing mergeObjs && not (arSupportsDashL ar)) $ + throwE "Neither a merge object tool nor an ar that supports -L is available" -- Windows-specific utilities (windres, dllwrap) <- ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -63,6 +63,7 @@ data Error = Error { errorMessage :: String throwE :: String -> M a throwE msg = do e <- getEnv + logInfo msg let err = Error { errorMessage = msg , errorLogContexts = logContexts e } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0867fd34b691ae3dd357bdeb4df956ffe4571162 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0867fd34b691ae3dd357bdeb4df956ffe4571162 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 19:18:16 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 30 May 2023 15:18:16 -0400 Subject: [Git][ghc/ghc][wip/cleanup-selfboot] cleanup: Remove unused field from SelfBoot Message-ID: <64764bf88fd92_2f3791fc247e0424787@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/cleanup-selfboot at Glasgow Haskell Compiler / GHC Commits: 112c2201 by Krzysztof Gogolewski at 2023-05-30T21:16:49+02:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 8 changed files: - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types.hs - testsuite/driver/testlib.py - testsuite/mk/boilerplate.mk - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -114,7 +114,6 @@ import GHC.Types.Var as Var import GHC.Types.Var.Set import GHC.Types.Name import GHC.Types.Name.Env -import GHC.Types.Name.Set import GHC.Types.Id import GHC.Types.Id.Make import GHC.Types.Id.Info @@ -568,7 +567,7 @@ tcHiBootIface hsc_src mod then do { (_, hug) <- getEpsAndHug ; case lookupHugByModule mod hug of Just info | mi_boot (hm_iface info) == IsBoot - -> mkSelfBootInfo (hm_iface info) (hm_details info) + -> mkSelfBootInfo (hm_details info) _ -> return NoSelfBoot } else do @@ -584,7 +583,7 @@ tcHiBootIface hsc_src mod ; case read_result of { Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + ; mkSelfBootInfo tc_iface } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -613,28 +612,8 @@ tcHiBootIface hsc_src mod need = text "Need the hi-boot interface for" <+> ppr mod <+> text "to compare against the Real Thing" -mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo -mkSelfBootInfo iface mds - = do -- NB: This is computed DIRECTLY from the ModIface rather - -- than from the ModDetails, so that we can query 'sb_tcs' - -- WITHOUT forcing the contents of the interface. - let tcs = map ifName - . filter isIfaceTyCon - . map snd - $ mi_decls iface - return $ SelfBoot { sb_mds = mds - , sb_tcs = mkNameSet tcs } - where - -- Returns @True@ if, when you call 'tcIfaceDecl' on - -- this 'IfaceDecl', an ATyCon would be returned. - -- NB: This code assumes that a TyCon cannot be implicit. - isIfaceTyCon IfaceId{} = False - isIfaceTyCon IfaceData{} = True - isIfaceTyCon IfaceSynonym{} = True - isIfaceTyCon IfaceFamily{} = True - isIfaceTyCon IfaceClass{} = True - isIfaceTyCon IfaceAxiom{} = False - isIfaceTyCon IfacePatSyn{} = False +mkSelfBootInfo :: ModDetails -> TcRn SelfBootInfo +mkSelfBootInfo mds = return $ SelfBoot { sb_mds = mds } {- ************************************************************************ ===================================== compiler/GHC/JS/Optimizer.hs ===================================== @@ -47,9 +47,8 @@ import GHC.JS.Syntax import Control.Arrow {- -Note [ Unsafe JavaScript Optimizations ] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - +Note [Unsafe JavaScript optimizations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There are a number of optimizations that the JavaScript Backend performs that are not sound with respect to arbritrary JavaScript. We still perform these optimizations because we are not optimizing arbritrary javascript and under the ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -698,9 +698,6 @@ tcRnHsBootDecls boot_or_sig decls , hs_valds = XValBindsLR (NValBinds val_binds val_sigs) }) <- rnTopSrcDecls first_group - -- The empty list is for extra dependencies coming from .hs-boot files - -- See Note [Extra dependencies from .hs-boot files] in GHC.Rename.Module - ; (gbl_env, lie) <- setGblEnv tcg_env $ captureTopConstraints $ do { -- NB: setGblEnv **before** captureTopConstraints so that -- if the latter reports errors, it knows what's in scope ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -5006,7 +5006,7 @@ checkValidRoleAnnots role_annots tc = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl -- Note [Missing role annotations warning] --- +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- We warn about missing role annotations for tycons -- 1. not type-classes: -- type classes are nominal by default, which is most conservative ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -687,10 +687,7 @@ instance ContainsModule TcGblEnv where data SelfBootInfo = NoSelfBoot -- No corresponding hi-boot file | SelfBoot - { sb_mds :: ModDetails -- There was a hi-boot file, - , sb_tcs :: NameSet } -- defining these TyCons, --- What is sb_tcs used for? See Note [Extra dependencies from .hs-boot files] --- in GHC.Rename.Module + { sb_mds :: ModDetails } -- There was a hi-boot file bootExports :: SelfBootInfo -> NameSet bootExports boot = ===================================== testsuite/driver/testlib.py ===================================== @@ -167,7 +167,7 @@ def stage1(name, opts): 'add your test to testsuite/tests/stage1 instead') # Note [Why is there no stage1 setup function?] -# +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Presumably a stage1 setup function would signal that the stage1 # compiler should be used to compile a test. # ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -265,7 +265,7 @@ ifeq "$(findstring clean,$(MAKECMDGOALS))" "" endif # Note [WayFlags] -# +# ~~~~~~~~~~~~~~~ # Code that uses TemplateHaskell should either use -fexternal-interpreter, or # be built in the same way as the compiler (-prof, -dynamic or -static). # ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -15,7 +15,6 @@ ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constr ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -31,12 +30,8 @@ ref compiler/GHC/Tc/Gen/Splice.hs:531:35: Note [PendingRnSplice] ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] -ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] -ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] -ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] -ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] @@ -47,10 +42,6 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:276:10: Note [WayFlags] -ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] -ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts] ref testsuite/tests/polykinds/CuskFam.hs:16:11: Note [Unifying implicit CUSK variables] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/112c2201e01208f237f26c4d0b10c755f5444b76 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/112c2201e01208f237f26c4d0b10c755f5444b76 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 21:07:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 May 2023 17:07:24 -0400 Subject: [Git][ghc/ghc][master] Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <6476658cb72e0_2f3792946deac432860@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - 3 changed files: - compiler/GHC/Driver/Session.hs - testsuite/tests/th/TH_foreignCallingConventions.hs - testsuite/tests/th/TH_foreignCallingConventions.stderr Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2524,7 +2524,7 @@ supportedLanguageOverlays :: [String] supportedLanguageOverlays = map (flagSpecName . snd) safeHaskellFlagsDeps supportedExtensions :: ArchOS -> [String] -supportedExtensions (ArchOS _ os) = concatMap toFlagSpecNamePair xFlags +supportedExtensions (ArchOS arch os) = concatMap toFlagSpecNamePair xFlags where toFlagSpecNamePair flg -- IMPORTANT! Make sure that `ghc --supported-extensions` omits @@ -2533,9 +2533,12 @@ supportedExtensions (ArchOS _ os) = concatMap toFlagSpecNamePair xFlags -- the rationale | isAIX, flagSpecFlag flg == LangExt.TemplateHaskell = [noName] | isAIX, flagSpecFlag flg == LangExt.QuasiQuotes = [noName] + -- "JavaScriptFFI" is only supported on the JavaScript backend + | notJS, flagSpecFlag flg == LangExt.JavaScriptFFI = [noName] | otherwise = [name, noName] where isAIX = os == OSAIX + notJS = arch /= ArchJavaScript noName = "No" ++ name name = flagSpecName flg ===================================== testsuite/tests/th/TH_foreignCallingConventions.hs ===================================== @@ -1,6 +1,9 @@ {-# LANGUAGE ForeignFunctionInterface, CApiFFI, GHCForeignImportPrim, - QuasiQuotes, TemplateHaskell, JavaScriptFFI, MagicHash, - UnliftedFFITypes #-} + QuasiQuotes, TemplateHaskell, MagicHash, + UnliftedFFITypes, CPP #-} +#if defined(javascript_HOST_ARCH) +{-# LANGUAGE JavaScriptFFI #-} +#endif module TH_foreignCallingConventions where ===================================== testsuite/tests/th/TH_foreignCallingConventions.stderr ===================================== @@ -8,7 +8,7 @@ foreign import stdcall safe "bay" bay :: (GHC.Types.Int -> GHC.Types.IO GHC.Types.Int foreign import javascript unsafe "bax" bax :: GHC.Ptr.Ptr GHC.Types.Int -> GHC.Types.IO GHC.Base.String -TH_foreignCallingConventions.hs:(13,2)-(24,2): Splicing declarations +TH_foreignCallingConventions.hs:(16,2)-(27,2): Splicing declarations do let fi cconv safety lbl name ty = ForeignD (ImportF cconv safety lbl name ty) dec1 <- fi CCall Interruptible "&" (mkName "foo") <$> [t| Ptr () |] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0350b1865f392cf9590c82b5194b62e63770aa44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0350b1865f392cf9590c82b5194b62e63770aa44 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 21:08:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 May 2023 17:08:04 -0400 Subject: [Git][ghc/ghc][master] testsuite: Pass -kb16k -kc128k for performance tests Message-ID: <647665b495ca7_2f3791c6447744381a1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -1791,7 +1791,11 @@ async def simple_build(name: Union[TestName, str], stats_file = name + '.comp.stats' if isCompilerStatsTest(): - extra_hc_opts += ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS' + # Set a bigger chunk size to reduce variation due to additional under/overflowing + # The tests are attempting to test how much work the compiler is doing by proxy of + # bytes allocated. The additional allocations caused by stack overflow can cause + # spurious failures if you trip over the limit (see #23439) + extra_hc_opts += ' +RTS -kc128k -kb16k -V0 -t' + stats_file + ' --machine-readable -RTS' if backpack: extra_hc_opts += ' -outputdir ' + name + '.out' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b48169194bfbfdbfd23ef4cad80212a13e262717 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b48169194bfbfdbfd23ef4cad80212a13e262717 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue May 30 21:08:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 30 May 2023 17:08:39 -0400 Subject: [Git][ghc/ghc][master] Move via-C flags into GHC Message-ID: <647665d7a2a06_2f3792cbb7b1044162d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 9 changed files: - compiler/GHC/Settings/IO.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_gcc_extra_flags.m4 - + m4/fp_gcc_supports_via_c_flags.m4 Changes: ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -76,7 +76,6 @@ initSettings top_dir = do getToolSetting :: String -> ExceptT SettingsError m String getToolSetting key = expandToolDir useInplaceMinGW mtool_dir <$> getSetting key targetPlatformString <- getSetting "target platform string" - myExtraGccViaCFlags <- getSetting "GCC extra via C opts" cc_prog <- getToolSetting "C compiler command" cxx_prog <- getToolSetting "C++ compiler command" cc_args_str <- getToolSetting "C compiler flags" @@ -93,6 +92,16 @@ initSettings top_dir = do cpp_args = map Option (words cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str + + -- The extra flags we need to pass gcc when we invoke it to compile .hc code. + -- + -- -fwrapv is needed for gcc to emit well-behaved code in the presence of + -- integer wrap around (#952). + extraGccViaCFlags = if platformUnregisterised platform + -- configure guarantees cc support these flags + then ["-fwrapv", "-fno-builtin"] + else [] + ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" @@ -204,7 +213,7 @@ initSettings top_dir = do , toolSettings_opt_lc = [] , toolSettings_opt_i = [] - , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags + , toolSettings_extraGccViaCFlags = extraGccViaCFlags } , sTargetPlatform = platform ===================================== configure.ac ===================================== @@ -622,14 +622,15 @@ FP_GCC_VERSION dnl ** See whether cc supports -no-pie FP_GCC_SUPPORTS_NO_PIE +dnl ** Check support for the extra flags passed by GHC when compiling via C +FP_GCC_SUPPORTS_VIA_C_FLAGS + dnl ** Used to determine how to compile ghc-prim's atomics.c, used by dnl unregisterised, Sparc, and PPC backends. Also determines whether dnl linking to libatomic is required for atomic operations, e.g. on dnl RISCV64 GCC. FP_CC_SUPPORTS__ATOMICS -FP_GCC_EXTRA_FLAGS - dnl ** look to see if we have a C compiler using an llvm back end. dnl FP_CC_LLVM_BACKEND ===================================== distrib/configure.ac.in ===================================== @@ -164,7 +164,7 @@ AC_SUBST([OptCmd]) dnl ** Check gcc version and flags we need to pass it ** FP_GCC_VERSION FP_GCC_SUPPORTS_NO_PIE -FP_GCC_EXTRA_FLAGS +FP_GCC_SUPPORTS_VIA_C_FLAGS FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) ===================================== hadrian/bindist/Makefile ===================================== @@ -79,8 +79,7 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@ - @echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ + @echo '[("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ @echo ',("C++ compiler command", "$(SettingsCxxCompilerCommand)")' >> $@ @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -234,7 +234,6 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -137,7 +137,6 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ ld-supports-response-files = @LdSupportsResponseFiles@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -411,8 +411,7 @@ generateSettings :: Expr String generateSettings = do ctx <- getContext settings <- traverse sequence $ - [ ("GCC extra via C opts", expr $ lookupSystemConfig "gcc-extra-via-c-opts") - , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) + [ ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand) , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags) , ("C++ compiler command", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerCommand) , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) ===================================== m4/fp_gcc_extra_flags.m4 deleted ===================================== @@ -1,20 +0,0 @@ -# FP_GCC_EXTRA_FLAGS -# ------------------ -# Determine which extra flags we need to pass gcc when we invoke it -# to compile .hc code. -# -# -fwrapv is needed for gcc to emit well-behaved code in the presence of -# integer wrap around. (#952) -# -AC_DEFUN([FP_GCC_EXTRA_FLAGS], -[AC_REQUIRE([FP_GCC_VERSION]) -AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts], -[ - if test "$Unregisterised" = "YES"; then - # These used to be conditioned on gcc version but we no longer support - # GCC versions which lack support for these flags - fp_cv_gcc_extra_opts="-fwrapv -fno-builtin" - fi -]) -AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) -]) ===================================== m4/fp_gcc_supports_via_c_flags.m4 ===================================== @@ -0,0 +1,17 @@ +# FP_GCC_SUPPORTS_VIA_C_FLAGS +# --------------------------- +# Make sure GCC supports the flags passed by GHC when compiling via C +AC_DEFUN([FP_GCC_SUPPORTS_VIA_C_FLAGS], +[ + AC_REQUIRE([AC_PROG_CC]) + AC_MSG_CHECKING([whether CC supports flags passed by GHC when compiling via C]) + echo 'int main() { return 0; }' > conftest.c + if $CC -fwrapv -fno-builtin -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + AC_MSG_ERROR([gcc must support the flags -fwrapv and -fno-builtin]) + fi + rm -f conftest.c conftest.o conftest +]) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6629f1c58a714405ba94e93d54a9c471f6f62914 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6629f1c58a714405ba94e93d54a9c471f6f62914 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 07:50:37 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Wed, 31 May 2023 03:50:37 -0400 Subject: [Git][ghc/ghc][wip/amg/dcoercion-optimisation] WIP: more experiments Message-ID: <6476fc4d40fe2_2f379244576ac470638@gitlab.mail> Adam Gundry pushed to branch wip/amg/dcoercion-optimisation at Glasgow Haskell Compiler / GHC Commits: 44e4dc9f by Adam Gundry at 2023-05-31T08:50:17+01:00 WIP: more experiments - - - - - 1 changed file: - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -393,10 +393,11 @@ opt_co4 opts env@(LC _ _lift_co_env) sym rep r (HydrateDCo _r lhs_ty dco rhs_ty) = assert (r == _r) $ wrapSym sym $ -- (\ (lhs', dco') -> mkHydrateDCo r' lhs' dco' rhs') $ - opt_dco4_wrap "HydrateDCo" opts env rep r lhs_ty dco - where - rhs' = substTyUnchecked (lcSubstRight env) rhs_ty - r' = chooseRole rep r +-- opt_dco4_wrap "HydrateDCo" opts env rep r lhs_ty dco + opt_dco4_to_co opts env rep r lhs_ty dco +-- where +-- rhs' = substTyUnchecked (lcSubstRight env) rhs_ty +-- r' = chooseRole rep r opt_co4 opts env sym rep r (UnivCo prov _r t1 t2) = assert (r == _r) $ @@ -612,29 +613,31 @@ type family OptRes co_or_dco where type Optimiser in_co out_co = OptCoParams -> LiftingContext -> SymFlag -> ReprFlag -> Role -> in_co -> out_co -opt_co_or_dco :: CoOrDCo co_or_dco -> Type -> Optimiser co_or_dco Coercion +opt_co_or_dco :: CoOrDCo co_or_dco -> Type -> Optimiser co_or_dco co_or_dco opt_co_or_dco Co _ = opt_co4 opt_co_or_dco DCo l_ty = \ opts lc sym repr r dco -> assert (sym == False) $ + snd $ opt_dco4 opts lc repr r l_ty dco opt_univ :: forall co_or_dco . Outputable co_or_dco => CoOrDCo co_or_dco -> OptCoParams - -> LiftingContext -> SymFlag -> UnivCoProvenance Coercion -> Role - -> Type -> Type -> Coercion + -> LiftingContext -> SymFlag -> UnivCoProvenance co_or_dco -> Role + -> Type -> Type -> OptRes co_or_dco opt_univ co_or_dco opts env sym (PhantomProv h) _r ty1 ty2 | sym = mk_phantom h' ty2' ty1' | otherwise = mk_phantom h' ty1' ty2' where - h' = wrap "opt_univ PhantomProv" (opt_co_or_dco Co ty1) opts env sym False Nominal h + h' = wrap "opt_univ PhantomProv" (opt_co_or_dco co_or_dco ty1) opts env sym False Nominal h ty1' = substTy (lcSubstLeft env) ty1 ty2' = substTy (lcSubstRight env) ty2 - mk_phantom :: Coercion -> Type -> Type -> Coercion - mk_phantom = mkPhantomCo - + mk_phantom :: co_or_dco -> Type -> Type -> OptRes co_or_dco + mk_phantom = case co_or_dco of + Co -> mkPhantomCo + DCo -> \ h t1 t2 -> (t1, mkUnivDCo (PhantomProv h) t2) opt_univ co_or_dco opts env sym prov role oty1 oty2 | Just (tc1, tys1) <- splitTyConApp_maybe oty1 @@ -645,10 +648,19 @@ opt_univ co_or_dco opts env sym prov role oty1 oty2 -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom); -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps = let roles = tyConRoleListX role tc1 - arg_cos = zipWith3 mk_univ roles tys1 tys2 - arg_cos' = zipWith (opt_co4 opts env sym False) roles arg_cos - in - mkTyConAppCo role tc1 arg_cos' + in case co_or_dco of + Co -> + let + arg_cos = zipWith3 mk_univ roles tys1 tys2 + arg_cos' = zipWith (opt_co4 opts env sym False) roles arg_cos + in + mkTyConAppCo role tc1 arg_cos' + DCo -> + let + arg_cos = zipWith3 (\ r x y -> snd $ mk_univ r x y) roles tys1 tys2 + (arg_lhs', arg_dcos') = unzip $ zipWith3 (opt_dco4 opts env False) roles tys1 arg_cos + in + (mkTyConApp tc1 arg_lhs', mkTyConAppDCo arg_dcos') -- can't optimize the AppTy case because we can't build the kind coercions. @@ -657,7 +669,9 @@ opt_univ co_or_dco opts env sym prov role oty1 oty2 -- NB: prov isn't interesting here either = let k1 = tyVarKind tv1 k2 = tyVarKind tv2 - eta = mk_univ Nominal k1 k2 + eta = case co_or_dco of + Co -> mk_univ Nominal k1 k2 + DCo -> snd $ mk_univ Nominal k1 k2 tv1' = mk_castTy (TyVarTy tv1) k1 eta k2 -- eta gets opt'ed soon, but not yet. ty2' = substTyWith [tv2] [tv1'] ty2 @@ -672,9 +686,13 @@ opt_univ co_or_dco opts env sym prov role oty1 oty2 = let k1 = varType cv1 k2 = varType cv2 r' = coVarRole cv1 - eta = mk_univ Nominal k1 k2 + eta = case co_or_dco of + Co -> mk_univ Nominal k1 k2 + DCo -> snd $ mk_univ Nominal k1 k2 eta_d = downgradeRole r' Nominal $ - eta + case co_or_dco of + Co -> eta + DCo -> mkHydrateDCo Nominal k1 eta k2 -- eta gets opt'ed soon, but not yet. n_co = (mkSymCo $ mkSelCo (SelTyCon 2 r') eta_d) `mkTransCo` (mkCoVarCo cv1) `mkTransCo` @@ -694,24 +712,32 @@ opt_univ co_or_dco opts env sym prov role oty1 oty2 mk_univ role a b where - mk_castTy :: Type -> Type -> Coercion -> Type -> Type - mk_castTy = \ ty _ co _ -> CastTy ty co - mk_univ :: Role -> Type -> Type -> Coercion - mk_univ = mkUnivCo prov' - mk_forall :: TyCoVar -> Coercion -> Coercion -> Coercion - mk_forall cv eta = mkForAllCo cv eta - opt_forall :: TyCoVar -> Coercion -> (LiftingContext,TyCoVar,Coercion) - opt_forall tv co = optForAllCoBndr opts env sym tv co - prov' :: UnivCoProvenance KindCoercion + mk_castTy :: Type -> Type -> co_or_dco -> Type -> Type + mk_castTy = case co_or_dco of + Co -> \ ty _ co _ -> CastTy ty co + DCo -> \ ty l dco r -> CastTy ty (mkHydrateDCo Nominal l dco r) + mk_univ :: Role -> Type -> Type -> OptRes co_or_dco + mk_univ = case co_or_dco of + Co -> mkUnivCo prov' + DCo -> \ _ l_ty r_ty -> (l_ty, mkUnivDCo prov' r_ty) + mk_forall :: TyCoVar -> co_or_dco -> OptRes co_or_dco -> OptRes co_or_dco + mk_forall cv eta = case co_or_dco of + Co -> mkForAllCo cv eta + DCo -> \ (_,body) -> (mkTyVarTy cv, mkForAllDCo cv eta body) + opt_forall :: TyCoVar -> co_or_dco -> (LiftingContext,TyCoVar,co_or_dco) + opt_forall tv co = case co_or_dco of + Co -> optForAllCoBndr opts env sym tv co + DCo -> optForAllDCoBndr opts env sym tv co + prov' :: UnivCoProvenance co_or_dco prov' = case prov of #if __GLASGOW_HASKELL__ < 901 -- This alt is redundant with the first match of the FunDef PhantomProv kco -> PhantomProv - $ wrap "univ_co phantom" (opt_co_or_dco Co oty1) + $ wrap "univ_co phantom" (opt_co_or_dco co_or_dco oty1) opts env sym False Nominal kco #endif ProofIrrelProv kco -> ProofIrrelProv - $ wrap "univ_co proof_irrel" (opt_co_or_dco Co oty1) + $ wrap "univ_co proof_irrel" (opt_co_or_dco co_or_dco oty1) opts env sym False Nominal kco PluginProv str -> PluginProv str CorePrepProv homo -> CorePrepProv homo @@ -1034,14 +1060,14 @@ fireTransRule _rule _co1 _co2 res -- N.B.: The reason we return (Type, DCoercion) and not just DCoercion is that we -- sometimes need the substituted LHS type (see opt_trans_dco). -opt_phantom_dco :: OptCoParams -> LiftingContext -> Role -> Type -> DCoercion -> NormalCo +opt_phantom_dco :: OptCoParams -> LiftingContext -> Role -> Type -> DCoercion -> (Type, NormalDCo) opt_phantom_dco opts env r l_ty dco = opt_univ DCo opts env False (PhantomProv kco) Phantom l_ty r_ty where - kco = mkKindCo $ mkHydrateDCo r l_ty dco r_ty + kco = DehydrateCo (mkKindCo $ mkHydrateDCo r l_ty dco r_ty) r_ty = followDCo r l_ty dco -- A naive attempt at removing this entirely causes issues in test "type_in_type_hole_fits". -opt_dco4_wrap :: String -> OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> NormalCo +opt_dco4_wrap :: String -> OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> (Type, NormalDCo) opt_dco4_wrap str opts lc rep r l_ty dco = wrap ("opt_dco4 " ++ str) go opts lc False rep r dco where go opts lc _sym repr r dco = opt_dco4 opts lc repr r l_ty dco @@ -1050,11 +1076,11 @@ opt_dco2 :: OptCoParams -> LiftingContext -> Role -- ^ The role of the input coercion -> Type - -> DCoercion -> NormalCo + -> DCoercion -> (Type, NormalDCo) opt_dco2 opts env Phantom ty dco = opt_phantom_dco opts env Phantom ty dco opt_dco2 opts env r ty dco = opt_dco3 opts env Nothing r ty dco -opt_dco3 :: OptCoParams -> LiftingContext -> Maybe Role -> Role -> Type -> DCoercion -> NormalCo +opt_dco3 :: OptCoParams -> LiftingContext -> Maybe Role -> Role -> Type -> DCoercion -> (Type, NormalDCo) opt_dco3 opts env (Just Phantom) r ty dco = opt_phantom_dco opts env r ty dco opt_dco3 opts env (Just Representational) r ty dco = opt_dco4_wrap "opt_dco3 R" opts env True r ty dco opt_dco3 opts env _ r ty dco = opt_dco4_wrap "opt_dco3 _" opts env False r ty dco @@ -1069,85 +1095,70 @@ which is where we have a long transitive chain of type family reduction steps. -} -opt_dco4 :: OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> NormalCo -opt_dco4 opts env@(LC _ lift_co_env) rep r l_ty dco = case dco of +opt_dco4_to_co :: OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> NormalCo +opt_dco4_to_co opts env rep r l_ty dco = case dco of TransDCo dco1 dco2 - -> case opt_dco4 opts env rep r l_ty dco1 of - HydrateDCo r' l_ty' dco1' r_ty - | isEmptyVarEnv lift_co_env -> - let dco2' = substDCo (lcSubst env) dco2 - in HydrateDCo r' l_ty' (dco1' `mkTransDCo` dco2') (followDCo r' r_ty dco2') - co1@(AxiomInstCo coax br cos) - | not (isNewTyCon (coAxiomTyCon coax)) - , isEmptyVarEnv lift_co_env -> - let dco2' = substDCo (lcSubst env) dco2 + -> case opt_dco4_to_co opts env rep r l_ty dco1 of + HydrateDCo r' l_ty' dco1' r_ty -> + let (r_ty', dco2') = opt_dco4 opts env rep r r_ty dco2 + in mkHydrateDCo r' l_ty' (dco1' `mkTransDCo` dco2') (followDCo r' r_ty' dco2') + co1@(AxiomInstCo coax _br _cos) + | not (isNewTyCon (coAxiomTyCon coax)) -> + let (r_ty', dco2') = opt_dco4 opts env rep r r_ty dco2 Pair l_ty' r_ty = coercionKind co1 dco1' = mkDehydrateCo co1 -- TODO: inline; use assumption cos are refls? - in HydrateDCo r l_ty' (dco1' `mkTransDCo` dco2') (followDCo r r_ty dco2') + in mkHydrateDCo r l_ty' (dco1' `mkTransDCo` dco2') (followDCo r r_ty' dco2') -- TODO: AxiomRuleCo? - co1 -> opt_trans opts (lcInScopeSet env) co1 (opt_dco4 opts env rep r (coercionRKind co1) dco2) + co1 -> opt_trans opts (lcInScopeSet env) co1 (opt_dco4_to_co opts env rep r (coercionRKind co1) dco2) + StepsDCo n | n > 1 -> let (lhs', dco') = opt_dco4 opts env rep r l_ty dco + in mkHydrateDCo r lhs' dco' (followDCo r lhs' dco') _ -> opt_co4 opts env False rep r (hydrateOneLayerDCo r l_ty dco) -_opt_dco4 :: OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> NormalCo -_opt_dco4 opts env rep r l_ty dco = case dco of +opt_dco4 :: OptCoParams -> LiftingContext -> ReprFlag -> Role -> Type -> DCoercion -> (Type, NormalDCo) +opt_dco4 opts env rep r l_ty dco = case dco of ReflDCo - -> lifted_co + -> lifted_dco GReflRightDCo kco | isGReflCo kco || isGReflCo kco' - -> lifted_co + -> lifted_dco | otherwise - -> mkGReflRightCo r l_ty' kco' + -> (l_ty', mkGReflRightDCo kco') where kco' = opt_co4 opts env False False Nominal kco GReflLeftDCo kco | isGReflCo kco || isGReflCo kco' - -> lifted_co + -> lifted_dco | otherwise - -> mkGReflLeftCo r l_ty' kco' + -> (l_ty', mkGReflLeftDCo kco') where kco' = opt_co4 opts env False False Nominal kco TyConAppDCo dcos | Just (tc, l_tys) <- splitTyConApp_maybe l_ty -> let - arg_cos = + (arg_ltys, arg_dcos) = case (rep, r) of (True, Nominal) -> + unzip $ zipWith3 (\ mb_r' -> opt_dco3 opts env mb_r' Nominal) (map Just (tyConRoleListRepresentational tc)) l_tys dcos (False, Nominal) -> + unzip $ zipWith (opt_dco4 opts env False Nominal) l_tys dcos (_, Representational) -> + unzip $ zipWith3 (opt_dco2 opts env) (tyConRoleListRepresentational tc) l_tys dcos (_, Phantom) -> pprPanic "opt_dco4 sees a phantom!" (ppr dco) - in mkTyConAppCo r tc arg_cos - --- AMG TODO: experimenting with changing dco opt to return a Coercion. --- --- Key question: do we want to push Hydrate up or down? --- If we have TyConApp for a non-family, it will never reduce, so might want to be a Coercion? --- But then perhaps that is included in a larger context which wants a DCoercion? --- --- Idea: we only benefit from DCoercion when we have a long chain of --- Steps/AxiomInstDCo. For coercion optimisation purposes, a Coercion is --- better. Thus dcoercion optimisation produces Coercions. Then in --- opt_trans_rule we need to handle the cases intelligently. --- --- Idea: look out for --- Hydrate ty1 dco ; Sym (Hydrate ty2 dco) --- and handle it by converting to coercions and optimising their transitive composition? - --- Sym (Hydrate ty dco1) ; Hydrate ty dco2 --- should be easy as we can follow common prefix of both dco1 and dco2 + in (mkTyConApp tc arg_ltys, mkTyConAppDCo arg_dcos) | otherwise -> pprPanic "opt_dco4: TyConAppDCo where ty is not a TyConApp" $ @@ -1157,17 +1168,14 @@ _opt_dco4 opts env rep r l_ty dco = case dco of AppDCo dco1 dco2 | Just (l_ty1, l_ty2) <- splitAppTy_maybe l_ty , let - l_co1 = opt_dco4 opts env rep r l_ty1 dco1 - l_co2 = opt_dco4 opts env False Nominal l_ty2 dco2 - -> mkAppCo l_co1 l_co2 + (l_ty1', l_dco1) = opt_dco4 opts env rep r l_ty1 dco1 + (l_ty2', l_dco2) = opt_dco4 opts env False Nominal l_ty2 dco2 + -> (mkAppTy l_ty1' l_ty2', mkAppDCo l_dco1 l_dco2) | otherwise -> pprPanic "opt_dco4: AppDCo where ty is not an AppTy" $ vcat [ text "dco =" <+> ppr dco , text "l_ty =" <+> ppr l_ty ] - ForAllDCo{} -- AMG TODO - -> rep_dco -{- ForAllDCo dco_tcv k_dco body_dco | ForAllTy (Bndr ty_tv af) body_ty <- coreFullView l_ty -> case optForAllDCoBndr opts env False dco_tcv k_dco of @@ -1183,45 +1191,44 @@ _opt_dco4 opts env rep r l_ty dco = case dco of -> pprPanic "opt_dco4: ForAllDCo where ty is not a ForAllTy" $ vcat [ text "dco =" <+> ppr dco , text "l_ty =" <+> ppr l_ty ] --} CoVarDCo cv - -> opt_co4 opts env False rep r (CoVarCo cv) + -> let co' = opt_co4 opts env False rep r (CoVarCo cv) + in (coercionLKind co', mkDehydrateCo co') AxiomInstDCo {} - -> rep_dco + -> (l_ty', rep_dco) StepsDCo {} - -> rep_dco + -> (l_ty', rep_dco) - UnivDCo{} -> rep_dco -- TODO -{- UnivDCo prov rhs_ty -> opt_univ DCo opts env False prov r' l_ty rhs_ty --} TransDCo dco1 dco2 -> let - co1' = opt_dco4 opts env rep r l_ty dco1 + (l_ty', dco1') = opt_dco4 opts env rep r l_ty dco1 -- Follow the original directed coercion, -- to avoid applying the substitution twice. - Pair l_ty' mid_ty' = coercionKind co1' - co2' = opt_dco4 opts env rep r mid_ty' dco2 + mid_ty = followDCo r l_ty dco1 + (mid_ty', dco2') = opt_dco4 opts env rep r mid_ty dco2 in - opt_trans opts (lcInScopeSet env) co1' co2' + (l_ty', opt_trans_dco opts (lcInScopeSet env) r' l_ty' dco1' mid_ty' dco2') SubDCo dco -> assert (r == Representational) $ opt_dco4_wrap "SubDCo" opts env True Nominal l_ty dco DehydrateCo co -> - opt_co4_wrap "DehydrateCo" opts env False rep r co + let co' = opt_co4_wrap "DehydrateCo" opts env False rep r co + in (coercionLKind co', mkDehydrateCo co') where - lifted_co = liftCoSubst r' env l_ty + lifted_dco = let lifted_co = liftCoSubst r' env l_ty + in ( coercionLKind lifted_co, mkDehydrateCo lifted_co ) l_ty' = substTyUnchecked (lcSubstLeft env) l_ty r' = chooseRole rep r - rep_dco = wrapRole rep r $ mkHydrateDCo r l_ty' dco (followDCo r l_ty' dco) + rep_dco = wrapRole_dco rep r l_ty' dco (followDCo r l_ty' dco) --------------------------------------------------------- -- Transitivity for directed coercions. @@ -1691,5 +1698,5 @@ optForAllDCoBndr :: OptCoParams optForAllDCoBndr opts env sym tv = substForAllDCoBndrUsingLC sym (substTyUnchecked (lcSubstLeft env)) - (mkDehydrateCo . opt_dco4_wrap "optForAllDCoBndr" opts env False Nominal (tyVarKind tv)) env + (snd . opt_dco4_wrap "optForAllDCoBndr" opts env False Nominal (tyVarKind tv)) env tv View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44e4dc9f5c1db7f5512c6abc9ded4fcb6a62f273 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44e4dc9f5c1db7f5512c6abc9ded4fcb6a62f273 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 10:14:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 May 2023 06:14:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: testsuite: Pass -kb16k -kc128k for performance tests Message-ID: <64771e033e7cd_2f3792d9688e0476612@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - e159ebce by Arnaud Spiwack at 2023-05-31T06:14:19-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - 1c8c81ea by Arnaud Spiwack at 2023-05-31T06:14:19-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - 4b423d59 by mimi.vx at 2023-05-31T06:14:22-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Settings/IO.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/rtd-theme/__init__.py - docs/users_guide/rtd-theme/breadcrumbs.html - docs/users_guide/rtd-theme/footer.html - docs/users_guide/rtd-theme/layout.html - + docs/users_guide/rtd-theme/locale/da/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/da/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/de/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/de/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/en/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/en/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/es/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/es/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/et/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/et/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/fa_IR/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/fa_IR/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/fr/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/fr/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/hr/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/hr/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/hu/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/hu/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/it/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/it/LC_MESSAGES/sphinx.po The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6f46fc6479890d07e5c215e40cc3bd6a954a9d6...4b423d598444e2024d9716fb20a235ca97f7f24d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6f46fc6479890d07e5c215e40cc3bd6a954a9d6...4b423d598444e2024d9716fb20a235ca97f7f24d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 11:23:02 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 31 May 2023 07:23:02 -0400 Subject: [Git][ghc/ghc][wip/js-th] 27 commits: Migrate errors in GHC.Rename.Splice GHC.Rename.Pat Message-ID: <64772e169035_36fbc9c2bc885678@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - fd012ecc by Sylvain Henry at 2023-05-30T15:47:23+02:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - bbe73d9f by Sylvain Henry at 2023-05-30T15:53:10+02:00 Don't use getKey - - - - - f120d892 by Sylvain Henry at 2023-05-31T13:03:48+02:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - d586b7c4 by Sylvain Henry at 2023-05-31T13:05:24+02:00 Fix some recompilation avoidance tests - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs - compiler/GHC/Driver/Config/Diagnostic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0e55f2591487b685c599acc97a3a4357f9bf00f5...d586b7c4f4a53f913fb91d02698737b2f6f73acc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0e55f2591487b685c599acc97a3a4357f9bf00f5...d586b7c4f4a53f913fb91d02698737b2f6f73acc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 12:34:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 May 2023 08:34:51 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Allow CPR on unrestricted constructors Message-ID: <64773eeb4d9de_36fbc9c2ca4100623@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - 3 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -763,6 +763,11 @@ Wrinkles (W3) We need a TypeOrConstraint flag in LitRubbish. +(W4) In the CPR transformation, we can't unbox constructors with constraint + arguments because unboxed tuples (# …, … #) currently only supports fields + of type TYPE rr. See (CPR2) in Note [Which types are unboxed?] in + GHC.Core.Opt.WorkWrap.Utils. + Note [Type and Constraint are not apart] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Type and Constraint are not equal (eqType) but they are not /apart/ ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -2863,18 +2863,11 @@ pushCoValArg co = Just (MRefl, MRefl) | isFunTy tyL - , (co_mult, co1, co2) <- decomposeFunCo co + , (_, co1, co2) <- decomposeFunCo co -- If co :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2) -- then co1 :: tyL1 ~ tyR1 -- co2 :: tyL2 ~ tyR2 - , isReflexiveCo co_mult - -- We can't push the coercion in the case where co_mult isn't reflexivity: - -- it could be an unsafe axiom, and losing this information could yield - -- ill-typed terms. For instance (fun x ::(1) Int -> (fun _ -> () |> co) x) - -- with co :: (Int -> ()) ~ (Int %1 -> ()), would reduce to (fun x ::(1) Int - -- -> (fun _ ::(Many) Int -> ()) x) which is ill-typed. - , typeHasFixedRuntimeRep new_arg_ty -- We can't push the coercion inside if it would give rise to -- a representation-polymorphic argument. @@ -2907,10 +2900,7 @@ pushCoercionIntoLambda in_scope x e co , Pair s1s2 t1t2 <- coercionKind co , Just {} <- splitFunTy_maybe s1s2 , Just (_, w1, t1,_t2) <- splitFunTy_maybe t1t2 - , (co_mult, co1, co2) <- decomposeFunCo co - , isReflexiveCo co_mult - -- We can't push the coercion in the case where co_mult isn't - -- reflexivity. See pushCoValArg for more details. + , (_, co1, co2) <- decomposeFunCo co , typeHasFixedRuntimeRep t1 -- We can't push the coercion into the lambda if it would create -- a representation-polymorphic binder. ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -674,13 +674,11 @@ canUnboxResult fam_envs ty cpr -- type constructor via a .hs-boot file (#8743) , let dc = dcs `getNth` (con_tag - fIRST_TAG) , null (dataConExTyCoVars dc) -- no existentials; - -- See Note [Which types are unboxed?] + -- See (CPR1) in Note [Which types are unboxed?] -- and GHC.Core.Opt.CprAnal.argCprType -- where we also check this. - , all isLinear (dataConInstArgTys dc tc_args) - -- Deactivates CPR worker/wrapper splits on constructors with non-linear - -- arguments, for the moment, because they require unboxed tuple with variable - -- multiplicity fields. + , null (dataConTheta dc) -- no constraints; + -- See (CPR2) in Note [Which types are unboxed?] = DoUnbox (DataConPatContext { dcpc_dc = dc, dcpc_tc_args = tc_args , dcpc_co = co, dcpc_args = arg_cprs }) @@ -691,13 +689,6 @@ canUnboxResult fam_envs ty cpr -- See Note [non-algebraic or open body type warning] open_body_ty_warning = warnPprTrace True "canUnboxResult: non-algebraic or open body type" (ppr ty) Nothing -isLinear :: Scaled a -> Bool -isLinear (Scaled w _ ) = - case w of - OneTy -> True - _ -> False - - {- Note [Which types are unboxed?] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Worker/wrapper will unbox @@ -719,25 +710,28 @@ Worker/wrapper will unbox * is not recursive (as per 'isRecDataCon') * (might have multiple constructors, in contrast to (1)) * the applied data constructor *does not* bind existentials + * nor does it bind constraints (equalities or dictionaries) We can transform > f x y = let ... in D a b to > $wf x y = let ... in (# a, b #) via 'mkWWcpr'. - NB: We don't allow existentials for CPR W/W, because we don't have unboxed - dependent tuples (yet?). Otherwise, we could transform + (CPR1). We don't allow existentials for CPR W/W, because we don't have + unboxed dependent tuples (yet?). Otherwise, we could transform > f x y = let ... in D @ex (a :: ..ex..) (b :: ..ex..) to > $wf x y = let ... in (# @ex, (a :: ..ex..), (b :: ..ex..) #) + (CPR2) we don't allow constraints for CPR W/W, because an unboxed tuple + contains types of kind `TYPE rr`, but not of kind `CONSTRAINT rr`. + This is annoying; there is no real reason for this except that we don't + have TYPE/CONSTAINT polymorphism. See Note [TYPE and CONSTRAINT] + in GHC.Builtin.Types.Prim. + The respective tests are in 'canUnboxArg' and 'canUnboxResult', respectively. -Note that the data constructor /can/ have evidence arguments: equality -constraints, type classes etc. So it can be GADT. These evidence -arguments are simply value arguments, and should not get in the way. - Note [mkWWstr and unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ By using unsafeCoerce, it is possible to make the number of demands fail to View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6629f1c58a714405ba94e93d54a9c471f6f62914...bf9344d24157986ea013210e7cb9a5953670e0e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6629f1c58a714405ba94e93d54a9c471f6f62914...bf9344d24157986ea013210e7cb9a5953670e0e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 13:07:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 May 2023 09:07:05 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Allow CPR on unrestricted constructors Message-ID: <647746793b10a_36fbc9207d24c109233@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - 5f96e9da by sheaf at 2023-05-31T09:06:58-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - f1a50626 by sheaf at 2023-05-31T09:06:58-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - cc132db5 by sheaf at 2023-05-31T09:06:58-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - ae80934b by sheaf at 2023-05-31T09:06:58-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - 60e44bcc by sheaf at 2023-05-31T09:06:58-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - e2173edf by mimi.vx at 2023-05-31T09:07:01-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Default.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b423d598444e2024d9716fb20a235ca97f7f24d...e2173edfec04025eb868ea81edda2843c4549852 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b423d598444e2024d9716fb20a235ca97f7f24d...e2173edfec04025eb868ea81edda2843c4549852 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 14:29:51 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 May 2023 10:29:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21247 Message-ID: <647759df69aab_36fbc94383de012222a@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T21247 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21247 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 14:36:21 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 31 May 2023 10:36:21 -0400 Subject: [Git][ghc/ghc][wip/js-th] 2 commits: Stg: return imported FVs Message-ID: <64775b65c380a_36fbc927d7d9412420@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 89b57a26 by Sylvain Henry at 2023-05-31T16:41:46+02:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - f00e5db4 by Sylvain Henry at 2023-05-31T16:41:46+02:00 Fix some recompilation avoidance tests - - - - - 9 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Utils/Misc.hs - testsuite/tests/driver/recomp009/all.T - testsuite/tests/driver/recompTH/all.T - testsuite/tests/driver/th-new-test/all.T - testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -148,6 +148,7 @@ import GHC.ByteCode.Types import GHC.Linker.Loader import GHC.Linker.Types +import GHC.Linker.Deps import GHC.Hs import GHC.Hs.Dump @@ -234,6 +235,7 @@ import GHC.Types.SafeHaskell import GHC.Types.ForeignStubs import GHC.Types.Name.Env ( mkNameEnv ) import GHC.Types.Var.Env ( mkEmptyTidyEnv ) +import GHC.Types.Var.Set import GHC.Types.Error import GHC.Types.Fixity.Env import GHC.Types.CostCentre @@ -248,6 +250,7 @@ import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.TyThing import GHC.Types.HpcInfo import GHC.Types.Unique.Supply (uniqFromMask) +import GHC.Types.Unique.Set import GHC.Utils.Fingerprint ( Fingerprint ) import GHC.Utils.Panic @@ -278,7 +281,7 @@ import System.FilePath as FilePath import System.Directory import qualified Data.Set as S import Data.Set (Set) -import Data.Functor +import Data.Functor ((<&>)) import Control.DeepSeq (force) import Data.Bifunctor (first) import Data.List.NonEmpty (NonEmpty ((:|))) @@ -1847,7 +1850,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do this_mod location late_cc_binds data_tycons ----------------- Convert to STG ------------------ - (stg_binds, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) + (stg_binds_with_deps, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) <- {-# SCC "CoreToStg" #-} withTiming logger (text "CoreToStg"<+>brackets (ppr this_mod)) @@ -1859,6 +1862,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do (seqEltsUFM (seqTagSig) tag_env)) (myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) False this_mod location prepd_binds) + let (stg_binds,_stg_deps) = unzip stg_binds_with_deps + let cost_centre_info = (late_local_ccs ++ caf_ccs, caf_cc_stacks) platform = targetPlatform dflags @@ -1977,9 +1982,12 @@ hscInteractive hsc_env cgguts location = do -- The stg cg info only provides a runtime benfit, but is not requires so we just -- omit it here - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _ignore_stg_cg_infos) + (stg_binds_with_deps, _infotable_prov, _caf_ccs__caf_cc_stacks, _ignore_stg_cg_infos) <- {-# SCC "CoreToStg" #-} myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) True this_mod location prepd_binds + + let (stg_binds,_stg_deps) = unzip stg_binds_with_deps + ----------------- Generate byte code ------------------ comp_bc <- byteCodeGen hsc_env this_mod stg_binds data_tycons mod_breaks ------------------ Create f-x-dynamic C-side stuff ----- @@ -2157,7 +2165,7 @@ doCodeGen hsc_env this_mod denv data_tycons myCoreToStg :: Logger -> DynFlags -> [Var] -> Bool -> Module -> ModLocation -> CoreProgram - -> IO ( [CgStgTopBinding] -- output program + -> IO ( [(CgStgTopBinding,IdSet)] -- output program and its dependencies , InfoTableProvMap , CollectedCCs -- CAF cost centre info (declared and used) , StgCgInfos ) @@ -2172,7 +2180,7 @@ myCoreToStg logger dflags ic_inscope for_bytecode this_mod ml prepd_binds = do this_mod stg_binds putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG - (pprGenStgTopBindings (initStgPprOpts dflags) stg_binds_with_fvs) + (pprGenStgTopBindings (initStgPprOpts dflags) (fmap fst stg_binds_with_fvs)) return (stg_binds_with_fvs, denv, cost_centre_info, stg_cg_info) @@ -2325,7 +2333,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) this_mod iNTERACTIVELoc core_binds data_tycons - (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) + (stg_binds_with_deps, _infotable_prov, _caf_ccs__caf_cc_stacks, _stg_cg_info) <- {-# SCC "CoreToStg" #-} liftIO $ myCoreToStg (hsc_logger hsc_env) (hsc_dflags hsc_env) @@ -2335,6 +2343,8 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do iNTERACTIVELoc prepd_binds + let (stg_binds,_stg_deps) = unzip stg_binds_with_deps + {- Generate byte code -} cbc <- liftIO $ byteCodeGen hsc_env this_mod stg_binds data_tycons mod_breaks @@ -2569,7 +2579,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do tidy_expr {- Lint if necessary -} - lintInteractiveExpr (text "hscCompileExpr") hsc_env prepd_expr + lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr let this_loc = ModLocation{ ml_hs_file = Nothing, ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", @@ -2583,14 +2593,14 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do -- files for the same module and the JS linker doesn't support this. -- -- Note that we can't use icInteractiveModule because the ic_mod_index value - -- isn't bumped between invocations of hscCompileExpr, so uniqueness isn't + -- isn't bumped between invocations of hscCompileCoreExpr, so uniqueness isn't -- guaranteed. -- -- We reuse the unique we obtained for the binding, but any unique would do. let this_mod = mkInteractiveModule (show u) let for_bytecode = True - (stg_binds, _prov_map, _collected_ccs, _stg_cg_infos) <- + (stg_binds_with_deps, _prov_map, _collected_ccs, _stg_cg_infos) <- myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) @@ -2599,15 +2609,14 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do this_loc [NonRec binding_id prepd_expr] + let (stg_binds, _stg_deps) = unzip stg_binds_with_deps + let interp = hscInterp hsc_env - let tmpfs = hsc_tmpfs hsc_env - let tmp_dir = tmpDir dflags case interp of -- always generate JS code for the JS interpreter (no bytecode!) Interp (ExternalInterp (ExtJS i)) _ -> - jsCodeGen logger tmpfs tmp_dir unit_env (initStgToJSConfig dflags) interp i - this_mod stg_binds binding_id + jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id _ -> do {- Convert to BCOs -} @@ -2626,18 +2635,70 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do -- | Generate JS code for the given bindings and return the HValue for the given id jsCodeGen - :: Logger - -> TmpFs - -> TempDir - -> UnitEnv - -> StgToJSConfig - -> Interp + :: HscEnv + -> SrcSpan -> JSInterp -> Module - -> [CgStgTopBinding] + -> [(CgStgTopBinding,IdSet)] -> Id -> IO (ForeignHValue, [Linkable], PkgsLoaded) -jsCodeGen logger tmpfs tmp_dir unit_env js_config interp i this_mod stg_binds binding_id = do +jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do + let logger = hsc_logger hsc_env + tmpfs = hsc_tmpfs hsc_env + dflags = hsc_dflags hsc_env + interp = hscInterp hsc_env + tmp_dir = tmpDir dflags + unit_env = hsc_unit_env hsc_env + js_config = initStgToJSConfig dflags + + -- We need to load all the dependencies first. + -- + -- We get all the imported names from the Stg bindings and load their modules. + -- + -- (logic adapted from GHC.Linker.Loader.loadDecls for the JS linker) + let + (stg_binds, stg_deps) = unzip stg_binds_with_deps + imported_ids = nonDetEltsUniqSet (unionVarSets stg_deps) + imported_names = map idName imported_ids + + needed_mods :: [Module] + needed_mods = [ nameModule n | n <- imported_names, + isExternalName n, -- Names from other modules + not (isWiredInName n) -- Exclude wired-in names + ] -- (see note below) + -- Exclude wired-in names because we may not have read + -- their interface files, so getLinkDeps will fail + -- All wired-in names are in the base package, which we link + -- by default, so we can safely ignore them here. + + -- Initialise the linker (if it's not been done already) + initLoaderState interp hsc_env + + -- Take lock for the actual work. + (dep_linkables, dep_units) <- modifyLoaderState interp $ \pls -> do + let link_opts = initLinkDepsOpts hsc_env + + -- Find what packages and linkables are required + deps <- getLinkDeps link_opts interp pls srcspan needed_mods + -- We update the LinkerState even if the JS interpreter maintains its linker + -- state independently to load new objects here. + let (objs, _bcos) = partition isObjectLinkable + (concatMap partitionLinkable (ldNeededLinkables deps)) + + let (objs_loaded', _new_objs) = rmDupLinkables (objs_loaded pls) objs + + -- FIXME: we should make the JS linker load new_objs here, instead of + -- on-demand. + + -- FIXME: we don't report needed units because we would have to find a way + -- to build a meaningful LoadedPkgInfo (see the mess in + -- GHC.Linker.Loader.{loadPackage,loadPackages'}). Detecting what to load + -- and actually loading (using the native interpreter) are intermingled, so + -- we can't directly reuse this code. + let pls' = pls { objs_loaded = objs_loaded' } + pure (pls', (ldAllLinkables deps, emptyUDFM {- ldNeededUnits deps -}) ) + + let foreign_stubs = NoStubs spt_entries = mempty cost_centre_info = mempty @@ -2660,12 +2721,7 @@ jsCodeGen logger tmpfs tmp_dir unit_env js_config interp i this_mod stg_binds bi binding_fref <- withJSInterp i $ \inst -> mkForeignRef href (freeReallyRemoteRef inst href) - -- FIXME (#23013): the JS linker doesn't use the LoaderState. - -- The state is only maintained in the interpreter instance (jsLinkState field) for now. - let linkables = mempty - let loaded_pkgs = emptyUDFM - - return (castForeignRef binding_fref, linkables, loaded_pkgs) + return (castForeignRef binding_fref, dep_linkables, dep_units) {- ********************************************************************** ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -29,6 +29,11 @@ module GHC.Linker.Loader , withExtendedLoadedEnv , extendLoadedEnv , deleteFromLoadedEnv + -- * Internals + , rmDupLinkables + , modifyLoaderState + , initLinkDepsOpts + , partitionLinkable ) where @@ -282,15 +287,22 @@ reallyInitLoaderState interp hsc_env = do -- Initialise the linker state let pls0 = emptyLoaderState - -- (a) initialise the C dynamic linker - initObjLinker interp + case platformArch (targetPlatform (hsc_dflags hsc_env)) of + -- FIXME: we don't initialize anything with the JS interpreter. + -- Perhaps we should load preload packages. We'll load them on demand + -- anyway. + ArchJavaScript -> return pls0 + _ -> do + -- (a) initialise the C dynamic linker + initObjLinker interp - -- (b) Load packages from the command-line (Note [preload packages]) - pls <- unitEnv_foldWithKey (\k u env -> k >>= \pls' -> loadPackages' interp (hscSetActiveUnitId u hsc_env) (preloadUnits (homeUnitEnv_units env)) pls') (return pls0) (hsc_HUG hsc_env) - -- steps (c), (d) and (e) - loadCmdLineLibs' interp hsc_env pls + -- (b) Load packages from the command-line (Note [preload packages]) + pls <- unitEnv_foldWithKey (\k u env -> k >>= \pls' -> loadPackages' interp (hscSetActiveUnitId u hsc_env) (preloadUnits (homeUnitEnv_units env)) pls') (return pls0) (hsc_HUG hsc_env) + + -- steps (c), (d) and (e) + loadCmdLineLibs' interp hsc_env pls loadCmdLineLibs :: Interp -> HscEnv -> IO () ===================================== compiler/GHC/Stg/FVs.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE LambdaCase #-} {- | Non-global free variable analysis on STG terms. This pass annotates @@ -84,26 +85,31 @@ But isn't it in correct dependency order already? No: -- with the free variables needed in the closure -- * Each StgCase is correctly annotated (in its extension field) with -- the variables that must be saved across the case -depSortWithAnnotStgPgm :: Module -> [StgTopBinding] -> [CgStgTopBinding] +depSortWithAnnotStgPgm :: Module -> [StgTopBinding] -> [(CgStgTopBinding,ImpFVs)] depSortWithAnnotStgPgm this_mod binds = {-# SCC "STG.depSortWithAnnotStgPgm" #-} - lit_binds ++ map from_scc sccs + zip lit_binds (repeat emptyVarSet) ++ map from_scc sccs where lit_binds :: [CgStgTopBinding] pairs :: [(Id, StgRhs)] (lit_binds, pairs) = flattenTopStgBindings binds - nodes :: [Node Name (Id, CgStgRhs)] + nodes :: [Node Name (Id, CgStgRhs, ImpFVs)] nodes = map (annotateTopPair env0) pairs env0 = Env { locals = emptyVarSet, mod = this_mod } -- Do strongly connected component analysis. Why? -- See Note [Why do we need dependency analysis?] - sccs :: [SCC (Id,CgStgRhs)] + sccs :: [SCC (Id,CgStgRhs,ImpFVs)] sccs = stronglyConnCompFromEdgedVerticesUniq nodes - from_scc (CyclicSCC pairs) = StgTopLifted (StgRec pairs) - from_scc (AcyclicSCC (bndr,rhs)) = StgTopLifted (StgNonRec bndr rhs) + from_scc = \case + AcyclicSCC (bndr,rhs,imp_fvs) -> (StgTopLifted (StgNonRec bndr rhs), imp_fvs) + CyclicSCC triples -> (StgTopLifted (StgRec pairs), imp_fvs) + where + (ids,rhss,imp_fvss) = unzip3 triples + pairs = zip ids rhss + imp_fvs = unionVarSets imp_fvss flattenTopStgBindings :: [StgTopBinding] -> ([CgStgTopBinding], [(Id,StgRhs)]) @@ -119,13 +125,13 @@ flattenTopStgBindings binds flatten_one (StgNonRec b r) = [(b,r)] flatten_one (StgRec pairs) = pairs -annotateTopPair :: Env -> (Id, StgRhs) -> Node Name (Id, CgStgRhs) +annotateTopPair :: Env -> (Id, StgRhs) -> Node Name (Id, CgStgRhs, ImpFVs) annotateTopPair env0 (bndr, rhs) = DigraphNode { node_key = idName bndr - , node_payload = (bndr, rhs') + , node_payload = (bndr, rhs', imp_fvs) , node_dependencies = map idName (nonDetEltsUniqSet top_fvs) } where - (rhs', top_fvs, _) = rhsFVs env0 rhs + (rhs', imp_fvs, top_fvs, _) = rhsFVs env0 rhs -------------------------------------------------------------------------------- -- * Non-global free variable analysis @@ -158,6 +164,12 @@ addLocals bndrs env -- analysis on the top-level bindings. type TopFVs = IdSet +-- | ImpFVs: set of variables that are imported +-- +-- It is a /non-deterministic/ set because we use it only to perform module +-- dependency analysis. +type ImpFVs = IdSet + -- | LocalFVs: set of variable that are: -- (a) bound locally (by a lambda, non-top-level let, or case); that is, -- it appears in the 'locals' field of 'Env' @@ -181,97 +193,100 @@ type LocalFVs = DIdSet -- annBindingFreeVars :: Module -> StgBinding -> CgStgBinding -annBindingFreeVars this_mod = fstOf3 . bindingFVs (Env emptyVarSet this_mod) emptyDVarSet +annBindingFreeVars this_mod = fstOf4 . bindingFVs (Env emptyVarSet this_mod) emptyDVarSet -bindingFVs :: Env -> LocalFVs -> StgBinding -> (CgStgBinding, TopFVs, LocalFVs) +bindingFVs :: Env -> LocalFVs -> StgBinding -> (CgStgBinding, ImpFVs, TopFVs, LocalFVs) bindingFVs env body_fv b = case b of - StgNonRec bndr r -> (StgNonRec bndr r', fvs, lcl_fvs) + StgNonRec bndr r -> (StgNonRec bndr r', imp_fvs, top_fvs, lcl_fvs) where - (r', fvs, rhs_lcl_fvs) = rhsFVs env r + (r', imp_fvs, top_fvs, rhs_lcl_fvs) = rhsFVs env r lcl_fvs = delDVarSet body_fv bndr `unionDVarSet` rhs_lcl_fvs - StgRec pairs -> (StgRec pairs', fvs, lcl_fvss) + StgRec pairs -> (StgRec pairs', imp_fvs, top_fvs, lcl_fvss) where bndrs = map fst pairs env' = addLocals bndrs env - (rhss, rhs_fvss, rhs_lcl_fvss) = mapAndUnzip3 (rhsFVs env' . snd) pairs - fvs = unionVarSets rhs_fvss + (rhss, rhs_imp_fvss, rhs_top_fvss, rhs_lcl_fvss) = mapAndUnzip4 (rhsFVs env' . snd) pairs + top_fvs = unionVarSets rhs_top_fvss + imp_fvs = unionVarSets rhs_imp_fvss pairs' = zip bndrs rhss lcl_fvss = delDVarSetList (unionDVarSets (body_fv:rhs_lcl_fvss)) bndrs -varFVs :: Env -> Id -> (TopFVs, LocalFVs) -> (TopFVs, LocalFVs) -varFVs env v (top_fvs, lcl_fvs) +varFVs :: Env -> Id -> (ImpFVs, TopFVs, LocalFVs) -> (ImpFVs, TopFVs, LocalFVs) +varFVs env v (imp_fvs, top_fvs, lcl_fvs) | v `elemVarSet` locals env -- v is locally bound - = (top_fvs, lcl_fvs `extendDVarSet` v) + = (imp_fvs, top_fvs, lcl_fvs `extendDVarSet` v) | nameIsLocalOrFrom (mod env) (idName v) -- v is bound at top level - = (top_fvs `extendVarSet` v, lcl_fvs) + = (imp_fvs, top_fvs `extendVarSet` v, lcl_fvs) | otherwise -- v is imported - = (top_fvs, lcl_fvs) + = (imp_fvs `extendVarSet` v, top_fvs, lcl_fvs) -exprFVs :: Env -> StgExpr -> (CgStgExpr, TopFVs, LocalFVs) +exprFVs :: Env -> StgExpr -> (CgStgExpr, ImpFVs, TopFVs, LocalFVs) exprFVs env = go where go (StgApp f as) - | (top_fvs, lcl_fvs) <- varFVs env f (argsFVs env as) - = (StgApp f as, top_fvs, lcl_fvs) + | (imp_fvs, top_fvs, lcl_fvs) <- varFVs env f (argsFVs env as) + = (StgApp f as, imp_fvs, top_fvs, lcl_fvs) - go (StgLit lit) = (StgLit lit, emptyVarSet, emptyDVarSet) + go (StgLit lit) = (StgLit lit, emptyVarSet, emptyVarSet, emptyDVarSet) go (StgConApp dc n as tys) - | (top_fvs, lcl_fvs) <- argsFVs env as - = (StgConApp dc n as tys, top_fvs, lcl_fvs) + | (imp_fvs, top_fvs, lcl_fvs) <- argsFVs env as + = (StgConApp dc n as tys, imp_fvs, top_fvs, lcl_fvs) go (StgOpApp op as ty) - | (top_fvs, lcl_fvs) <- argsFVs env as - = (StgOpApp op as ty, top_fvs, lcl_fvs) + | (imp_fvs, top_fvs, lcl_fvs) <- argsFVs env as + = (StgOpApp op as ty, imp_fvs, top_fvs, lcl_fvs) go (StgCase scrut bndr ty alts) - | (scrut',scrut_top_fvs,scrut_lcl_fvs) <- exprFVs env scrut - , (alts',alts_top_fvss,alts_lcl_fvss) - <- mapAndUnzip3 (altFVs (addLocals [bndr] env)) alts + | (scrut',scrut_imp_fvs,scrut_top_fvs,scrut_lcl_fvs) <- exprFVs env scrut + , (alts',alts_imp_fvss,alts_top_fvss,alts_lcl_fvss) + <- mapAndUnzip4 (altFVs (addLocals [bndr] env)) alts , let top_fvs = scrut_top_fvs `unionVarSet` unionVarSets alts_top_fvss + imp_fvs = scrut_imp_fvs `unionVarSet` unionVarSets alts_imp_fvss alts_lcl_fvs = unionDVarSets alts_lcl_fvss lcl_fvs = delDVarSet (unionDVarSet scrut_lcl_fvs alts_lcl_fvs) bndr - = (StgCase scrut' bndr ty alts', top_fvs,lcl_fvs) + = (StgCase scrut' bndr ty alts', imp_fvs, top_fvs, lcl_fvs) go (StgLet ext bind body) = go_bind (StgLet ext) bind body go (StgLetNoEscape ext bind body) = go_bind (StgLetNoEscape ext) bind body go (StgTick tick e) - | (e', top_fvs, lcl_fvs) <- exprFVs env e + | (e', imp_fvs, top_fvs, lcl_fvs) <- exprFVs env e , let lcl_fvs' = unionDVarSet (tickish tick) lcl_fvs - = (StgTick tick e', top_fvs, lcl_fvs') + = (StgTick tick e', imp_fvs, top_fvs, lcl_fvs') where tickish (Breakpoint _ _ ids) = mkDVarSet ids tickish _ = emptyDVarSet - go_bind dc bind body = (dc bind' body', top_fvs, lcl_fvs) + go_bind dc bind body = (dc bind' body', imp_fvs, top_fvs, lcl_fvs) where env' = addLocals (bindersOf bind) env - (body', body_top_fvs, body_lcl_fvs) = exprFVs env' body - (bind', bind_top_fvs, lcl_fvs) = bindingFVs env' body_lcl_fvs bind + (body', body_imp_fvs, body_top_fvs, body_lcl_fvs) = exprFVs env' body + (bind', bind_imp_fvs, bind_top_fvs, lcl_fvs) = bindingFVs env' body_lcl_fvs bind top_fvs = bind_top_fvs `unionVarSet` body_top_fvs + imp_fvs = bind_imp_fvs `unionVarSet` body_imp_fvs -rhsFVs :: Env -> StgRhs -> (CgStgRhs, TopFVs, LocalFVs) +rhsFVs :: Env -> StgRhs -> (CgStgRhs, ImpFVs, TopFVs, LocalFVs) rhsFVs env (StgRhsClosure _ ccs uf bs body typ) - | (body', top_fvs, lcl_fvs) <- exprFVs (addLocals bs env) body + | (body', imp_fvs, top_fvs, lcl_fvs) <- exprFVs (addLocals bs env) body , let lcl_fvs' = delDVarSetList lcl_fvs bs - = (StgRhsClosure lcl_fvs' ccs uf bs body' typ, top_fvs, lcl_fvs') + = (StgRhsClosure lcl_fvs' ccs uf bs body' typ, imp_fvs, top_fvs, lcl_fvs') rhsFVs env (StgRhsCon ccs dc mu ts bs typ) - | (top_fvs, lcl_fvs) <- argsFVs env bs - = (StgRhsCon ccs dc mu ts bs typ, top_fvs, lcl_fvs) + | (imp_fvs, top_fvs, lcl_fvs) <- argsFVs env bs + = (StgRhsCon ccs dc mu ts bs typ, imp_fvs, top_fvs, lcl_fvs) -argsFVs :: Env -> [StgArg] -> (TopFVs, LocalFVs) -argsFVs env = foldl' f (emptyVarSet, emptyDVarSet) +argsFVs :: Env -> [StgArg] -> (ImpFVs, TopFVs, LocalFVs) +argsFVs env = foldl' f (emptyVarSet, emptyVarSet, emptyDVarSet) where - f (fvs,ids) StgLitArg{} = (fvs, ids) - f (fvs,ids) (StgVarArg v) = varFVs env v (fvs, ids) + f (imp_fvs,fvs,ids) StgLitArg{} = (imp_fvs, fvs, ids) + f (imp_fvs,fvs,ids) (StgVarArg v) = varFVs env v (imp_fvs, fvs, ids) -altFVs :: Env -> StgAlt -> (CgStgAlt, TopFVs, LocalFVs) +altFVs :: Env -> StgAlt -> (CgStgAlt, ImpFVs, TopFVs, LocalFVs) altFVs env GenStgAlt{alt_con=con, alt_bndrs=bndrs, alt_rhs=e} - | (e', top_fvs, lcl_fvs) <- exprFVs (addLocals bndrs env) e + | (e', imp_fvs, top_fvs, lcl_fvs) <- exprFVs (addLocals bndrs env) e , let lcl_fvs' = delDVarSetList lcl_fvs bndrs , let newAlt = GenStgAlt{alt_con=con, alt_bndrs=bndrs, alt_rhs=e'} - = (newAlt, top_fvs, lcl_fvs') + = (newAlt, imp_fvs, top_fvs, lcl_fvs') ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Unit.Module ( Module ) import GHC.Utils.Error import GHC.Types.Var +import GHC.Types.Var.Set import GHC.Types.Unique.Supply import GHC.Utils.Outputable import GHC.Utils.Logger @@ -70,7 +71,7 @@ stg2stg :: Logger -> StgPipelineOpts -> Module -- ^ module being compiled -> [StgTopBinding] -- ^ input program - -> IO ([CgStgTopBinding], StgCgInfos) -- output program + -> IO ([(CgStgTopBinding,IdSet)], StgCgInfos) -- output program stg2stg logger extra_vars opts this_mod binds = do { dump_when Opt_D_dump_stg_from_core "Initial STG:" binds ; showPass logger "Stg2Stg" @@ -88,9 +89,10 @@ stg2stg logger extra_vars opts this_mod binds -- sorting pass is necessary. -- This pass will also augment each closure with non-global free variables -- annotations (which is used by code generator to compute offsets into closures) - ; let binds_sorted_with_fvs = depSortWithAnnotStgPgm this_mod binds' + ; let (binds_sorted_with_fvs, imp_fvs) = unzip (depSortWithAnnotStgPgm this_mod binds') -- See Note [Tag inference for interactive contexts] - ; inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs + ; (cg_binds, cg_infos) <- inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs + ; pure (zip cg_binds imp_fvs, cg_infos) } where ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Utils.Misc ( unzipWith, mapFst, mapSnd, chkAppend, - mapAndUnzip, mapAndUnzip3, + mapAndUnzip, mapAndUnzip3, mapAndUnzip4, filterOut, partitionWith, dropWhileEndLE, spanEnd, last2, lastMaybe, onJust, @@ -55,6 +55,7 @@ module GHC.Utils.Misc ( -- * Tuples fstOf3, sndOf3, thdOf3, + fstOf4, sndOf4, fst3, snd3, third3, uncurry3, @@ -183,6 +184,11 @@ fstOf3 (a,_,_) = a sndOf3 (_,b,_) = b thdOf3 (_,_,c) = c +fstOf4 :: (a,b,c,d) -> a +sndOf4 :: (a,b,c,d) -> b +fstOf4 (a,_,_,_) = a +sndOf4 (_,b,_,_) = b + fst3 :: (a -> d) -> (a, b, c) -> (d, b, c) fst3 f (a, b, c) = (f a, b, c) @@ -324,7 +330,6 @@ mapAndUnzip f (x:xs) (r1:rs1, r2:rs2) mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d]) - mapAndUnzip3 _ [] = ([], [], []) mapAndUnzip3 f (x:xs) = let (r1, r2, r3) = f x @@ -332,6 +337,14 @@ mapAndUnzip3 f (x:xs) in (r1:rs1, r2:rs2, r3:rs3) +mapAndUnzip4 :: (a -> (b, c, d, e)) -> [a] -> ([b], [c], [d], [e]) +mapAndUnzip4 _ [] = ([], [], [], []) +mapAndUnzip4 f (x:xs) + = let (r1, r2, r3, r4) = f x + (rs1, rs2, rs3, rs4) = mapAndUnzip4 f xs + in + (r1:rs1, r2:rs2, r3:rs3, r4:rs4) + zipWithAndUnzip :: (a -> b -> (c,d)) -> [a] -> [b] -> ([c],[d]) zipWithAndUnzip f (a:as) (b:bs) = let (r1, r2) = f a b ===================================== testsuite/tests/driver/recomp009/all.T ===================================== @@ -1,3 +1,3 @@ # Test for #481, a recompilation bug with Template Haskell -test('recomp009', [req_th, js_broken(23013), extra_files(['Main.hs', 'Sub1.hs', 'Sub2.hs'])], makefile_test, []) +test('recomp009', [req_th, extra_files(['Main.hs', 'Sub1.hs', 'Sub2.hs'])], makefile_test, []) ===================================== testsuite/tests/driver/recompTH/all.T ===================================== @@ -1,4 +1,4 @@ -test('recompTH', [req_th, js_broken(23013), extra_files(['A.hs', 'B1.hs', 'B2.hs' ]), +test('recompTH', [req_th, extra_files(['A.hs', 'B1.hs', 'B2.hs' ]), when(fast(), skip) , normalise_slashes], makefile_test, []) ===================================== testsuite/tests/driver/th-new-test/all.T ===================================== @@ -1,4 +1,4 @@ -test('th-new-test', [req_th, js_broken(23013), extra_files(['A.hs', 'B.hs', 'C.hs', 'D.hs', 'B1.hs', 'D1.hs', 'Main.hs']), +test('th-new-test', [req_th, extra_files(['A.hs', 'B.hs', 'C.hs', 'D.hs', 'B1.hs', 'D1.hs', 'Main.hs']), when(fast(), skip) , normalise_slashes], makefile_test, []) ===================================== testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs ===================================== @@ -68,7 +68,7 @@ cmmOfSummary summ = do let infotable = emptyInfoTableProvMap tycons = [] ccs = emptyCollectedCCs - stg' = depSortWithAnnotStgPgm (ms_mod summ) stg + stg' = fmap fst (depSortWithAnnotStgPgm (ms_mod summ) stg) hpcinfo = emptyHpcInfo False tmpfs = hsc_tmpfs env stg_to_cmm dflags mod = codeGen logger tmpfs (initStgToCmmConfig dflags mod) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d586b7c4f4a53f913fb91d02698737b2f6f73acc...f00e5db404db3855dfe75f694e2aaee0c26a3da7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d586b7c4f4a53f913fb91d02698737b2f6f73acc...f00e5db404db3855dfe75f694e2aaee0c26a3da7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 15:35:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 31 May 2023 11:35:30 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 25 commits: Migrate errors in GHC.Rename.Splice GHC.Rename.Pat Message-ID: <64776942e37db_36fbc92622a80143186@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 10867599 by Ben Gamari at 2023-05-31T11:35:27-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 971e82f4 by Ben Gamari at 2023-05-31T11:35:27-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs - compiler/GHC/Driver/Config/Diagnostic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46f435d2649ea67049db51213fd009b45253f28f...971e82f43ab79bb6631b3129afa78ed3ff586d21 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46f435d2649ea67049db51213fd009b45253f28f...971e82f43ab79bb6631b3129afa78ed3ff586d21 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 15:36:36 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 31 May 2023 11:36:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ipe-section Message-ID: <6477698462c32_36fbc927d5f80143631@gitlab.mail> Ben Gamari pushed new branch wip/ipe-section at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ipe-section You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 15:37:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 May 2023 11:37:28 -0400 Subject: [Git][ghc/ghc][master] 5 commits: Data.Bag: add INLINEABLE to polymorphic functions Message-ID: <647769b8df985_36fbc927d7d9414701@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 30 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Head.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf9344d24157986ea013210e7cb9a5953670e0e2...f62d81954691e1f1f4e4ac1c86b0d99bbc31cbc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf9344d24157986ea013210e7cb9a5953670e0e2...f62d81954691e1f1f4e4ac1c86b0d99bbc31cbc4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 15:38:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 May 2023 11:38:51 -0400 Subject: [Git][ghc/ghc][master] Update rdt-theme to latest upstream version Message-ID: <64776a0b4779a_36fbc95ef8f941522bd@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 30 changed files: - docs/users_guide/rtd-theme/__init__.py - docs/users_guide/rtd-theme/breadcrumbs.html - docs/users_guide/rtd-theme/footer.html - docs/users_guide/rtd-theme/layout.html - + docs/users_guide/rtd-theme/locale/da/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/da/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/de/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/de/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/en/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/en/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/es/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/es/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/et/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/et/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/fa_IR/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/fa_IR/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/fr/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/fr/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/hr/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/hr/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/hu/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/hu/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/it/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/it/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/lt/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/lt/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/nl/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/nl/LC_MESSAGES/sphinx.po - + docs/users_guide/rtd-theme/locale/pl/LC_MESSAGES/sphinx.mo - + docs/users_guide/rtd-theme/locale/pl/LC_MESSAGES/sphinx.po The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70526f5bd8886126f49833ef20604a2c6477780a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70526f5bd8886126f49833ef20604a2c6477780a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 16:03:42 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 May 2023 12:03:42 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T16432 Message-ID: <64776fde1c426_36fbc95feb53c1578e2@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T16432 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T16432 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 16:25:11 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 31 May 2023 12:25:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22451 Message-ID: <647774e747279_36fbc96b243e01641b6@gitlab.mail> Ben Gamari pushed new branch wip/T22451 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22451 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 17:39:12 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 31 May 2023 13:39:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/#16635-improve-errors Message-ID: <6477864093cf_36fbc96b243e01844d5@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/%2316635-improve-errors You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 17:59:16 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 May 2023 13:59:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-build-9.2 Message-ID: <64778af45e541_36fbc993b59081881f2@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/fix-build-9.2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-build-9.2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 19:09:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 31 May 2023 15:09:33 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 2 commits: testsuite: Allow preservation of unexpected output Message-ID: <64779b6d6bdc5_36fbc99d018182167e2@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: e94fff9d by Ben Gamari at 2023-05-31T15:09:19-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 12dfd808 by Ben Gamari at 2023-05-31T15:09:19-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 5 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -684,16 +684,20 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty - , if validateNonmovingGc buildConfig - then "RUNTEST_ARGS" =: "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" - else mempty + , let runtestArgs = + [ "--unexpected-output-dir=./unexpected-output" ] ++ + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + , "unexpected-output"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -11,7 +11,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -59,6 +60,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-darwin-validate" } }, @@ -73,7 +75,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -117,6 +120,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-linux-deb10-validate" } }, @@ -131,7 +135,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -175,6 +180,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "i386-linux-deb9-validate" } }, @@ -189,7 +195,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -237,6 +244,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -252,7 +260,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -296,6 +305,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -311,7 +321,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -355,6 +366,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -370,7 +382,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -414,6 +427,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -429,7 +443,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -477,6 +492,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -494,7 +510,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -540,6 +557,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -555,7 +573,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -602,6 +621,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -617,7 +637,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -664,6 +685,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -679,7 +701,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -726,6 +749,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -741,7 +765,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -787,6 +812,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -802,7 +828,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -848,6 +875,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -863,7 +891,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -909,6 +938,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -924,7 +954,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -969,6 +1000,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -984,7 +1016,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1028,6 +1061,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1043,7 +1077,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1087,6 +1122,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1102,7 +1138,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1147,6 +1184,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1162,7 +1200,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1206,6 +1245,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1221,7 +1261,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1265,6 +1306,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1280,7 +1322,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1324,6 +1367,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1339,7 +1383,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1383,6 +1428,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1398,7 +1444,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1443,6 +1490,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1459,7 +1507,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1505,6 +1554,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1520,7 +1570,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1567,6 +1618,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1582,7 +1634,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1626,6 +1679,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1641,7 +1695,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1685,7 +1740,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", "CONFIGURE_ARGS": "", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output --way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", "XZ_OPT": "-9" } @@ -1701,7 +1756,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1745,6 +1801,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1760,7 +1817,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1806,6 +1864,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1821,7 +1880,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1868,6 +1928,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1883,7 +1944,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1929,6 +1991,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1944,7 +2007,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -1989,6 +2053,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2004,7 +2069,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2048,6 +2114,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2063,7 +2130,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2107,6 +2175,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2121,7 +2190,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2166,6 +2236,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2180,7 +2251,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2225,6 +2297,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2240,7 +2313,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2289,6 +2363,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2304,7 +2379,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2350,6 +2426,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2365,7 +2442,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2411,6 +2489,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2426,7 +2505,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2475,6 +2555,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2492,7 +2573,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2540,6 +2622,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2555,7 +2638,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2603,6 +2687,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2618,7 +2703,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2666,6 +2752,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2681,7 +2768,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2727,6 +2815,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2742,7 +2831,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2788,6 +2878,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2803,7 +2894,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2849,6 +2941,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2864,7 +2957,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2910,6 +3004,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -2925,7 +3020,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -2971,7 +3067,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output --way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-release+boot_nonmoving_gc", "XZ_OPT": "-9" } @@ -2987,7 +3083,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3033,6 +3130,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3048,7 +3146,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3096,6 +3195,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3111,7 +3211,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3159,6 +3260,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3174,7 +3276,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3222,6 +3325,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3237,7 +3341,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3283,6 +3388,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3298,7 +3404,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3344,6 +3451,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3359,7 +3467,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3405,6 +3514,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3419,7 +3529,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3465,6 +3576,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3479,7 +3591,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3525,6 +3638,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3540,7 +3654,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3588,6 +3703,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_utimensat": "no" @@ -3604,7 +3720,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3650,6 +3767,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-freebsd13-validate" } }, @@ -3664,7 +3782,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3711,6 +3830,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, @@ -3725,7 +3845,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3771,6 +3892,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, @@ -3785,7 +3907,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3832,6 +3955,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, @@ -3846,7 +3970,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3893,6 +4018,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, @@ -3907,7 +4033,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -3951,6 +4078,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, @@ -3965,7 +4093,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4010,6 +4139,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, @@ -4024,7 +4154,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4069,6 +4200,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, @@ -4083,7 +4215,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4127,6 +4260,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, @@ -4141,7 +4275,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4185,6 +4320,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, @@ -4199,7 +4335,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4243,6 +4380,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, @@ -4257,7 +4395,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4303,6 +4442,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4318,7 +4458,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4364,6 +4505,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, @@ -4378,7 +4520,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4425,6 +4568,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, @@ -4439,7 +4583,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4483,7 +4628,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", "CONFIGURE_ARGS": "", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output --way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" } }, @@ -4498,7 +4643,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4544,6 +4690,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-linux-fedora33-release" } }, @@ -4557,7 +4704,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-output" ], "reports": { "junit": "junit.xml" @@ -4602,6 +4750,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "--unexpected-output-dir=./unexpected-output", "TEST_ENV": "x86_64-windows-validate" } } ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--unexpected-output-dir", help="directory in which to place unexpected output") parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") @@ -128,6 +129,9 @@ if args.top: if args.test_package_db: config.test_package_db = args.test_package_db +if args.unexpected_output_dir: + config.unexpected_output_dir = Path(args.unexpected_output_dir) + if args.only: config.only = args.only config.run_only_some_tests = True ===================================== testsuite/driver/testglobals.py ===================================== @@ -203,7 +203,7 @@ class TestConfig: self.baseline_commit = None # type: Optional[GitRef] # Additional package dbs to inspect for test dependencies. - self.test_package_db = [] # type: [PathToPackageDb] + self.test_package_db = [] # type: List[PathToPackageDb] # Should we skip performance tests self.skip_perf_tests = False @@ -225,6 +225,10 @@ class TestConfig: # See Note [Haddock runtime stats files] at the bottom of this file. self.stats_files_dir = Path('/please_set_stats_files_dir') + # Where to place observed output files on when unexpected output + # is observed. + self.unexpected_output_dir = None # type: Optional[Path] + # Should we cleanup after test runs? self.cleanup = True ===================================== testsuite/driver/testlib.py ===================================== @@ -2196,11 +2196,15 @@ async def check_prof_ok(name: TestName, way: WayName) -> bool: # new output. Returns true if output matched or was accepted, false # otherwise. See Note [Output comparison] for the meaning of the # normaliser and whitespace_normaliser parameters. -async def compare_outputs(way: WayName, - kind: str, - normaliser: OutputNormalizer, - expected_file, actual_file, diff_file=None, - whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: +async def compare_outputs( + way: WayName, + kind: str, + normaliser: OutputNormalizer, + expected_file: Path, + actual_file: Path, + diff_file: Optional[Path]=None, + whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options if kind == 'stderr' and getTestOpts().ignore_stderr: return True @@ -2277,6 +2281,12 @@ async def compare_outputs(way: WayName, expected_path.unlink() return True else: + if config.unexpected_output_dir is not None: + ghc_root = expected_path.relative_to(config.top.parent) + out = config.unexpected_output_dir / ghc_root + out.parent.mkdir(exist_ok=True, parents=True) + write_file(out, expected_str) + return False # Checks that each line from pattern_file is present in actual_file as @@ -2331,6 +2341,15 @@ def grep_output(normaliser: OutputNormalizer, pattern_file, actual_file, is_subs # squash all whitespace, making the diff unreadable. Instead we rely # on the `diff` program to ignore whitespace changes as much as # possible (#10152). +# +# In addition, to aid CI users we will optionally collect all +# of the unexpected output that we encountered in the +# directory at config.unexpected_output_dir. The intent here is for this +# directory to be preserved as a CI artifact which can then +# be downloaded by the user and committed to their branch +# to address CI failures on platforms which they cannot +# test locally. + # Note [Null device handling] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/971e82f43ab79bb6631b3129afa78ed3ff586d21...12dfd80847136b182fad201a461480c81a2f514c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/971e82f43ab79bb6631b3129afa78ed3ff586d21...12dfd80847136b182fad201a461480c81a2f514c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 21:13:26 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 May 2023 17:13:26 -0400 Subject: [Git][ghc/ghc][wip/T16432] 7 commits: Data.Bag: add INLINEABLE to polymorphic functions Message-ID: <6477b876b18cb_16c027c2c1880541@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T16432 at Glasgow Haskell Compiler / GHC Commits: d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 11e385d4 by Krzysztof Gogolewski at 2023-05-31T23:12:23+02:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - 30 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Head.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/961b8ce3efaf2f2db032c63f608788bf0940059f...11e385d4e7b99d4e0957531b030dae60a3b721f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/961b8ce3efaf2f2db032c63f608788bf0940059f...11e385d4e7b99d4e0957531b030dae60a3b721f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 21:14:03 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 31 May 2023 17:14:03 -0400 Subject: [Git][ghc/ghc][wip/T21247] 7 commits: Data.Bag: add INLINEABLE to polymorphic functions Message-ID: <6477b89bd8aa8_16c027c2ee8808ef@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T21247 at Glasgow Haskell Compiler / GHC Commits: d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 1dfa3ee7 by Krzysztof Gogolewski at 2023-05-31T23:13:57+02:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 30 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Head.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b97e574e9a447ac1f45811dde20eee6ae9d15649...1dfa3ee73c7003d4bae0fcc19e2230aa34579c1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b97e574e9a447ac1f45811dde20eee6ae9d15649...1dfa3ee73c7003d4bae0fcc19e2230aa34579c1c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed May 31 21:19:57 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 31 May 2023 17:19:57 -0400 Subject: [Git][ghc/ghc][wip/expand-do] call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine Message-ID: <6477b9fd2e72c_16c027c2c2c8144@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: ba566946 by Apoorv Ingle at 2023-05-31T16:19:45-05:00 call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -687,7 +687,7 @@ addArgCtxt :: AppCtxt -> LHsExpr GhcRn -- (VAExpansion), just use the less-informative context -- "In the expression: arg" -- Unless the arg is also a generated thing, in which case do nothing. ----See Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr +--- See Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr addArgCtxt ctxt (L arg_loc arg) thing_inside = do { in_generated_code <- inGeneratedCode ; case ctxt of ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -208,7 +208,20 @@ tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty tcExpr e@(XExpr (ExpandedExpr {})) res_ty = tcApp e res_ty -tcExpr (XExpr (PopSrcSpan e)) res_ty = popErrCtxt $ tcApp (unLoc e) res_ty + +tcExpr (XExpr (PopSrcSpan e)) res_ty = popErrCtxt $ tcExpr (unLoc e) res_ty + +tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty + = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt + , text "expr:" <+> ppr expr + , text "res_ty" <+> ppr res_ty + ]) + ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ + tcApp (unLoc expr) res_ty + } + + + tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty @@ -415,15 +428,6 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty - = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt - , text "expr:" <+> ppr expr - , text "res_ty" <+> ppr res_ty - ]) - ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - tcApp (unLoc expr) res_ty - } - tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expand_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1466,8 +1466,6 @@ addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt e thing_inside = case e of HsUnboundVar {} -> thing_inside - XExpr (ExpandedStmt (HsExpanded stmt _)) -> - addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) thing_inside _ -> addErrCtxt (exprCtxt e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1238,7 +1238,7 @@ expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bnds)) : lstmts) = return $ L loc $ mkExpandedStmt stmt (wrapGenSpan (HsLet noExtField noHsTok bnds - noHsTok (genPopSrcSpanExpr expand_stmts))) + noHsTok expand_stmts)) expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn @@ -1250,7 +1250,7 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) -- ------------------------------------------------------- -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts - expr <- mk_failable_lexpr_tcm pat (noLocA $ mkExpandedStmt stmt expand_stmts) fail_op + expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) [ genPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e) , genPopSrcSpanExpr expr @@ -1265,8 +1265,8 @@ expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmt -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ (mkHsApps (wrapGenSpan f) -- (>>) - [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) -- e - , expand_stmts ]) -- stmts' + [ genPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e) -- e + , genPopSrcSpanExpr expand_stmts ]) -- stmts' expand_do_stmts do_or_lc ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts @@ -1394,7 +1394,7 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ (wrapGenSpan [ mkHsCaseAltDoExp pat lexpr -- pat -> expr - , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" + , mkHsCaseAltDoExp nlWildPatName -- _ -> fail "fail pattern" (wrapGenSpan $ genHsApp fail_op (mk_fail_msg_expr dflags pat)) ])) where @@ -1428,9 +1428,12 @@ f = {g1} (>>=) ({l1'} e1) (\ p -> ) The points to consider are: -1. Generate appropriate warnings for discarded results, eg. say g p :: m Int -2. Decorate an expression a fail block if the pattern match is irrefutable -3. Generating approprate type error messages that blame the correct source spans +1. Generating appropriate type error messages that blame the correct source spans +2. Generate appropriate warnings for discarded results, eg. say g p :: m Int +3. Decorate an expression a fail block if the pattern match is irrefutable + +Things get a bit tricky with QuickLook involved that decomposes the applications +to perform an impredicativity check. TODO expand using examples View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba56694691955e3bcedaad9cf419cdcf0bab2796 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba56694691955e3bcedaad9cf419cdcf0bab2796 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: